.CM *ID* VCT04    VDN      changed on 1992-08-13-12.25.02 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$VCT04$
.tt 2 $$$
.tt 3 $C. Nemack$Conditional-Compiling_Utilities$1995-05-02$
***********************************************************
.nf


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

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

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

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

.fo
.nf
.sp
Module  : Conditional-Compiling_Utilities
=========
.sp
Purpose :
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              c04cc2init (VAR argln     : tct_line;
                    VAR printrout : tsp_name;
                    VAR td_trace  : boolean;
                    errfileno     : tsp_int4);
 
        PROCEDURE
              c04ccinit (VAR argln     : tct_line;
                    VAR printrout : tsp_name;
                    VAR td_trace  : boolean;
                    VAR nopref    : boolean;
                    VAR counting  : boolean;
                    errfileno     : tsp_int4);
 
        FUNCTION
              c04ccgetline (infileno : tsp_int4;
                    VAR ln    : tct_line;
                    errfileno : tsp_int4) : tsp_vf_return;
 
        PROCEDURE
              c04linelength_init ( l : integer );
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              String_utilities : VCT02;
 
        FUNCTION
              c02isblankline (VAR ln : tct_line) : boolean;
&       IFDEF DEBUG1
 
        PROCEDURE
              c02zwrite ( ln : tct_line );
&       ENDIF
 
      ------------------------------ 
 
        FROM
              CCT-Routines : VCT45;
 
        PROCEDURE
              c45initcond;
 
        PROCEDURE
              c45process_cond_directive (VAR ln : tsp_line;
                    VAR length   : tsp_int4;
                    VAR errtxt   : tsp_line);
 
        PROCEDURE
              c45store_symbols (VAR s_name : tsp_c8;
                    VAR s_value   : tsp_c8;
                    VAR s_count   : integer;
                    VAR errtxt   : tsp_line);
 
      ------------------------------ 
 
        FROM
              RTE_driver  : VEN102;
 
        PROCEDURE
              sqlfread (VAR hostfileno : tsp_int4;
                    buf              : tct_lineaddr;
                    VAR length       : tsp_int4;
                    VAR error        : tsp_vf_return;
                    VAR errtext      : tsp_errtext);
 
        PROCEDURE
              sqlfwrite (VAR hostfileno : tsp_int4;
                    buf               : tct_lineaddr;
                    length            : tsp_int4;
                    VAR error         : tsp_vf_return;
                    VAR errtext       : tsp_errtext);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10mv (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_line;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s10mv;
 
              tsp_moveobj tsp_line
 
        PROCEDURE
              c45process_cond_directive;
 
              tct_errortext tsp_line
 
        PROCEDURE
              c45store_symbols;
 
              tct_token     tsp_c8
              tct_errortext tsp_line
 
        PROCEDURE
              sqlfread;
 
              tsp_vf_bufaddr tct_lineaddr
 
        PROCEDURE
              sqlfwrite;
 
              tsp_vf_bufaddr tct_lineaddr
 
.CM *-END-* synonym -------------------------------------
Author  : C. Nemack
.sp
.cp 3
Created : 1988-07-18
.sp
.cp 3
Version : 1999-07-21
.sp
.cp 3
Release :  6.1.1         Date : 1995-05-02
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.sp2
PROCEDURE c04ccinit:
.sp
The procedure c04ccinit sets the parameters for conditional-compiling.
The parameters are returned by calling the procedure sqlargl. The
initialization of the conditional-compiling-module will be performed
by the procedure 'c45_init_cond'.
.sp 2
PROCEDURE c04cc2init:
.sp
The procedure c04cc2init calls the procedure c04ccinit and
adds missing parameters.
.sp 2
FUNCTION c04ccgetline:
.sp
The function c04ccgetline gets a line from the virtual-file, which
is specified by the 'infileno'. The errorcode will be returned as
function-result. Blanklines and lines which not fulfill the conditional
compiling facts were not returned, but following line which differs to
a blankline and fulfill the conditional facts. Errors in conditonal-
compiling command were written to 'errfileno', which must be open
by the called module.
.sp
The function calls 'c45_do_cond_directive' for checking conditional
compiling facts. For initializations of conditional-compiling must
'c45_init_cond' be called.
.sp
.nf
NOTE: The s60maximal linelength of ln.l is defined by 'linelength'
      and the returned length of line is defined by
      'maxlinelength'. If a line is longer as maxlinelength,
      it will be truncated to maxlinelength by overreading
      the begin of the line.
.fo
.sp 2
PROCEDURE name_to_lower:
.sp
The given name will be transformed to lower-case characters.
.sp2
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
VAR
      c04lnlength   : integer;
      c04hline      : tct_line;
      c04iline      : tct_line;
 
 
(*------------------------------*) 
 
PROCEDURE
      c04cc2init (VAR argln     : tct_line;
            VAR printrout : tsp_name;
            VAR td_trace  : boolean;
            errfileno     : tsp_int4);
 
VAR
      dummy_nopref    : boolean;
      dummy_counting  : boolean;
 
BEGIN
c04ccinit (argln, printrout, td_trace, dummy_nopref, dummy_counting,
      errfileno);
END;
 
(*------------------------------*) 
 
PROCEDURE
      c04ccinit (VAR argln     : tct_line;
            VAR printrout : tsp_name;
            VAR td_trace  : boolean;
            VAR nopref    : boolean;
            VAR counting  : boolean;
            errfileno     : tsp_int4);
 
CONST
      c_param_char  = '-';
      c_print_rout  = 'P';
      c_machine     = 'M';
      c_kind        = 'K';
      c_trace       = 'T';
      c_compiler    = 'C';
      c_os          = 'O';
      c_osspec      = 'E';
      c_define      = 'D';
      c_nopref      = 'N';
      c_count       = 'I';
      c_sqlmode     = 'S';
&     IF $COMP = MSPAS
      cl_print_rout = 'p';
      cl_machine    = 'm';
      cl_kind       = 'k';
      cl_trace      = 't';
      cl_compiler   = 'c';
      cl_os         = 'o';
      cl_osspec     = 'e';
      cl_define     = 'd';
      cl_nopref     = 'n';
      cl_count      = 'i';
      cl_sqlmode    = 's';
&     ENDIF
      cn_dummy      = '1       ';
 
VAR
      i           : integer;
      j           : integer;
      tcount      : integer;
      tokenname   : tsp_c8;
      token       : tsp_c8;
      first_param : integer;
      ferr        : tsp_vf_return;
      ferr_txt    : tsp_errtext;
 
BEGIN
nopref   := false;
counting := false;
(* conditional compiling *)
c45initcond;
c04linelength_init (mxct_line);
&IFDEF DEBUG1
write ('ccinit ');
c02zwrite (argln);
&ENDIF
first_param := 0;
tcount      := 0;
i           := 1;
WHILE (i < argln.len) DO
    BEGIN
    token     := bsp_c8;
    tokenname := bsp_c8;
    WHILE ((argln.l[ i ] = bsp_c1) AND (i < argln.len)) DO
        i := i + 1;
    (*ENDWHILE*) 
    IF  (argln.l[ i ] = c_param_char)
    THEN
        BEGIN
        IF  (first_param = 0)
        THEN
            first_param := i;
        (*ENDIF*) 
        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
&           IF $COMP = MSPAS
            cl_print_rout,
&           ENDIF
            c_print_rout :
                BEGIN
                j := 1;
                WHILE (argln.l[ i ] <> bsp_c1) DO
                    BEGIN
                    printrout [ j ] := argln.l[ i ];
                    i               := i + 1;
                    j               := j + 1;
                    END;
                (*ENDWHILE*) 
                name_to_lower (printrout);
                tokenname := bsp_c8;
                END;
&           IF $COMP = MSPAS
            cl_nopref,
&           ENDIF
            c_nopref   :
                nopref := true;
&           IF $COMP = MSPAS
            cl_machine,
&           ENDIF
            c_machine  :
                BEGIN
                copy_token (argln, i, token);
                tokenname := cct_c_mach;
                END;
&           IF $COMP = MSPAS
            cl_kind,
&           ENDIF
            c_kind     :
                BEGIN
                copy_token (argln, i, token);
                tokenname := cct_c_kind;
                END;
&           IF $COMP = MSPAS
            cl_count,
&           ENDIF
            c_count    :
                counting := true;
&           IF $COMP = MSPAS
            cl_trace,
&           ENDIF
            c_trace    :
                BEGIN
                copy_token (argln, i, token);
                IF  (token[ 1 ] = 'N')
                THEN
                    BEGIN
                    td_trace := false;
                    token    := bsp_c8;
                    END
                ELSE
                    BEGIN
                    td_trace  := true;
                    tokenname := cct_c_trace;
                    END;
                (*ENDIF*) 
                END;
&           IF $COMP = MSPAS
            cl_compiler,
&           ENDIF
            c_compiler :
                BEGIN
                copy_token (argln, i, token);
                tokenname := cct_c_comp;
                END;
&           IF $COMP = MSPAS
            cl_os,
&           ENDIF
            c_os       :
                BEGIN
                copy_token (argln, i, token);
                tokenname := cct_c_os;
                END;
&           IF $COMP = MSPAS
            cl_osspec,
&           ENDIF
            c_osspec   :
                BEGIN
                copy_token (argln, i, token);
                tokenname := cct_c_osspec;
                END;
&           IF $COMP = MSPAS
            cl_define,
&           ENDIF
            c_define   :
                BEGIN
                copy_token (argln, i, tokenname);
                token := cn_dummy;
                END;
&           IF $COMP = MSPAS
            cl_sqlmode,
&           ENDIF
            c_sqlmode  :
                BEGIN
                copy_token (argln, i, token);
                tokenname := cct_c_mode;
                END;
            OTHERWISE
            END;
        (*ENDCASE*) 
        END
    ELSE
        i := i + 1;
    (*ENDIF*) 
&   IFDEF DEBUG1
    IF  (token[ 1 ] <> bsp_c1)
    THEN
        writeln ('c45_store_symbols (',tokenname, ', ',
              token, ', ', tcount,')');
&   ENDIF
    (*ENDIF*) 
    IF  (token[ 1 ] <> bsp_c1)
    THEN
        c45store_symbols (tokenname, token, tcount, c04hline.l);
    (*ENDIF*) 
    c04hline.len := mxct_errtxt;
    IF  (tcount < 0)
    THEN
        sqlfwrite (errfileno, c04hline.adr, c04hline.len, ferr, ferr_txt);
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  (first_param > 0)
THEN
    BEGIN
    i := first_param - 1;
    WHILE ((i > 0) AND (argln.l[ i ] = bsp_c1)) DO
        i := i - 1;
    (*ENDWHILE*) 
    argln.len := i;
    END;
&IFDEF DEBUG1
(*ENDIF*) 
write ('argln  ');
c02zwrite (argln);
&ENDIF
END;
 
(*------------------------------*) 
 
PROCEDURE
      copy_token (VAR argln    : tct_line;
            VAR pos   : integer;
            VAR token : tsp_c8);
 
VAR
      i : integer;
 
BEGIN
i     := 1;
token := bsp_c8;
WHILE ((argln.l[ pos ] <> bsp_c1) AND (pos <= argln.len) AND (i <= 8))
      DO
    BEGIN
    token[ i ] := argln.l[ pos ];
    pos        := succ(pos);
    i          := succ(i);
    END;
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      name_to_lower (VAR n : tsp_name);
 
VAR
      i   : integer;
 
BEGIN
FOR i := 1 TO mxsp_name DO
    BEGIN
    IF  (n[ i ] IN [ 'a'..'i', 'j'..'r', 's'..'z' ])
    THEN
        n[ i ] := chr(ord(n[ i ]) + ord ('a') - ord ('A'))
    (*ENDIF*) 
    END;
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      c04ccgetline (infileno : tsp_int4;
            VAR ln    : tct_line;
            errfileno : tsp_int4) : tsp_vf_return;
 
VAR
      start_pos   : integer;
      blen        : tsp_int4;
      ferr        : tsp_vf_return;
      ferr_txt    : tsp_errtext;
      len         : tsp_int4;
 
BEGIN
c04iline.adr := @c04iline.l;
sqlfread (infileno, c04iline.adr, blen, ferr, ferr_txt);
(* correction for length (file was created with fixed length) *)
WHILE ((blen > 1) AND (c04iline.l[ blen ] = bsp_c1)) DO
    blen := blen - 1;
(*ENDWHILE*) 
len := blen;
c45process_cond_directive (c04iline.l, len, c04hline.l);
IF  (len > 0)
THEN
    BEGIN
    IF  (blen <= c04lnlength)
    THEN
        BEGIN
        ln.len    := blen;
        start_pos := 1;
        END
    ELSE
        BEGIN
        ln.len    := mxct_line;
        start_pos := blen - c04lnlength + 1;
        END;
    (*ENDIF*) 
    s10mv (mxsp_line, mxsp_line, c04iline.l, start_pos, ln.l, 1, ln.len);
    END
ELSE
    IF  (len < 0)
    THEN
        BEGIN
        c04hline.adr := @c04hline.l;
        sqlfwrite (errfileno, c04hline.adr, c04hline.len, ferr,ferr_txt);
        ln.len := 0;  (* is equal to blankline *)
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  ((len = 0) OR c02isblankline (ln))
THEN
    BEGIN
    IF  ferr = vf_ok
    THEN
        ferr := c04ccgetline (infileno, ln, errfileno)
    ELSE
        ln.len := 0;
    (*ENDIF*) 
    END;
&IFDEF DEBUG1
(*ENDIF*) 
c02zwrite (ln);
&ENDIF
c04ccgetline := ferr;
END;
 
(*------------------------------*) 
 
PROCEDURE
      c04linelength_init (
            l : integer);
 
BEGIN
c04lnlength := l;
END; (* c04linelength_init *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        100
*-PRETTY-*  lines of code :        364        PRETTYX 3.10 
*-PRETTY-*  lines in file :        600         1997-12-10 
.PA 
