.CM *ID* VCT41    VDN      changed on 1992-08-10-09.42.28 by KERN      *
.ad 8
.bm 8
.fm 4
.bt $Copyright by   Software AG, 1996$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VCT41$
.tt 2 $$$
.tt 3 $Zabach$Miniscript$1996-11-14$
***********************************************************
.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  : Miniscript
=========
.sp
Purpose : Formating textfiles and commandhandling
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROGRAM
              vct41;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              String_utilities : VCT02;
 
        PROCEDURE
              c02putname (
                    VAR ln  : tct_long_line;
                    pos     : integer;
                    nam     : tsp_name);
 
        PROCEDURE
              c02init;
 
        PROCEDURE
              c02linelength_init (l : integer);
 
        FUNCTION
              c02getline (infileno : tsp_int4;
                    VAR ln  : tct_long_line) : tsp_vf_return;
 
        PROCEDURE
              c02vfwrite (fno     : tsp_int4;
                    VAR buf : tct_long_line);
 
        PROCEDURE
              c02int4to_line (int       : tsp_int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tct_longline);
 
        PROCEDURE
              c02blankline (VAR l : tct_long_line);
&       ifdef DEBUG
 
        PROCEDURE
              c02zwrite (ln : tct_long_line);
&       endif
 
      ------------------------------ 
 
        FROM
              Conditional-Compiling_Utilities : VCT04;
 
        PROCEDURE
              c04cc2init (VAR argln     : tct_long_line;
                    VAR printrout : tsp_name;
                    VAR td_trace  : boolean;
                    errfileno     : tsp_int4);
 
      ------------------------------ 
 
        FROM
              Miniscript_Filehandling : VCT44;
 
        VAR
              c44errfile        : tsp_int4;
              c44summary        : tsp_int4;
              c44imfileno       : tsp_int4;
              c44glossar        : tsp_int4;
              c44infileno       : tsp_int4;
              c44outfileno      : tsp_int4;
 
        PROCEDURE
              c44makereset;
 
        PROCEDURE
              c44gmake_reset;
 
        FUNCTION
              c44files_init_ok : boolean;
 
        PROCEDURE
              c44close_files;
 
        PROCEDURE
              c44openfile (VAR ln     : tct_long_line;
                    VAR pos    : tsp_int2;
                    VAR filen  : tsp_vfilename;
                    VAR fileno : tsp_int4;
                    lineno     : integer;
                    VAR ferr   : tsp_vf_return);
 
      ------------------------------ 
 
        FROM
              CCT-Routines : VCT45;
 
        PROCEDURE
              c45initscript;
 
        PROCEDURE
              c45process_cond_directive (VAR ln : tct_longline;
                    VAR length   : tsp_int4;
                    VAR errtxt   : tct_errortext);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlabort;
 
        PROCEDURE
              sqlfinish (terminate : boolean);
 
        PROCEDURE
              sqlfclose (VAR hostfileno : tsp_int4;
                    erase             : boolean;
                    poolptr           : tsp_int4;
                    buf_count         : tsp_int2;
                    block             : tct_long_lineaddr;
                    VAR error         : tsp_vf_return;
                    VAR errtext       : tsp_errtext);
 
        PROCEDURE
              sqlargl (VAR args    : tct_longline);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
&       ifdef oldstuff
        PROCEDURE
              s10mv (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_buf;
                    p1       : tsp_int4;
                    VAR val2 : tct_longline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
&       endif
 
        PROCEDURE
              s10mv1 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : tsp_int4;
                    VAR val2 : tct_longline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv2 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tct_longline;
                    p1       : tsp_int4;
                    VAR val2 : tct_longline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv3 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c40;
                    p1       : tsp_int4;
                    VAR val2 : tct_longline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv9 (size1    : tsp_int4;
                    size2    : tsp_int4 ;
                    VAR val1 : one_word;
                    p1       : tsp_int4;
                    VAR val2 : tct_longline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv10(size1    : tsp_int4;
                    size2    : tsp_int4 ;
                    VAR val1 : tct_errortext;
                    p1       : tsp_int4;
                    VAR val2 : tct_longline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv11(size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_vfilename;
                    p1       : tsp_int4;
                    VAR val2 : tct_longline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        PROCEDURE
              s30lcm      (VAR buf1     : one_word;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : one_word;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
&       if $COMP=PTOC
&       else
 
        FUNCTION
              s30gad (VAR b : tct_longline) : tct_long_lineaddr;
&       endif
 
        FUNCTION
              s30lnr (VAR str : tct_longline;
                    val     : char;
                    start   : tsp_int4;
                    cnt     : tsp_int4) : tsp_int4;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              c02putname;
 
              tct_line tct_long_line
 
        FUNCTION
              c02getline;
 
              tct_line tct_long_line
 
        PROCEDURE
              c02vfwrite;
 
              tct_line tct_long_line
 
        PROCEDURE
              c02int4to_line;
 
              tsp_line tct_longline
 
        PROCEDURE
              c02blankline;
 
              tct_line tct_long_line
&             ifdef DEBUG
 
        PROCEDURE
              c02zwrite;
 
              tct_line tct_long_line
&             endif
 
        PROCEDURE
              c04cc2init;
 
              tct_line tct_long_line
 
        PROCEDURE
              c44openfile;
 
              tct_line tct_long_line
 
        PROCEDURE
              c45process_cond_directive;
 
              tsp_line tct_longline
 
        PROCEDURE
              sqlargl;
 
              tsp_line tct_longline
&             ifdef oldstuff
 
        PROCEDURE
              s10mv;
 
              tsp_moveobj tsp_buf
              tsp_moveobj tct_longline
&             endif
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj tsp_name
              tsp_moveobj tct_longline
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tct_longline
              tsp_moveobj tct_longline
 
        PROCEDURE
              s10mv3;
 
              tsp_moveobj tsp_c40
              tsp_moveobj tct_longline
 
        PROCEDURE
              s10mv9;
 
              tsp_moveobj one_word
              tsp_moveobj tct_longline
 
        PROCEDURE
              s10mv10;
 
              tsp_moveobj tct_errortext
              tsp_moveobj tct_longline
 
        PROCEDURE
              s10mv11;
 
              tsp_moveobj tsp_vfilename
              tsp_moveobj tct_longline
 
        PROCEDURE
              s30lcm;
 
              tsp_moveobj one_word
              tsp_moveobj one_word
&             if $COMP=PTOC
&             else
 
        FUNCTION
              s30gad;
 
              tsp_moveobj tct_longline
              tsp_addr tct_long_lineaddr
&             endif
 
        PROCEDURE
              s30lnr;
 
              tsp_moveobj tct_longline
 
        PROCEDURE
              sqlfclose;
 
              tsp_vf_bufaddr tct_long_lineaddr
 
.CM *-END-* synonym -------------------------------------
Author  : Kernighan / Plauger / Zabach / Nemack
.sp
.cp 3
Created : 1976 / 25.6.1981 // 01.08.1988
.sp
.cp 3
Version : 1996-11-14
.sp
.cp 3
Release :  6.2 	 Date : 1996-11-14
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.nf
PROGRAM    VCT41:
.sp 3
CALL    :  VCT41 xxxxxxxxxxxxxxxx
.sp
   with :  fn      Name of textfile which should be prepared
                   by VCT41. The filetype is 'VDN'.
.sp
           output  VCT41 generates file a like fn 'VDN'.
                   If errors were detected, an errormessage
                   will be written to the error file.
 
 
This module represents the user-interface.
.sp 2
The following commands may be processed by Miniscript. The commands
are described in the Miniscript-manual.
   .AD = adjust
   .BM = bottom margin
   .BB = block begin
   .BE = block end
   .BR = break
   .BT = bottom title
   .CC = change commandsign
   .CE = center
   .CI = catchword index
   .CM = comment
   .CN = chapterwise numbering
   .CP = conditional page
   .CW = catchword
   .DC = define catchword
   .DS = double space
   .FI = format
   .FM = footing margin
   .FO = format
   .FS = footing space
   .GC = glossary content
   .GL = glossary
   .HB = help text special behaviour begin
   .HE = help text special behaviour end
   .HI = hanging indent
   .HM = heading margin
   .HS = heading space
   .IN = indent
   .IM = input module
   .LL = line length
   .LS = line spacing
   .NF = no format
   .OC = overlay character
   .OF = offset
   .OP = odd page
   .PA = page eject
   .PB = pseudo blank
   .PL = page length
   .SB = section begin
   .SC = section content
   .SE = section end
   .SP = space
   .SS = single space
   .TM = top margin
   .TR = translate
   .TT = top title
   .UN = undent
.sp
Unknown commands will be indicated by error messages.
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.sp 2
PROCEDURE itoc:
.sp
The procedure ITOC converts the integer 'int' to a string with
printable characters. If the given integer is less than zero
it will be converted to a Raman-numeral. 'Size' specifies the length
for output on the string.
.sp 2
PROCEDURE putc_next:
.sp
The procedure PUTC writes the given character to the
outputbuffer. If the character is equal to carrige-return, the
outputbuffer will be written to the outputstream. Characters in
escape-format will be transformed to the defined charactersequence.
.sp 2
PROCEDURE s41pdec:
.sp
S41PDEC dumps the pagenumber as printable characters. A small pagenumber
will be dumped with leading spaces. The output will be performed by
the procedure PUTC.
.sp 2
PROCEDURE puttl:
.sp
PUTTL analyses the given line byte by byte and replaces the pagecount
instead of '%'. The pagecount will be replaced by the procedure s41pdec.
The characters will be printed by PUTC.
.sp 2
PROCEDURE skip:
.sp
SKIP determines the printer-control-character 'first' by using the given
parameter of linefeeds.
.sp 2
PROCEDURE phead:
.sp
PHEAD increments the pagecount and performs a formfeed. The blanklines
on top of page will be generated by using SKIP. The number of blanklines
is defined by m1val. The maximum seven headlines will be processed by
PUTTL. The following m2val blanklines will be generated.
.sp 2
PROCEDURE pfoot:
.sp
PFOOT will only work if a footline is wanted. In this case the length
of the footer must be greater than zero and ftval must be equal to one.
The m3val blanklines in front of the footline will be given out.
The footline will be given out by PUTTL.
.sp 2
PROCEDURE put_out_buf:
.sp
PUT_OUT_BUF causes on top of page the output of the headlines by
calling PHEAD. This happens, if lineno is greater than bottom or
lineno is equal to zero.
The outputline consists of the printer-control-character 'first',
followed by indenting the line by blanks and dumping the characters
by PUTC. If second equal true, the second outputbuffer 'outbuf2' will
also dumped by putc_next. It is necessary if underlining is swtiched on.
When the last textline is reached the procedure pfoot is called for
break down the page.
.sp 2
PROCEDURE out_one_line:
.sp
OUT_ONE_LINE puts out one line by calling PUT_OUT_BUF and variables
were initialized.
.sp 2
PROCEDURE leadbl:
.sp
LEADBL determines the numbers of blanks, which must be inserted at the
beginning of the line. The variable 'tival' contains the number of
blanks. The following text is moved to the beginning of the line.
.sp 2
PROCEDURE scopy:
.sp
SCOPY appends the word in line SLN to TLN. SPOS and TPOS specify the
startpositions of the lines, SLN and TLN. UNDERLINE controls the
generating of underlined words.
.sp 2
PROCEDURE underl:
.sp
UNDERL underlines a line from the position pos. The output is written
to the outputbuffer outbuf2.
.sp 2
FUNCTION width:
.sp
WITH counts the number of bytes of the given string, which were used
for printing the string.
.sp 2
FUNCTION give_number:
.sp
The function GIVE_NUMBER returns for a printable
hexadecimal digit its value.
.sp 2
FUNCTION getwrd:
.sp
GETWRD searches the next word on the line. The search starts at
position 'pos'. Blanks will be skipped. The characters were
moved to 'wrdbuf' and if necessary translated by TRANSLATE.
If the last character on line is a hyphen 'message', is set to true.
The functionresult is the length of wrdbuf.
.sp 2
FUNCTION wordlength:
.sp
The function WORDLENGTH counts the number of bytes of the word.
Charactersequences which must be translated will be considered.
.sp 2
PROCEDURE part:
.sp
This procedure determines the position of word, where it may be
splitted by dash. The first part of word is moved to 'part_of_word'
and the rest of word is moved to the begining of the line by SCOPY.
.sp 2
PROCEDURE spread:
.sp
SPREAD realizes the equalization of the margins by inserting spaces
behind a space.
.sp 2
PROCEDURE textout:
.sp
TEXTOUT detects the number of blanks, which must be inserted to equalize
the margins. PART may be called for getting a word, which can splitted
into two parts by dash. The line is given out by OUT_ONE_LINE.
.sp 2
PROCEDURE putwrd:
.sp
PUTWRD puts the given word on 'outbuf'. If the length of 'outbuf' was
greater than the maximum linelength for outputline, TEXTOUT will be
called.
.sp 2
PROCEDURE translate:
.sp
TRANSLATE replaces the characters after '??' with the charactersequence,
which is specified by the command '.tr'.
.sp 2
PROCEDURE text_p:
.sp
TEXT_P processes a line of text. It controls intending, centering,
underlining, formating and translation.
.sp 2
PROCEDURE gettl:
.sp
GETTL processes a top title line. It will separate the three textparts,
which are separated by '$'. Blanks will be skipped. The textparts will
be copied to special buffer in the special format. The length of
the buffer is constant, also as margins are changed. Pagenumbering
is realized by reserving space behind the positon of the
pagenumbersymbol, which was found on the top title or bottom line.
.sp 2
PROCEDURE condpag:
.sp
CONDPAG performs a conditional formfeed if the number of lines, which
can be placed on page, is less than the given integer. The formfeed
will be performed by calling PFOOT.
.sp 2
PROCEDURE space_lines:
.sp
SPACE_LINES works only if the end of page isn't reached. If the
end of page is reached after it works, PFOOT will be called.
.sp 2
PROCEDURE setval:
.sp
SETVAL initializes the given parameters.
.sp 2
FUNCTION ctoi:
.sp
CTOI converts hexadecimal or decimal characters to an integer.
Hexadecimals must start with 'h' or 'H'.
.sp 2
PROCEDURE skipbl:
.sp
SKIPBL skips blanks and returns the position of a character on line,
which differs to 'tab' and blank.
.sp 2
FUNCTION getval:
.sp
GETVAL gets the value of the command. The value will be converted
by CTOI.
.sp 2
PROCEDURE put_int:
.sp
PUT_INT puts an integer at the specified position.
.sp2
PROCEDURE section_begin:
.sp
SECTION_BEGIN detects the next chapternumber and puts it behind the
last ';' on the actual line.
.sp 2
FUNCTION str_to_int:
.sp
STR_TO_INT converts a string specified by 'pos' on 'ln' to an integer,
which is functionresult.
.sp 2
PROCEDURE summary_dump:
.sp
SUMMARY_DUMP reads all lines of the summary-file. The lines were copied
to the script outputfile.
.sp 2
PROCEDURE save_rest:
.sp
SAVE_REST writes the rest of the line to the glossary-file. The beginning
is specified by 'pos'.
.sp 2
PROCEDURE setnewchar:
.sp
SETNEWCHAR inserts the parameters of '.tr' into a table.
.sp 2
PROCEDURE get_wordposition:
.sp
GET_WORDPOSITION searches for a catched word.
.sp 2
PROCEDURE catchword:
.sp
CATCHWORD inserts the word into a tree for the glossary.
.sp 2
PROCEDURE catchword_index:
.sp
CATCHWORD_INDEX adds a pagenumber to the word in the tree. The
pagenumbers of one word are distinct.
.sp 2
FUNCTION comtyp:
.sp
COMTYP analyses the command and returns the command-number.
.sp 2
PROCEDURE one_command:
.sp
The procedure ONE_COMMAND processes one command at a time. The command
is given by the line and interpreted by calling the function COMTYP.
COMTYP returns the actual command, which will be processed. The
parameters of the command were got by function GETVAL.
.sp 2
PROCEDURE init:
.sp
INIT initializes all variables and calls some special initial-procedures.
.sp 2
PROCEDURE process_line:
.sp
PROCESS_LINE processes the given line. Commands will be interpreted
by ONE_COMMAND and the text will be processed by TEXT_P.
.sp 2
PROCEDURE f_flush:
.sp
FFLUSH flushes the outputbuffer 'oline', if it isn't empty.
.sp 2
PROCEDURE sequential_program:
.sp
This is the main procedure of vct41. First is the initial-procedure
INIT called. After reading and processing the IMFILE line by line the
script inputfile will be processed. The processing happens by
procedure PROCESS_LINE. The page will be finished and all files were
closed.
.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
      (* Die Versionsnummer wird mit dem SCRIPT-Kommando '.vs' in die *)
      (* Fehlerdatei geschrieben. Sie erscheint nicht im Text.        *)
      n_vct_version   = 'SCRIPT  3.26      ';
      n_vct_date      = ' 1993-06-02       ';
      n_new         = '|';
      nl_0          = '+';
      nl_1          = ' ';
      nl_2          = '0';
      nl_3          = '-';
      ff            = '1';
&     IF $OS IN [  VMSP, VMS  ]
      cr            = '0d'xc;
&     ELSE
&     IF $OS = MSDOS
      cr            = '\015';
&     ELSE
      cr            = '\0d';
&     ENDIF
&     ENDIF
      pagenum       = '%';
      question_mark = '?';
      maxout        = mxct_longline;
      pagelen       = 66;
      pagewidth     = 70;
      huge          = 133;
      single_quote  = '''';
      underscore    = '_';
      maxpagepos    = 50;
      c_lineno_init = 1000;
 
TYPE
      maxcharschar = PACKED ARRAY [ 1..cct_maxchars ] OF char;
 
      n_char       = RECORD
            length : tsp_int2;
            nc     : PACKED ARRAY [ 1..10 ] OF char;
      END;
 
      new_char     = PACKED ARRAY [ 0..255 ] OF n_char;
      one_word     = PACKED ARRAY [ 1..cct_maxwlength ] OF char;
      wpptr        = ^wpages;
 
      wpages       = RECORD
            parr   : ARRAY [ 1..cct_maxpageno ] OF tsp_int2;
            pcount : tsp_int2;
            pdefine: boolean;
            pfill  : boolean;
            ppoint : wpptr;
      END;
 
      wwptr        = ^wword;
 
      wword         = RECORD
            aword   : one_word;
            outword : one_word;
            wordlen : tsp_int2;
            difflen : tsp_int2;
            apages  : wpptr;
            nword   : wwptr
      END;
 
      tp_command    = (c_unknown, c_ad, c_bb, c_be,
            c_bm, c_br, c_bt, c_cc, c_ce,
            c_ci, c_cm, c_cn, c_cp, c_dc, c_ds, c_fi, c_fm, c_fo,
            c_fs, c_gc, c_gl, c_hb, c_he, c_hi, c_hm, c_hs,
            c_im, c_inconst, c_ll, c_ls, c_nb, c_nd, c_ne, c_nf,
            c_oc, c_ofconst, c_op, c_pa, c_pb, c_pl, c_sb, c_sc,
            c_se, c_sn, c_sp, c_ss, c_tm, c_tr, c_tt, c_un, c_vs, c_cw);
 
      c41_glob_tp            = RECORD
            inputbuf       : tct_long_line;
            oline          : tct_long_line;
            oln2           : tct_long_line;
            footer         : ARRAY  [ 1..2 ]  OF tct_long_line;
            outbuf2        : tct_long_line;
            outbuf         : tct_long_line;
            header         : ARRAY  [ 1..7 ]  OF tct_long_line;
            blankline      : tct_long_line;
            hline          : tct_long_line;
            block          : ARRAY  [ 1..72 ] OF tct_long_line;
            s40            : tsp_c40;
            lsval          : tsp_int2;
            lineno         : tsp_int2;
            bottom         : tsp_int2;
            inval          : tsp_int2;
            rmval          : tsp_int2;
            tival          : tsp_int2;
            adval          : tsp_int2;
            ofval          : tsp_int2;
            hival          : tsp_int2;
            ceval          : tsp_int2;
            ulval          : tsp_int2;
            curpag         : tsp_int2;
            newpag         : tsp_int2;
            plval          : tsp_int2;
            m1val          : tsp_int2;
            m2val          : tsp_int2;
            m3val          : tsp_int2;
            m4val          : tsp_int2;
            ttval          : tsp_int2;
            tmval          : tsp_int2;
            bmval          : tsp_int2;
            ftval          : tsp_int2;
            ndval          : tsp_int2;
            outp           : tsp_int2;
            outwds         : tsp_int2;
            dir            : tsp_int2;
            strlength      : tsp_int2;
            l_outbuf       : tsp_int2;
            linecount      : tsp_int2;
            notelevel      : tsp_int2;
            act_level      : tsp_int2;
            max_level      : tsp_int2;
            blocklines     : tsp_int2;
            blocklength    : tsp_int2;
            c41_i          : tsp_int2;
            filler         : tsp_int2;
            to_fill        : boolean;
            second         : boolean;
            print_summary  : boolean;
            contrcr        : boolean;
            chn            : boolean;
            notice         : boolean;
            blockinput     : boolean;
            blockoutput    : boolean;
            tab            : char;
            esc            : char;
            nullchar       : char;
            first          : char;
            pseudoblank    : char;
            command        : char;
            backspace      : char;
            hyphen         : char;
            catchwfound    : boolean;
            lineend        : boolean;
            level          : PACKED ARRAY [ 1..10 ] OF tsp_int2;
            newchar        : new_char;
            pagepos        : ARRAY [ 1..maxpagepos ] OF wpptr;
            cntpagepos     : tsp_int2;
            catchwinline   : tsp_int2;
            cwmaxlen       : tsp_int2;
            llval          : tsp_int2;
            catchwarr      : ARRAY [ 0..255 ] OF wwptr;
            dummy_nvers    : tsp_name;
            new_text       : boolean;
            escape         : boolean;
            h_line         : tct_longline;
            dummy_ndate    : tsp_name;
            section_number : tsp_int2;
            inp_filename   : tsp_vfilename;
            help_text      : boolean;
      END;
 
 
VAR
      c41_glob : c41_glob_tp;
      c41_err  : tct_errortext;
 
 
(*------------------------------*) 
 
PROCEDURE
      itoc (int     : integer;
            VAR str : maxcharschar;
            size    : integer);
 
VAR
      i      : integer;
      intval : integer;
 
BEGIN
i := 1;
WHILE i <= cct_maxchars DO
    BEGIN
    str[ i ] := bsp_c1;
    i        := i + 1
    END;
(*ENDWHILE*) 
IF  int < 0
THEN
    BEGIN
    i := int + 8;
    CASE i OF
        1 :
            str := '  i';
        2 :
            str := ' ii';
        3 :
            str := 'iii';
        4 :
            str := ' iv';
        5 :
            str := '  v';
        6 :
            str := ' vi';
        7 :
            str := 'vii';
        OTHERWISE
            ;
        END;
    (*ENDCASE*) 
    END
ELSE
    BEGIN
    i      := size;
    intval := int;
    REPEAT
        str [ i ] := chr(ord('0') + (intval MOD 10));
        intval    := intval DIV 10;
        i         := i - 1
    UNTIL
        ((intval = 0) OR (i = 0));
    (*ENDREPEAT*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      putc_first (firstchar : char);
 
CONST
&     IF $OS = MSDOS
      c_lf = '\012'; (* ASCII linefeed *)
      c_ff = '\014';
&     ELSE
      c_lf = '\0a'; (* ASCII linefeed *)
      c_ff = '\0c';
&     ENDIF
 
BEGIN
WITH c41_glob  DO
    IF  blockoutput
    THEN
        CASE firstchar OF
            ff :
                BEGIN
                END;
            nl_0 :
                BEGIN
                END;
            nl_1 :
                blocklength := succ(blocklength);
            nl_2 :
                blocklength := blocklength + 2;
            nl_3 :
                blocklength := blocklength + 3
            END;
        (*ENDCASE*) 
&   IF $OS IN [ WIN32, UNIX, MSDOS, OS2  ]
    (*ENDIF*) 
(*ENDWITH*) 
CASE firstchar OF
    ff   :
        putc_next (c_ff);
    nl_0 :
        BEGIN
        END;
    nl_1 :
        putc_next (bsp_c1);
    nl_2 :
        BEGIN
        putc_next (c_lf);
        putc_next (bsp_c1);
        END;
    nl_3 :
        BEGIN
&       IF $OS = MSDOS
        sqlabort;
&       ELSE
        putc_next (c_lf);
        putc_next (c_lf);
        putc_next (bsp_c1);
        putc_next (bsp_c1);
&       ENDIF
        END;
    END;
(*ENDCASE*) 
&ELSE
putc_next (firstchar);
&ENDIF
END;
 
(*------------------------------*) 
 
PROCEDURE
      putc_next (c : char);
 
VAR
      i : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
&   IFDEF DEBUG
    writeln ('putc_next (',c,') = ', ord(c):3, '  oline : ',oline.len:2,
          '>',oline.l:oline.len,'<');
&   ENDIF
    IF  contrcr
    THEN
        BEGIN
        contrcr := false;
        IF  blockoutput
        THEN
            BEGIN
            IF  blocklines = 0
            THEN
                c02vfwrite (c44outfileno, oline)
            ELSE
                BEGIN
                IF  ((blocklength > bottom + 1 - (m1val + m2val + ttval)) OR
                    (blocklines > 72))
                THEN
                    sqlabort;
                (*ENDIF*) 
                block[ blocklines ].l   := oline.l;
                block[ blocklines ].len := oline.len;
                END;
            (*ENDIF*) 
            blocklines := succ(blocklines);
            END
        ELSE
            c02vfwrite (c44outfileno, oline);
        (*ENDIF*) 
        oline.l[ 1 ] := c;
        oline.len    := 1;
        c            := bsp_c1;
        END;
    (*ENDIF*) 
    IF  ((oline.len >= maxout) OR (c = cr))
    THEN
        BEGIN
        contrcr := true;
        END;
    (*ENDIF*) 
    IF  c <> cr
    THEN
        BEGIN
        IF  c = pseudoblank
        THEN
            BEGIN
            oline.len            := oline.len + 1;
            oline.l[ oline.len ] := bsp_c1;
            END
        ELSE
            IF  c = esc
            THEN
                escape := true
            ELSE
                IF  c <> nullchar
                THEN
                    IF  escape
                    THEN
                        BEGIN
                        i := 1;
                        WHILE newchar[ ord(c) ].nc[ i ] <> nullchar DO
                            BEGIN
                            oline.len            := oline.len + 1;
                            oline.l[ oline.len ] :=
                                  newchar[ ord(c) ].nc[ i ];
                            i := succ(i);
                            END;
                        (*ENDWHILE*) 
                        escape := false;
                        END
                    ELSE
                        BEGIN
                        oline.len            := oline.len + 1;
                        oline.l[ oline.len ] := c;
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s41pdec (n : integer;
            len : integer);
 
VAR
      i     : integer;
      chars : maxcharschar;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    itoc (n,chars,len);
    i := 1;
    WHILE i <= len DO
        BEGIN
        putc_next (chars[ i ]);
        i := i + 1
        END
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      puttl (VAR ln  : tct_long_line;
            pageno : integer);
 
VAR
      i : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
&   IFDEF DEBUG
    writeln ('puttl (',ln.len:2,'>',ln.l:ln.len,'<');
&   ENDIF
    escape := false;
    putc_first (first);
    first := nl_1;
    i     := 1;
    WHILE i <= adval DO
        BEGIN
        putc_next (bsp_c1);
        i := i + 1
        END;
    (*ENDWHILE*) 
    i := 1;
    WHILE (i <= ln.len) DO
        BEGIN
        IF  ln.l[ i ] = pagenum
        THEN
            IF  NOT chn
            THEN
                s41pdec (pageno, cct_maxchars)
            ELSE
                IF  pageno < 0
                THEN
                    BEGIN
                    putc_next(bsp_c1);
                    putc_next(bsp_c1);
                    s41pdec (pageno, cct_maxchars)
                    END
                ELSE
                    BEGIN
                    s41pdec (notelevel, 2);
                    putc_next ('-');
                    s41pdec (pageno, 3)
                    END
                (*ENDIF*) 
            (*ENDIF*) 
        ELSE
            putc_next (ln.l[ i ]);
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    putc_next (cr)
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      skip (n : integer);
 
VAR
      i           : integer;
      l           : integer;
      putc_called : boolean;
 
BEGIN
WITH c41_glob  DO
    BEGIN
&   IFDEF DEBUG
    writeln ('skip (',n:2,')    lineno = ',lineno:3);
&   ENDIF
    IF  (lineno = c_lineno_init)
    THEN
        BEGIN
        lineno      := succ(lineno);
        putc_called := false;
        END
    ELSE
        putc_called := true;
    (*ENDIF*) 
    i := n;
    IF  first = nl_3
    THEN
        BEGIN
&       IF $OS = MSDOS
        i := 0;
        i := n DIV i;
&       ELSE
        i := i + 2
&             ENDIF
        END
    ELSE
        IF  first = nl_2
        THEN
            i := i + 1
        ELSE
            IF  first = ff
            THEN
                BEGIN
                putc_first (ff);
                putc_next (cr);
                putc_called := true;
                i           := i - 1
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    IF  new_text
    THEN
        WHILE i >= 1 DO
            BEGIN
            putc_first (bsp_c1);
            FOR l := 1 TO adval+rmval+1 DO
                putc_next (bsp_c1);
            (*ENDFOR*) 
            putc_next (n_new);
            putc_next (cr);
            putc_called := true;
            i           := i - 1
            END
        (*ENDWHILE*) 
    ELSE
&       IF $OS = MSDOS
        WHILE i >= 2 DO
            BEGIN
            putc_first (nl_2);
            putc_next (cr);
            putc_called := true;
            i           := i - 2
            END;
        (*ENDWHILE*) 
    (*ENDIF*) 
&   ELSE
    WHILE i >= 3 DO
        BEGIN
        putc_first (nl_3);
        putc_next (cr);
        putc_called := true;
        i           := i - 3
        END;
    (*ENDWHILE*) 
&   ENDIF
&   IFDEF DEBUG
    writeln ('skip  putc_called ',ord(putc_called):2);
&   ENDIF
    IF  NOT putc_called
    THEN
        putc_next (cr);
    (*ENDIF*) 
    IF  i = 2
    THEN
        first := nl_3
    ELSE
        IF  i = 1
        THEN
            first := nl_2
        ELSE
            first := nl_1;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      phead;
 
VAR
      j          : integer;
      m_new_text : boolean;
      m_blockoutput : boolean;
 
BEGIN
WITH c41_glob  DO
    BEGIN
&   IFDEF DEBUG
    writeln ('phead outbuf  = ',outbuf.len:2,'>',outbuf.l:outbuf.len,'<');
    writeln('phead outbuf2 = ',outbuf2.len:2,'>',outbuf2.l:outbuf2.len,'<');
    writeln ('puttl  ttval = ',ttval:3);
&   ENDIF
    m_blockoutput := blockoutput;
    blockoutput   := false;
    m_new_text    := new_text;
    new_text      := false;
    IF  ((notelevel <> level[ 1 ]) AND chn)
    THEN
        BEGIN
        notelevel := level[ 1 ];
        IF  newpag >= 0
        THEN
            newpag := 1
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  curpag <> 0
    THEN
        first := ff;
    (*ENDIF*) 
    curpag := newpag;
    newpag := newpag + 1;
    skip (m1val);
    IF  ttval > 0
    THEN
        BEGIN
        j := 1;
&       IFDEF DEBUG
        writeln ('phead  ttval = ',ttval:3);
&       ENDIF
        WHILE j <= ttval DO
            BEGIN
            puttl (header[ j ] ,curpag);
            first := nl_1;
            j     := j + 1
            END
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    skip (m2val);
    lineno      := m1val + m2val + ttval + 1;
    new_text    := m_new_text;
    blockoutput := m_blockoutput
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      pfoot;
 
VAR
      m_blockoutput : boolean;
      m_new_text    : boolean;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    m_blockoutput := blockoutput;
    blockoutput   := false;
    IF  (((footer[ 1 ].len = 0) AND (footer[ 2 ].len = 0)) OR (ftval = 0))
    THEN
        first := ff
    ELSE
        BEGIN
        (* the vertical bar which shows the text marked with .nb/.ne *)
        (* should not be printed in the space lines between the text *)
        (* area and the footing line *)
        m_new_text := new_text;
        new_text   := false;
        skip (m3val);
        new_text   := m_new_text;
        IF  ftval > 0
        THEN
            BEGIN
            puttl (footer[ 1 ], curpag);
            IF  ftval = 2
            THEN
                puttl (footer[ 2 ], curpag)
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    blockoutput := m_blockoutput
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_out_buf(VAR ln      : tct_long_line;
            pos         : integer;
            use_writeln : boolean);
 
VAR
      i       : integer;
      j       : integer;
      l       : integer;
      lendiff : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    lendiff := 0;
    IF  ((lineno = 0) OR ( lineno > bottom))
    THEN
        phead;
    (*ENDIF*) 
    IF  blockinput
    THEN
        c02vfwrite (c44outfileno, ln)
    ELSE
        BEGIN
        escape := false;
&       IF $OS in [ WIN32, MSDOS, OS2, UNIX ]
        CASE first OF
            nl_3 :
                lendiff := 3;
            nl_2 :
                lendiff := 1;
            OTHERWISE
                BEGIN
                END
            END;
        (*ENDCASE*) 
&       endif
        putc_first (first);
        l := tival + adval;
        s10mv2 (mxct_longline, mxct_longline,
              blankline.l, 1, oline.l, oline.len + 1, l);
        oline.len := oline.len + l;
        IF  NOT second
        THEN
            BEGIN
            IF  use_writeln
            THEN
                BEGIN
                IF  oline.len+ln.len > mxct_longline
                THEN
                    BEGIN
                    s40 := 'ERROR  too long input line    :         ';
                    s10mv3 (mxsp_c40, mxct_longline, s40, 1, hline.l, 1, 32);
                    c02int4to_line (linecount, false, 5, 32, hline.l);
                    hline.len := 36;
                    c02vfwrite (c44errfile, hline);
                    s40 := '  im File:                              ';
                    s10mv3 (mxsp_c40, mxct_longline, s40, 1, c41_glob.hline.l, 1, 11);
                    s10mv11(mxsp_vfilename, mxct_longline, c41_glob.inp_filename, 1,
                          c41_glob.hline.l, 12, 49);
                    c02int4to_line (c41_glob.linecount, false, 5, 56, c41_glob.hline.l);
                    c41_glob.hline.len := 60;
                    c02vfwrite (c44errfile, c41_glob.hline);
                    ln.len := 10
                    END;
                (*ENDIF*) 
                s10mv2 (mxct_longline, mxct_longline,
                      ln.l, 1, oline.l, oline.len + 1, ln.len);
                oline.len := oline.len + ln.len;
                IF  new_text
                THEN
                    BEGIN
                    l := rmval + lendiff - (oline.len-adval-2);
                    IF  l > 0
                    THEN
                        BEGIN
                        s10mv2 (mxct_longline, mxct_longline,
                              blankline.l, 1, oline.l, oline.len + 1, l);
                        oline.len := oline.len + l
                        END;
                    (*ENDIF*) 
                    oline.l[ oline.len+1 ] := bsp_c1;
                    oline.l[ oline.len+2 ] := n_new;
                    oline.len              := oline.len + 2
                    END;
                (*ENDIF*) 
                contrcr   := true
                END
            ELSE
                BEGIN
                FOR i := pos TO ln.len DO
                    putc_next (ln.l[ i ]);
                (*ENDFOR*) 
                IF  new_text
                THEN
                    BEGIN
                    l := rmval + lendiff - (oline.len-adval-2);
                    FOR i := 1 TO l+1 DO
                        putc_next (bsp_c1);
                    (*ENDFOR*) 
                    putc_next (n_new);
                    END;
                (*ENDIF*) 
                putc_next (cr)
                END
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            i := pos;
            WHILE (i <=  ln.len) DO
                BEGIN
                IF  ln.l[ i ] = esc
                THEN
                    BEGIN
                    escape         := true;
                    outbuf2.l[ i ] := chr(newchar[ ord(ln.l[ i + 1 ]) ].length - 1)
                    END
                ELSE
                    putc_next (ln.l[ i ]);
                (*ENDIF*) 
                i := i + 1
                END;
            (*ENDWHILE*) 
            IF  new_text
            THEN
                BEGIN
                l := rmval + lendiff - (oline.len-adval-2);
                FOR i := 1 TO l+1 DO
                    putc_next (bsp_c1);
                (*ENDFOR*) 
                putc_next (n_new)
                END;
&           IF $OS IN [  VMSP, VMS  ]
            (*ENDIF*) 
            putc_next (cr);
            putc_next (nl_0);
&           ELSE
            oline.len := succ(oline.len);
            oline.l[ oline.len ] := cr;
            putc_next (bsp_c1);
            putc_next (bsp_c1);
&           ENDIF
            l := tival + adval;
            i := pos;
            s10mv2 (mxct_longline, mxct_longline,
                  blankline.l, 1, oline.l, oline.len+1, l);
            oline.len := oline.len + l;
            WHILE (i <= outbuf2.len) DO
                BEGIN
                IF  ord(outbuf2.l[ i ]) < 11
                THEN
                    FOR j := 1 TO ord(outbuf2.l[ i ]) DO
                        putc_next(outbuf2.l[ i + 1 ])
                    (*ENDFOR*) 
                ELSE
                    putc_next (outbuf2.l[ i ]);
                (*ENDIF*) 
                outbuf2.l[ i ] := bsp_c1;
                i              := i + 1
                END;
            (*ENDWHILE*) 
            putc_next (cr);
            outbuf.l[ i ]  := bsp_c1;
            outbuf2.l[ i ] := bsp_c1;
            second         := false
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  NOT blockoutput
    THEN
        BEGIN
        IF  ((NOT to_fill) AND catchwfound)
        THEN
            BEGIN
            catchwfound  := false;
            catchwinline := cntpagepos;
            END;
        (*ENDIF*) 
        IF  catchwinline > 0
        THEN
            BEGIN
            FOR i := 1 TO catchwinline DO
                WITH pagepos[ i ]^ DO
                    IF  pdefine
                    THEN
                        IF  chn
                        THEN
                            parr[ pcount ] := -(notelevel * 1000 + curpag)
                        ELSE
                            parr[ pcount ] := -curpag
                        (*ENDIF*) 
                    ELSE
                        BEGIN
                        IF  chn
                        THEN
                            parr[ pcount ] := notelevel * 1000 + curpag
                        ELSE
                            parr[ pcount ] := curpag;
                        (*ENDIF*) 
                        IF  pcount > 1
                        THEN
                            IF  parr[ pcount-1 ] = -parr[ pcount ]
                            THEN
                                BEGIN
                                pcount := pred(pcount);
                                parr[ pcount ] := -abs(parr[ pcount ]);
                                (* define catchword-number has to be there *)
                                END
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDWITH*) 
            (*ENDFOR*) 
            IF  cntpagepos > catchwinline
            THEN
                FOR i := catchwinline + 1 TO cntpagepos DO
                    pagepos[ i - catchwinline ] := pagepos[ i ];
                (*ENDFOR*) 
            (*ENDIF*) 
            catchwinline := cntpagepos - catchwinline;
            cntpagepos   := catchwinline;
            catchwfound  := false;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  NOT blockinput
    THEN
        BEGIN
        IF  print_summary
        THEN
            BEGIN
            s10mv2 (mxct_longline, mxct_longline, blankline.l, 1,
                  oln2.l, oln2.len + 1, tival + adval);
            oln2.len := oln2.len + tival + adval;
            i        := ln.len - pos + 1;
            s10mv2 (mxct_longline,mxct_longline,ln.l,pos,oln2.l,oln2.len + 1, i);
            oln2.len := oln2.len + i;
            c02vfwrite (c44summary, oln2);
            ln.len   := 0;
            oln2.len := 0;
            END;
        (*ENDIF*) 
        tival := inval + ofval + hival;
        IF  ((lsval > bottom - lineno) AND (NOT blockoutput))
        THEN
            i := bottom - lineno
        ELSE
            i := lsval;
        (*ENDIF*) 
        IF  i = 0
        THEN
            first := nl_1
        ELSE
            IF  i = 1
            THEN
                first := nl_2
            ELSE
&               IF $OS = MSDOS
                skip (i);
            (*ENDIF*) 
        (*ENDIF*) 
&       ELSE
        IF  i = 2
        THEN
            first := nl_3
        ELSE
            skip (i);
        (*ENDIF*) 
&       ENDIF
        IF  NOT blockoutput
        THEN
            lineno := lineno + lsval + 1;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  lineno > bottom
    THEN
        pfoot
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      out_one_line;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  outp > 1
    THEN
        BEGIN
        outbuf.len  := outp - 1;
        outbuf2.len := outbuf.len;
        put_out_buf (outbuf, 1, false)
        END;
    (*ENDIF*) 
    outp        := 0;
    l_outbuf    := 0;
    outbuf.len  := 0;
    outbuf2.len := 0;
    outwds      := 0
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      leadbl (VAR ln  : tct_long_line;
            VAR pos : tsp_int2);
 
VAR
      j : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    out_one_line;
    ofval := 0;
    IF  to_fill = true
    THEN
        print_summary := false;
    (*ENDIF*) 
    WHILE ((pos <= ln.len) AND (ln.l[ pos ] = bsp_c1)) DO
        pos := pos + 1;
    (*ENDWHILE*) 
    IF  (pos <= ln.len)
    THEN
        tival := inval + hival + pos - 1;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      scopy (VAR sln    : tct_long_line;
            spos       : integer;
            VAR tln    : tct_long_line;
            tpos       : integer;
            underline  : boolean);
 
VAR
      i : integer;
      j : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    i := spos;
    j := tpos;
    IF  underline
    THEN
        BEGIN
        WHILE (i <= sln.len) DO
            BEGIN
            tln.l[ j ] := sln.l[ i ];
            IF  tln.l[ j ]  IN [ 'A'..'I','J'..'R','S'..'Z',
                'a'..'i','j'..'r','s'..'z','0'..'9' ]
            THEN
                outbuf2.l[ j ] := underscore
            ELSE
                outbuf2.l[ j ] := bsp_c1;
            (*ENDIF*) 
            j := j + 1;
            i := i + 1;
            END;
        (*ENDWHILE*) 
        tln.len        := j - 1;
        outbuf2.l[ j ] := bsp_c1;
        outbuf2.len    := j - 1;
        second         := true
        END
    ELSE
        BEGIN
        WHILE (i <= sln.len) DO
            BEGIN
            tln.l[ j ] := sln.l[ i ];
            j          := j + 1;
            i          := i + 1
            END;
        (*ENDWHILE*) 
        tln.len := j - 1;
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      underl (VAR ln  : tct_long_line;
            pos : integer);
 
VAR
      i : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    i := pos;
    WHILE ln.l[ i ] = bsp_c1 DO
        i := i + 1;
    (*ENDWHILE*) 
    WHILE (i <= ln.len) DO
        BEGIN
        IF  ln.l[ i ]  IN [ 'A'..'I','J'..'R','S'..'Z',
            'a'..'i','j'..'r','s'..'z','0'..'9' ]
        THEN
            outbuf2.l[ i ] := underscore
        ELSE
            IF  ln.l[ i ] = esc
            THEN
                outbuf2.l[ i ] := nullchar
            ELSE
                outbuf2.l[ i ] := bsp_c1;
            (*ENDIF*) 
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    outbuf2.len := i - 1;
    second      := true;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      width (VAR ln : tct_long_line) : integer;
 
VAR
      i    : integer;
      widt : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    widt := 0;
    i    := 1;
    WHILE (i <= ln.len) DO
        BEGIN
        IF  ln.l[ i ]  = backspace
        THEN
            widt := widt - 1
        ELSE
            widt := widt + 1;
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    width := widt
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      give_number (c : char) : integer;
 
VAR
      n : integer;
 
BEGIN
IF  (c >= '0') AND (c <= '9')
THEN
    n := ord(c) - ord('0')
ELSE
    IF  (c >= 'A') AND (c <= 'F')
    THEN
        n := ord(c) - ord('A') + 10
    ELSE
        IF  (c >= 'a') AND (c <= 'f')
        THEN
            n := ord(c) - ord('a') + 10
        ELSE
            n := -1;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
give_number := n;
END;
 
(*------------------------------*) 
 
FUNCTION
      getwrd (VAR ln      : tct_long_line;
            VAR pos     : tsp_int2;
            VAR wrdbuf  : tct_long_line;
            VAR message : boolean) : tsp_int4;
 
VAR
      j   : tsp_int4;
      ind : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    message := false;
    j       := 1;
    skipbl (ln,pos);
    WHILE   ((pos <= ln.len) AND (ln.l[ pos ] <> bsp_c1) AND
          (ln.l[ pos ] <> tab)) DO
        BEGIN
        IF  ln.l[ pos ] = question_mark
        THEN
            BEGIN
            pos := pos + 1;
            IF  pos > ln.len
            THEN
                BEGIN
                pos           := pos - 1;
                wrdbuf.l[ j ] := question_mark
                END
            ELSE
                IF  newchar[ ord(ln.l[ pos ]) ].length > 0
                THEN
                    BEGIN
                    wrdbuf.l[ j ] := esc;
                    j             := j + 1;
                    wrdbuf.l[ j ] := ln.l[ pos ]
                    END
                ELSE
                    wrdbuf.l[ j ] := ln.l[ pos ]
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            wrdbuf.l[ j ] := ln.l[ pos ];
        (*ENDIF*) 
        pos := pos + 1;
        j   := j + 1
        END;
    (*ENDWHILE*) 
    IF  j > 3
    THEN
        IF  ((wrdbuf.l[ j - 1 ] = hyphen) AND (wrdbuf.l[ j - 2 ]  <> hyphen))
        THEN
            message := true;
        (*ENDIF*) 
    (*ENDIF*) 
    wrdbuf.len := j - 1;
    getwrd     := j - 1;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      wordlength (VAR ln : tct_long_line) : integer;
 
VAR
      l       : integer;
      len     : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    l   := 0;
    len := 1;
    IF  (help_text AND
        ((ln.l[ 1 ] = '#') OR (ln.l[ 1 ] = '@')))
    THEN
        BEGIN
        len := 2;
        IF  ((ln.l[ 1 ] = '#') AND (ln.l[ 2 ] = '#'))
        THEN
            len := 3;
        (*ENDIF*) 
        WHILE ((len <= ln.len) AND
              (ln.l[ len ] >= '0') AND (ln.l[ len ] <= '9')) DO
            len := succ(len);
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    WHILE (len <= ln.len) DO
        BEGIN
        IF  ln.l[ len ] = esc
        THEN
            BEGIN
            len := len + 1;
            l   := l + newchar[ ord(ln.l[ len ]) ].length
            END
        ELSE
            l := l + 1;
        (*ENDIF*) 
        len := len + 1
        END;
    (*ENDWHILE*) 
    wordlength := l;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      part (VAR ln           : tct_long_line;
            VAR partlen      : tsp_int4;
            VAR part_of_word : tct_long_line;
            VAR wrdlen       : tsp_int4;
            VAR smaller      : boolean);
 
VAR
      i : integer;
      j : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    i := 1;
    WHILE i < partlen - 1 DO
        BEGIN
        IF  ln.l[ i ] = esc
        THEN
            partlen := partlen + 1;
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    smaller := false;
    WHILE ((i >= 3) AND (smaller = false)) DO
        BEGIN
        IF  ln.l[ i ] = hyphen
        THEN
            BEGIN
            partlen := i;
            smaller := true
            END;
        (*ENDIF*) 
        i := i - 1
        END;
    (*ENDWHILE*) 
    IF  smaller = true
    THEN
        IF  ((ln.l[ 1 ] = 'S') AND
            ( ln.l[ 2 ] = 'Q') AND
            ( ln.l[ 3 ] = 'L') AND
            ( ln.l[ 4 ] = hyphen) AND
            (((ln.l[ 5 ] = 'D') AND
            (  ln.l[ 6 ] = 'B'))
            OR
            (( ln.l[ 5 ] = 'P') AND
            (  ln.l[ 6 ] = 'L'))))
        THEN
            smaller := false
        ELSE
            BEGIN
            j := 1;
            i := 1;
            WHILE i <= partlen DO
                BEGIN
                part_of_word.l[ j ] := ln.l[ i ];
                j := j + 1;
                i := i + 1
                END;
            (*ENDWHILE*) 
            part_of_word.len := j - 1;
            scopy (ln,i,ln,1,false);
            wrdlen := ln.len;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      spread (VAR ln  : tct_long_line;
            outpos  : integer;
            nextra  : integer;
            outwds  : integer);
 
VAR
      i        : integer;
      j        : integer;
      nb       : integer;
      ne       : integer;
      nholes   : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  ((nextra > 0) AND (outwds > 1))
    THEN
        BEGIN
        dir    := 1 - dir;
        ne     := nextra;
        nholes := outwds - 1;
        i      := outpos - 1;
        IF  maxout - 2 > i + ne
        THEN
            j := i + ne
        ELSE
            j := maxout - 2;
        (*ENDIF*) 
        WHILE i < j DO
            BEGIN
            ln.l[ j ]      := ln.l[ i ];
            outbuf2.l[ j ] := outbuf2.l[ i ];
            IF  ln.l[ i ] = bsp_c1
            THEN
                BEGIN
                IF  dir = 0
                THEN
                    nb := (ne - 1) DIV nholes + 1
                ELSE
                    nb := ne DIV nholes;
                (*ENDIF*) 
                ne     := ne - nb;
                nholes := nholes - 1;
                WHILE nb > 0 DO
                    BEGIN
                    j              := j - 1;
                    ln.l[ j ]      := bsp_c1;
                    outbuf2.l[ j ] := bsp_c1;
                    nb             := nb - 1
                    END
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
            i := i - 1;
            j := j - 1
            END
        (*ENDWHILE*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      textout (count : integer;
            VAR wrdbuf : tct_long_line);
 
VAR
      nextra     : integer;
      partl      : tsp_int4;
      last       : integer;
      partwrd    : tct_long_line;
      part_found : boolean;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    nextra := llval - l_outbuf + 1;
    IF  count > 0
    THEN
        nextra := nextra + count - 1;
    (*ENDIF*) 
    IF  nextra >= 5
    THEN
        BEGIN
        partl := nextra;
        part (wrdbuf,partl,partwrd, wrdbuf.len, part_found);
        IF  part_found
        THEN
            BEGIN
            scopy (partwrd,1,outbuf,outp + 1 - count,ulval>0);
            outp := partl + outp + 1 - count;
            l_outbuf := l_outbuf + wordlength(partwrd) + 1 - count;
            IF  count = 0
            THEN
                outwds := outwds + 1;
            (*ENDIF*) 
            IF  (catchwfound AND (catchwinline < maxpagepos))
            THEN
                BEGIN
                catchwinline := succ(catchwinline);
                catchwfound  := false
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    nextra := llval - l_outbuf + 1;
    spread (outbuf,outp,nextra,outwds);
    IF  ((nextra > 0) AND (outwds > 1))
    THEN
        outp := outp + nextra;
    (*ENDIF*) 
    out_one_line;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      putwrd (VAR wrdbuf : tct_long_line;
            message : boolean);
 
VAR
      last    : integer;
      counter : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    last  := wordlength (wrdbuf) + l_outbuf + 1;
    llval := rmval - tival;
    IF  message
    THEN
        BEGIN
        counter := 2;
        IF  ((outp > 0) AND (last > llval + counter + 1))
        THEN
            BEGIN
            textout (counter,wrdbuf);
            last    := wordlength (wrdbuf) + 1;
            outwds  := 1;
            counter := 0
            END;
        (*ENDIF*) 
        IF  outp >= counter
        THEN
            outp := outp - counter;
        (*ENDIF*) 
        scopy (wrdbuf,1,outbuf,outp + 1,ulval>0);
        IF  outp > 0
        THEN
            l_outbuf := last - 2
        ELSE
            l_outbuf := last;
        (*ENDIF*) 
        outp              := outp + wrdbuf.len + 1;
        outbuf.l[ outp ]  := bsp_c1;
        outbuf2.l[ outp ] := bsp_c1;
        END
    ELSE
        BEGIN
        IF  ((outp > 0) AND (last > llval + 1))
        THEN
            BEGIN
            textout (0,wrdbuf);
            last := wordlength (wrdbuf) + 1
            END;
        (*ENDIF*) 
        scopy (wrdbuf,1,outbuf,outp + 1,ulval>0);
        outp              := outp + wrdbuf.len + 1;
        l_outbuf          := last;
        outbuf.l[ outp ]  := bsp_c1;
        outbuf2.l[ outp ] := bsp_c1;
        outwds            := outwds + 1;
        END;
    (*ENDIF*) 
    IF  ulval > 0
    THEN
        second := true;
    (*ENDIF*) 
    IF  (catchwfound AND (catchwinline < maxpagepos))
    THEN
        BEGIN
        catchwinline := succ(catchwinline);
        catchwfound  := false
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      translate (VAR ln     : tct_long_line;
            pos        : integer;
            VAR transl : boolean);
 
VAR
      i   : integer;
      j   : integer;
      ind : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    i      := pos;
    j      := pos;
    transl := false;
    WHILE (i <= ln.len) DO
        BEGIN
        IF  ln.l[ i ] = question_mark
        THEN
            BEGIN
            i := i + 1;
            IF  (i > ln.len)
            THEN
                BEGIN
                i         := i - 1;
                ln.l[ j ] := question_mark
                END
            ELSE
                BEGIN
                transl := true;
                IF  newchar[ ord(ln.l[ i ]) ].length > 0
                THEN
                    BEGIN
                    ln.l[ j ] := esc;
                    j         := j + 1;
                    ln.l[ j ] := ln.l[ i ]
                    END
                ELSE
                    ln.l[ j ] := ln.l[ i ]
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        ELSE
            ln.l[ j ] := ln.l[ i ];
        (*ENDIF*) 
        i := i + 1;
        j := j + 1
        END;
    (*ENDWHILE*) 
    ln.len := j - 1;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      text_p (VAR ln  : tct_long_line;
            VAR pos : tsp_int2);
 
VAR
      i       : tsp_int2;
      message : boolean;
      transl  : boolean;
      wrdbuf  : tct_long_line;
      k       : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  to_fill
    THEN
        IF  (ln.l[ pos ] = bsp_c1)
        THEN
            leadbl (ln, pos);
        (*ENDIF*) 
    (*ENDIF*) 
    IF  ceval > 0
    THEN
        BEGIN
        translate (ln, pos, transl);
        tival := (rmval - inval - (wordlength(ln) - pos + 1)) DIV 2 + inval;
        IF  tival < 0
        THEN
            tival := 0;
        (*ENDIF*) 
        IF  ulval > 0
        THEN
            underl (ln, pos);
        (*ENDIF*) 
        put_out_buf (ln, pos, false);
        ceval := ceval - 1
        END
    ELSE
        IF  ((pos = ln.len) AND (ln.l[ pos ] = bsp_c1))
        THEN
            BEGIN
            IF  ((lineno > bottom) OR ( lineno = 0))
            THEN
                phead;
            (*ENDIF*) 
            IF  NOT blockoutput
            THEN
                lineno := lineno + lsval + 1;
            (*ENDIF*) 
            IF  first <> ff
            THEN
                skip (1);
            (*ENDIF*) 
            IF  lineno > bottom
            THEN
                pfoot
            (*ENDIF*) 
            END
        ELSE
            IF  NOT to_fill
            THEN
                BEGIN
                translate (ln, pos, transl);
                IF  ulval > 0
                THEN
                    underl (ln, pos);
                (*ENDIF*) 
                IF  ((NOT transl) AND (ulval = 0) AND (pos = 1))
                THEN
                    put_out_buf (ln, pos, true)
                ELSE
                    put_out_buf (ln, pos, false)
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                i          := pos;
                wrdbuf.len := getwrd (ln,i,wrdbuf,message);
                WHILE (wrdbuf.len > 0) DO
                    BEGIN
                    putwrd (wrdbuf,notice);
                    IF  ((tival < inval) OR (ofval > 0) OR (hival > 0))
                    THEN
                        BEGIN
                        IF  (l_outbuf <= inval - tival)
                        THEN
                            BEGIN
                            WHILE (l_outbuf < inval - tival) DO
                                BEGIN
                                l_outbuf         := l_outbuf + 1;
                                outp             := outp + 1;
                                outbuf.l[ outp ] := bsp_c1
                                END;
                            (*ENDWHILE*) 
                            outwds := outwds - 1
                            END
                        ELSE
                            IF  (((l_outbuf <= ofval) OR (l_outbuf <= hival))
                                AND (tival < inval + ofval + hival))
                            THEN
                                BEGIN (*ofval or hival = 0*)
                                WHILE (l_outbuf < ofval + hival) DO
                                    BEGIN
                                    l_outbuf         := l_outbuf + 1;
                                    outp             := outp + 1;
                                    outbuf.l[ outp ] := bsp_c1
                                    END;
                                (*ENDWHILE*) 
                                outwds := outwds - 1
                                END
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    notice     := message;
                    wrdbuf.len := getwrd (ln,i,wrdbuf,message);
                    notice     := ((notice) AND (wrdbuf.len = 0));
                    END;
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    IF  ulval > 0
    THEN
        ulval := ulval - 1;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      gettl (VAR ln  : tct_long_line;
            pos     : integer;
            VAR ttl : tct_long_line);
 
VAR
      i        : tsp_int2;
      j        : integer;
      k        : integer;
      mx_len   : integer;
      partlen  : integer;
      ind      : integer;
      c        : char;
      ttext    : ARRAY[ 1..3 ] OF tct_longline;
      len      : ARRAY[ 1..3 ] OF integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    len[ 1 ] := 0;
    len[ 2 ] := 0;
    len[ 3 ] := 0;
    mx_len   := 0;
    i        := pos + 3;
    skipbl (ln,i);
    IF  ((ln.l[ i ] = '1') OR (ln.l[ i ] = '2') OR (ln.l[ i ] = '3') OR
        (ln.l[ i ] = '4') OR (ln.l[ i ] = '5') OR (ln.l[ i ] = '6') OR
        (ln.l[ i ] = '7'))
    THEN
        BEGIN
        i := i + 1;
        skipbl (ln,i)
        END;
    (*ENDIF*) 
    IF  (i <= ln.len)
    THEN
        BEGIN
        c := ln.l[ i ];
        i := i + 1;
        j := 1;
        WHILE ((j <= 3) AND (i <= ln.len)) DO
            BEGIN
            WHILE ((ln.l[ i ] <> c) AND (i <= ln.len)) DO
                BEGIN
                IF  ln.l[ i ] = pagenum
                THEN
                    IF  chn
                    THEN
                        mx_len := mx_len + 5
                    ELSE
                        mx_len := mx_len + 2;
                    (*ENDIF*) 
                (*ENDIF*) 
                len[ j ] := len[ j ] + 1;
                IF  ln.l[ i ] = question_mark
                THEN
                    BEGIN
                    i := i + 1;
                    IF  (i > ln.len)
                    THEN
                        BEGIN
                        i := i - 1;
                        ttext[ j, len[ j ] ] := question_mark
                        END
                    ELSE
                        IF  newchar[ ord(ln.l[ i ]) ].length > 0
                        THEN
                            BEGIN
                            ttext[ j, len[ j ] ] := esc;
                            len[ j ]             := len[ j ] + 1;
                            ttext[ j, len[ j ] ] := ln.l[ i ];
                            mx_len               := mx_len - 1;
                            END
                        ELSE
                            ttext[ j, len[ j ] ] := ln.l[ i ]
                        (*ENDIF*) 
                    (*ENDIF*) 
                    END
                ELSE
                    ttext[ j, len[ j ] ] := ln.l[ i ];
                (*ENDIF*) 
                i := i + 1
                END;
            (*ENDWHILE*) 
            IF  (i <= ln.len)
            THEN
                i := i + 1;
            (*ENDIF*) 
            mx_len := mx_len + len[ j ] ;
            j      := j + 1
            END;
        (*ENDWHILE*) 
        partlen := (rmval - mx_len) DIV 2;
        IF  partlen <= 0
        THEN
            BEGIN
            len[ 3 ] := len[ 3 ] + rmval - mx_len;
            IF  len[ 3 ] < 0
            THEN
                BEGIN
                len[ 2 ] := len[ 2 ] + len[ 3 ];
                IF  len[ 2 ] < 0
                THEN
                    len[ 1 ] := len[ 1 ] + len[ 2 ]
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            mx_len  := len[ 1 ] + len[ 2 ] + len[ 3 ];
            partlen := (rmval - mx_len) DIV 2
            END;
        (*ENDIF*) 
        j := 1;
        i := 1;
        WHILE j <= 3 DO
            BEGIN
            k := 1;
            WHILE k <= len [ j ]  DO
                BEGIN
                ttl.l[ i ] := ttext[ j,k ];
                k          := k + 1;
                i          := i + 1;
                END;
            (*ENDWHILE*) 
            IF  j < 3
            THEN
                BEGIN
                k := 1;
                WHILE k <= partlen DO
                    BEGIN
                    ttl.l[ i ] := bsp_c1;
                    k          := k + 1;
                    i          := i + 1;
                    END
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
            j := j + 1;
            partlen := rmval - mx_len - partlen
            END;
        (*ENDWHILE*) 
        ttl.len := i - 1;
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      condpag (n : integer);
 
BEGIN
WITH c41_glob  DO
    BEGIN
    out_one_line;
    IF  lineno <= bottom
    THEN
        IF  lineno + n * (lsval + 1) > bottom + 1
        THEN
            BEGIN
            IF  (((footer[ 1 ].len = 0) AND (footer[ 2 ].len = 0)) OR (ftval = 0))
            THEN
                first := ff
            ELSE
                BEGIN
                skip (bottom + 1 - lineno);
                pfoot
                END;
            (*ENDIF*) 
            lineno := lineno + n * (lsval + 1);
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      space_lines (n : integer);
 
BEGIN
WITH c41_glob  DO
    BEGIN
    out_one_line;
    IF  lineno <= bottom
    THEN
        BEGIN
        IF  ((n * (lsval + 1) > bottom + 1 - lineno) AND
            (NOT blockoutput))
        THEN
            IF  (((footer[ 1 ].len = 0) AND (footer[ 2 ].len = 0)) OR (ftval = 0))
            THEN
                first := ff
            ELSE
                skip (bottom + 1 - lineno)
            (*ENDIF*) 
        ELSE
            skip (n * (lsval + 1));
        (*ENDIF*) 
        IF  NOT blockoutput
        THEN
            lineno := lineno + n * (lsval + 1);
        (*ENDIF*) 
        IF  lineno > bottom
        THEN
            pfoot
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      setval (VAR param : tsp_int2;
            val       : integer;
            argtyp    : char;
            defval    : integer;
            minval    : integer;
            maxval    : integer;
            VAR right : boolean);
 
VAR
      helpparam : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  ((argtyp = cr) OR (argtyp = ';'))
    THEN
        helpparam := defval
    ELSE
        IF  argtyp = nl_0
        THEN
            helpparam := param + val
        ELSE
            IF  argtyp = nl_3
            THEN
                helpparam := param - val
            ELSE
                helpparam := val;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    param := helpparam;
    IF  helpparam > maxval
    THEN
        param := maxval
    ELSE
        IF  helpparam < minval
        THEN
            param := minval;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  param = helpparam
    THEN
        right := true
    ELSE
        right := false
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ctoi (VAR ln : tct_long_line;
            VAR i  : tsp_int2) : integer;
 
VAR
      mul    : integer;
      result : integer;
      d      : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    skipbl (ln,i);
    result := 0;
    d      := 1;
    IF  ((ln.l[ i ] = 'h') OR (ln.l[ i ] = 'H'))
    THEN
        BEGIN
        i   := i + 1;
        mul := 16
        END
    ELSE
        mul := 10;
    (*ENDIF*) 
    WHILE ((i <= ln.len) AND (ln.l[ i ] <> ';') AND (d > -1)) DO
        BEGIN
        d := give_number (ln.l[ i ]);
        IF  d > -1
        THEN
            result := mul * result + d;
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    ctoi := result
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      skipbl (VAR ln  : tct_long_line;
            VAR pos : tsp_int2);
 
BEGIN
WITH c41_glob  DO
    BEGIN
    WHILE (((ln.l[ pos ] = bsp_c1) OR (ln.l[ pos ] = tab))
          AND (pos <= ln.len)) DO
        pos := pos + 1
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      getval (VAR ln  : tct_long_line;
            pos : integer;
            VAR argtyp : char) : integer;
 
VAR
      i : tsp_int2;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    i := pos;
    WHILE ((i <= ln.len) AND (ln.l[ i ]  <> ';') AND
          (ln.l[ i ] <> bsp_c1) AND (ln.l[ i ] <> tab)) DO
        i := i + 1;
    (*ENDWHILE*) 
    skipbl (ln, i);
    IF  (i <= ln.len)
    THEN
        argtyp := ln.l[ i ]
    ELSE
        argtyp := cr;
    (*ENDIF*) 
    IF  ((argtyp = nl_0) OR (argtyp = nl_3))
    THEN
        i := i + 1;
    (*ENDIF*) 
    IF  ((argtyp = single_quote) AND
        ((((ln.l[ pos + 1 ] = 'P') OR (ln.l[ pos + 1 ] = 'p'))
        AND ((ln.l[ pos + 2 ] = 'B') OR (ln.l[ pos + 2 ] = 'b')))
        OR (((ln.l[ pos + 1 ] = 'C') OR (ln.l[ pos + 1 ] = 'c'))
        AND ((ln.l[ pos + 2 ] = 'C') OR (ln.l[ pos + 2 ] = 'c')))))
    THEN
        BEGIN
        i := i + 3;
        getval := ord(ln.l[ i - 2 ])
        END
    ELSE
        getval := ctoi (ln,i)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_int (VAR s30 : tsp_c30;
            VAR sl : tsp_int2;
            val : integer);
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  val < 10
    THEN
        BEGIN
        s30[ sl ] := chr(val + ord('0'));
        sl        := sl + 1
        END
    ELSE
        IF  val < 100
        THEN
            BEGIN
            s30[ sl ]     := chr(val DIV 10 + ord('0'));
            s30[ sl + 1 ] := chr(val MOD 10 + ord('0'));
            sl            := sl + 2
            END
        ELSE
            BEGIN
            s30[ sl ]     := chr(val DIV 100 + ord('0'));
            s30[ sl + 1 ] := chr((val MOD 100) DIV 10 + ord('0'));
            s30[ sl + 2 ] := chr(val MOD 10 + ord('0'));
            sl            := sl + 3
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      section_begin (VAR inbuf : tct_long_line;
            VAR valok : boolean);
 
VAR
      i   : integer;
      j   : integer;
      sl  : tsp_int2;
      s30 : tsp_c30;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    oln2.len           := oln2.len + 1;
    oln2.l[ oln2.len ] := '.';
    IF  lineno > bottom
    THEN
        BEGIN
        IF  chn
        THEN
            BEGIN
            c02int4to_line(level[ 1 ],true,6,oln2.len + 1,oln2.l);
            oln2.len           := oln2.len + 7;
            oln2.l[ oln2.len ] := '-';
            END;
        (*ENDIF*) 
        IF  (chn AND (act_level = 0))
        THEN
            BEGIN
            c02int4to_line(1,true,6,oln2.len + 1,oln2.l);
            oln2.len := oln2.len + 6;
            END
        ELSE
            BEGIN
            c02int4to_line(newpag,true,6,oln2.len + 1,oln2.l);
            oln2.len := oln2.len + 6;
            END;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        IF  chn
        THEN
            BEGIN
            c02int4to_line(notelevel,true,6,oln2.len + 1,oln2.l);
            oln2.len           := oln2.len + 7;
            oln2.l[ oln2.len ] := '-';
            END;
        (*ENDIF*) 
        c02int4to_line(curpag,true,6,oln2.len + 1,oln2.l);
        oln2.len := oln2.len + 6;
        END;
    (*ENDIF*) 
    oln2.len           := oln2.len + 1;
    oln2.l[ oln2.len ] := bsp_c1;
    act_level          := act_level + 1;
    i                  := 1;
    sl                 := 1;
    s30                := '                              ';
    WHILE i < act_level DO
        BEGIN
        put_int (s30, sl, level[ i ]);
        s30[ sl ] := '.';
        sl        := sl + 1;
        i         := i + 1
        END;
    (*ENDWHILE*) 
    put_int (s30, sl, level[ act_level ]);
    IF  sl > max_level
    THEN
        max_level := sl;
    (*ENDIF*) 
    IF  sl < inval
    THEN
        sl := inval;
    (*ENDIF*) 
    i := inbuf.len;
    WHILE ((inbuf.l[ i ] <> ';') AND (i > 1)) DO
        BEGIN
        inbuf.l[ i + sl ] := inbuf.l[ i ];
        i                 := i - 1
        END;
    (*ENDWHILE*) 
    inbuf.len := inbuf.len + sl;
    IF  i = 1
    THEN
        valok := false
    ELSE
        BEGIN
        FOR j := 1 TO sl DO
            inbuf.l[ j + i ] := s30[ j ];
        (*ENDFOR*) 
        print_summary := true
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      str_to_int (VAR ln  : tct_long_line;
            VAR pos : tsp_int2) : integer;
 
VAR
      i : integer;
      j : integer;
 
BEGIN
i := 0;
IF  (ln.l[ pos ] = '-')
THEN
    BEGIN
    j   := -1;
    pos := pos + 1;
    END
ELSE
    j := 1;
(*ENDIF*) 
WHILE ((pos <= ln.len) AND
      (ln.l[ pos ] >= '0') AND (ln.l[ pos ] <= '9')) DO
    BEGIN
    i   := (i * 10) + ord(ln.l[ pos ]) - ord('0');
    pos := pos + 1;
    END;
(*ENDWHILE*) 
str_to_int := i * j;
END;
 
(*------------------------------*) 
 
PROCEDURE
      c44_summary_dump;
 
VAR
      i            : integer;
      j            : integer;
      k            : integer;
      m            : integer;
      n            : integer;
      sl           : integer;
      pos          : tsp_int2;
      one_finished : boolean;
      s30          : tsp_c30;
      es_cape      : boolean;
      ln           : tct_long_line;
      vf_ret       : tsp_vf_return;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    oln2.len           := oln2.len + 1;
    oln2.l[ oln2.len ] := '$';
    c02vfwrite (c44summary, oln2);
    oln2.len := 0;
    c44makereset;
    vf_ret := c02getline(c44summary, ln);
    WHILE ((vf_ret = vf_ok) AND (ln.l[ 1 ] <> '$')) DO
        BEGIN
        pos := 2;
        n   := str_to_int (ln, pos);
        WHILE (pos < ln.len) AND (ln.l[ pos ] = bsp_c1) DO
            pos := pos + 1;
        (*ENDWHILE*) 
        IF  n = -1000
        THEN
            BEGIN
            IF  ln.l[ pos ] <> '$'
            THEN
                BEGIN
                pos := pos + 1;
                n   := str_to_int (ln, pos);
                IF  lineno > bottom
                THEN
                    BEGIN
                    phead;
                    putc_first (first);
                    END
                ELSE
                    putc_next (bsp_c1);
                (*ENDIF*) 
                putc_next(cr);
                lineno := lineno + 1
                END
            ELSE
                BEGIN
                pos := pos + 1;
                IF  (pos > ln.len)
                THEN
                    vf_ret := c02getline (c44summary, ln);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (vf_ret = vf_ok)
        THEN
            BEGIN
            IF  ln.l[ pos ] = '$'
            THEN
                space_lines (huge)
            ELSE
                BEGIN
                IF  lineno > bottom
                THEN
                    BEGIN
                    phead;
                    putc_first (first);
                    END
                ELSE
                    putc_next (bsp_c1);
                (*ENDIF*) 
                IF  chn
                THEN
                    BEGIN
                    pos := pos + 2;
                    m   := str_to_int (ln, pos);
                    END;
                (*ENDIF*) 
                k   := 0;
                WHILE ln.l[ pos ] = bsp_c1 DO
                    pos := pos + 1;
                (*ENDWHILE*) 
                FOR i := 1 TO inval + adval DO
                    BEGIN
                    k := k + 1;
                    putc_next (bsp_c1)
                    END;
                (*ENDFOR*) 
                i := 0;
                WHILE (pos <= ln.len) AND (ln.l[ pos ] <> bsp_c1) DO
                    BEGIN
                    putc_next (ln.l[ pos ]);
                    pos := pos + 1;
                    i   := i + 1;
                    END;
                (*ENDWHILE*) 
                FOR j := i + 1 TO max_level DO
                    putc_next (bsp_c1);
                (*ENDFOR*) 
                WHILE ln.l[ pos ] = bsp_c1 DO
                    pos := pos + 1;
                (*ENDWHILE*) 
                j            := max_level + k;
                one_finished := false;
                WHILE NOT one_finished DO
                    BEGIN
                    es_cape := false;
                    IF  ln.l[ pos ] = esc
                    THEN
                        es_cape := true
                    ELSE
                        j := j + 1;
                    (*ENDIF*) 
                    putc_next (ln.l[ pos ]);
                    WHILE (pos < ln.len) DO
                        BEGIN
                        pos := pos + 1;
                        IF  ln.l[ pos ] = esc
                        THEN
                            es_cape := true
                        ELSE
                            IF  es_cape
                            THEN
                                BEGIN
                                j       := j + newchar[ ord(ln.l[ pos ]) ].length;
                                es_cape := false
                                END
                            ELSE
                                j := j + 1;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        putc_next (ln.l[ pos ]);
                        END;
                    (*ENDWHILE*) 
                    vf_ret := c02getline (c44summary, ln);
                    pos    := 1;
                    IF  ((ln.l[ pos ] <> '.') AND (ln.l[ pos ] <> '$'))
                    THEN
                        BEGIN
                        putc_next (cr);
                        lineno := lineno + 1;
                        IF  lineno > bottom
                        THEN
                            BEGIN
                            phead;
                            putc_first (first);
                            END
                        ELSE
                            putc_next (bsp_c1);
                        (*ENDIF*) 
                        FOR j := 1 TO max_level + inval + adval DO
                            putc_next (bsp_c1);
                        (*ENDFOR*) 
                        pos := pos + 1;
                        WHILE ln.l[ pos ] = bsp_c1 DO
                            pos := pos + 1;
                        (*ENDWHILE*) 
                        j := max_level + inval + adval
                        END
                    ELSE
                        one_finished := true
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
                putc_next ('.');
                IF  chn
                THEN
                    j := j + 3;
                (*ENDIF*) 
                FOR i := j + 2 TO rmval - cct_maxchars + adval DO
                    putc_next ('.');
                (*ENDFOR*) 
                IF  chn
                THEN
                    BEGIN
                    s41pdec(n, 2);
                    putc_next('-');
                    s41pdec(m, 3)
                    END
                ELSE
                    s41pdec (n, cct_maxchars);
                (*ENDIF*) 
                putc_next (cr);
                lineno := lineno + 1;
                IF  (lineno > bottom)
                THEN
                    pfoot
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    space_lines (huge)
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      save_rest(VAR ln     : tct_long_line;
            pos        : integer;
            VAR norest : boolean);
 
VAR
      i : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    i := pos;
    WHILE ((ln.l[ i ] <> ';') AND (i <= ln.len)) DO
        i := succ(i);
    (*ENDWHILE*) 
    IF  i < ln.len
    THEN
        BEGIN
        hline.len := ln.len - i;
        s10mv2 (mxct_longline, mxct_longline,
              ln.l, i + 1, hline.l, 1, hline.len);
        c02vfwrite (c44glossar, hline);
        END;
    (*ENDIF*) 
    norest := true
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      setnewchar (VAR ln : tct_long_line;
            val    : integer);
 
VAR
      i : tsp_int2;
      j : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    i := 4;
    WHILE ln.l[ i ] = bsp_c1 DO
        i := i + 1;
    (*ENDWHILE*) 
    WHILE ln.l[ i ] <> bsp_c1 DO
        i := i + 1;
    (*ENDWHILE*) 
    newchar[ val ].length := ctoi (ln, i);
    j := 1;
    WHILE (i <= ln.len) DO
        BEGIN
        newchar[ val ].nc[ j ] := chr(ctoi(ln,i));
        j := j + 1
        END;
    (*ENDWHILE*) 
    newchar[ val ].nc[ j ] := nullchar;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      get_wordposition (VAR actword : one_word;
            VAR outword : one_word;
            wordl       : integer;
            diffl       : integer;
            tp_com      : tp_command);
 
VAR
      pos       : integer;
      prev      : wwptr;
      next      : wwptr;
      neww      : wwptr;
      lc_result : tsp_lcomp_result;
      prevpages : wpptr;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  (cntpagepos < maxpagepos)
    THEN
        BEGIN
        pos  := ord(actword[ 1 ]);
        prev := catchwarr[ pos ];
        IF  prev = NIL
        THEN
            BEGIN
            new (prev);
            catchwarr[ pos ] := prev;
            prev^.nword      := NIL;
            lc_result        := l_less
            END
        ELSE
            BEGIN
            next := prev;
            REPEAT
                s30lcm (actword, 1, cct_maxwlength,
                      next^.aword, 1, cct_maxwlength, lc_result);
                IF  lc_result = l_greater
                THEN
                    BEGIN
                    prev := next;
                    next := next^.nword
                    END
                (*ENDIF*) 
            UNTIL
                ((lc_result IN [ l_less, l_equal ]) OR (next = NIL));
            (*ENDREPEAT*) 
            IF  ((lc_result = l_less) OR (next = NIL))
            THEN
                BEGIN
                new(neww);
                neww^.nword := next;
                IF  prev = next
                THEN
                    catchwarr[ pos ] := neww
                ELSE
                    prev^.nword := neww;
                (*ENDIF*) 
                prev      := neww;
                lc_result := l_less
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  lc_result = l_less
        THEN
            BEGIN
            prev^.aword   := actword;
            prev^.outword := outword;
            prev^.wordlen := wordl;
            prev^.difflen := diffl;
            new(prev^.apages);
            cntpagepos                    := succ(cntpagepos);
            pagepos[ cntpagepos ]         := prev^.apages;
            pagepos[ cntpagepos ]^.pcount := 1;
            pagepos[ cntpagepos ]^.ppoint := NIL
            END
        ELSE
            BEGIN
            prevpages := next^.apages;
            WHILE prevpages^.ppoint <> NIL DO
                prevpages := prevpages^.ppoint;
            (*ENDWHILE*) 
            IF  prevpages^.pcount = cct_maxpageno
            THEN
                BEGIN
                new(prevpages^.ppoint);
                prevpages         := prevpages^.ppoint;
                prevpages^.pcount := 1;
                prevpages^.ppoint := NIL
                END
            ELSE
                prevpages^.pcount := succ(prevpages^.pcount);
            (*ENDIF*) 
            cntpagepos            := succ(cntpagepos);
            pagepos[ cntpagepos ] := prevpages
            END;
        (*ENDIF*) 
        pagepos[ cntpagepos ]^.parr[ pagepos[ cntpagepos ]^.pcount ] := 0;
        pagepos[ cntpagepos ]^.pdefine := (tp_com = c_dc);
        END
    ELSE
        BEGIN
        s40 := 'ERROR  to much catchwords on page :     ';
        s10mv3 (mxsp_c40, mxct_longline, s40, 1, hline.l, 1, 35);
        c02int4to_line (curpag, false, 5, 35, hline.l);
        hline.len := 39;
        c02vfwrite (c44errfile, hline);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      catchword (VAR ln : tct_long_line;
            pos    : integer;
            tp_com : tp_command);
 
VAR
      actpos    : tsp_int2;
      len       : integer;
      nlen      : integer;
      actword   : one_word;
      n_actword : one_word;
      j         : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    actpos := pos;
    WHILE ((ln.l[ actpos ] <> ';') AND (actpos <= ln.len)) DO
        actpos := succ(actpos);
    (*ENDWHILE*) 
    IF  (actpos <= ln.len)
    THEN
        BEGIN
        actpos := succ(actpos);
        skipbl (ln, actpos);
        len  := 1;
        nlen := 1;
        j    := 0;
        WHILE ((actpos <= ln.len) AND (ln.l[ actpos ] <> ';') AND
              (ln.l[ actpos ] <> tab) AND (nlen <= cct_maxwlength)) DO
            BEGIN
            IF  ln.l[ actpos ] = question_mark
            THEN
                BEGIN
                actpos := succ(actpos);
                IF  actpos > ln.len
                THEN
                    BEGIN
                    actpos            := pred(actpos);
                    actword[ len ]    := question_mark;
                    n_actword[ nlen ] := question_mark
                    END
                ELSE
                    IF  newchar[ ord(ln.l[ actpos ]) ].length > 0
                    THEN
                        BEGIN
                        n_actword[ nlen ] := esc;
                        nlen              := succ(nlen);
                        n_actword[ nlen ] := ln.l[ actpos ];
                        IF  ln.l[ actpos ] IN [ 'A', 'O', 'U', 'a', 'o', 'u' ]
                        THEN
                            BEGIN
                            actword[ len ] := ln.l[ actpos ];
                            len            := succ(len);
                            IF  len <= cct_maxwlength
                            THEN
                                actword[ len ] := 'e'
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  ln.l[ actpos ] = 'z'
                            THEN
                                BEGIN
                                actword[ len ] := 's';
                                len            := succ(len);
                                IF  len <= cct_maxwlength
                                THEN
                                    actword[ len ] := 's'
                                (*ENDIF*) 
                                END
                            ELSE
                                actword[ len ] := ln.l[ actpos ];
                            (*ENDIF*) 
                        (*ENDIF*) 
                        j := j - 2 + newchar[ ord(ln.l[ actpos ]) ].length
                        END
                    ELSE
                        BEGIN
                        actword[ len ]    := ln.l[ actpos ];
                        n_actword[ nlen ] := ln.l[ actpos ]
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                actword[ len ]    := ln.l[ actpos ];
                n_actword[ nlen ] := ln.l[ actpos ]
                END;
            (*ENDIF*) 
            actpos := succ(actpos);
            len    := succ(len);
            nlen   := succ(nlen)
            END;
        (*ENDWHILE*) 
        nlen := pred(nlen);
        len  := pred(len);
        IF  cwmaxlen < nlen + j
        THEN
            cwmaxlen := nlen + j;
        (*ENDIF*) 
        FOR actpos := 1 TO len DO
            IF  actword[ actpos ] in [ 'A'..'I', 'J'..'R', 'S'..'Z' ]
            THEN
                actword[ actpos ] := chr ( ord(actword[ actpos ]) -
                      ord('A') + ord('a') );
            (* alle W?orter als kleine W?orter sortieren *)
            (*ENDIF*) 
        (*ENDFOR*) 
        FOR actpos := len + 1 TO cct_maxwlength DO
            actword[ actpos ] := bsp_c1;
        (*ENDFOR*) 
        FOR actpos := nlen + 1 TO cct_maxwlength DO
            n_actword[ actpos ] := bsp_c1;
        (*ENDFOR*) 
        get_wordposition (actword, n_actword, nlen + j, j, tp_com)
        END;
    (*ENDIF*) 
    lineend := true;
    IF  (catchwfound AND (catchwinline < maxpagepos))
    THEN
        catchwinline := succ(catchwinline);
    (*ENDIF*) 
    catchwfound := true
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      catchword_index;
 
VAR
      i             : integer;
      j             : integer;
      next          : wwptr;
      nextpages     : wpptr;
      wrdbuf        : tct_long_line;
      m_pseudoblank : char;
      no            : integer;
      size          : integer;
      oldpage       : integer;
      valok         : boolean;
      is_output     : boolean;
      last          : boolean;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    out_one_line;
    m_pseudoblank := pseudoblank;
    IF  pseudoblank = bsp_c1
    THEN
        pseudoblank := '#';
    (*ENDIF*) 
    outbuf2.l := blankline.l;
    setval (inval, cwmaxlen + 1, nl_0, 0, 0, rmval - 1, valok);
    tival := inval;
    ofval := 0;
    FOR i := 0 TO 255 DO
        IF  catchwarr[ i ] <> NIL
        THEN
            BEGIN
            next    := catchwarr[ i ];
            oldpage := 0;
            WHILE next <> NIL DO
                BEGIN
                setval (tival, cwmaxlen + 1, nl_3, inval, 0, rmval, valok);
                nextpages  := next^.apages;
                wrdbuf.len := next^.wordlen - next^.difflen;
                s10mv9 (cct_maxwlength, mxct_longline, next^.outword, 1,
                      wrdbuf.l, 1, wrdbuf.len);
                j          := wrdbuf.len + 1;
                wrdbuf.len := cwmaxlen - next^.difflen;
                WHILE (j <= wrdbuf.len) DO
                    BEGIN
                    wrdbuf.l[ j ] := pseudoblank;
                    j             := j + 1;
                    END;
                (*ENDWHILE*) 
                putwrd(wrdbuf, false);
                outwds := pred(outwds);
                last   := false;
                WHILE nextpages <> NIL DO
                    BEGIN
                    FOR j := 1 TO nextpages^.pcount DO
                        BEGIN
                        wrdbuf.len    := 0;
                        is_output     := false;
                        oldpage       := nextpages^.parr[ j ];
                        IF  j < nextpages^.pcount
                        THEN
                            BEGIN
                            IF  abs(nextpages^.parr[ j + 1 ]) <> abs(oldpage)
                            THEN
                                is_output := true
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  nextpages^.ppoint = NIL
                            THEN
                                BEGIN
                                last      := true;
                                is_output := true
                                END
                            ELSE
                                IF  abs(nextpages^.ppoint^.parr[ 1 ]) <> abs(oldpage)
                                THEN
                                    is_output := true;
                                (*ENDIF*) 
                            (*ENDIF*) 
                        (*ENDIF*) 
                        IF  is_output
                        THEN
                            BEGIN
                            IF  chn
                            THEN
                                BEGIN
                                IF  nextpages^.parr[ j ] < 0
                                THEN
                                    no := (- nextpages^.parr[ j ]) DIV 1000
                                ELSE
                                    no := nextpages^.parr[ j ] DIV 1000;
                                (*ENDIF*) 
                                IF  no > 9
                                THEN
                                    BEGIN
                                    wrdbuf.l[ 1 ] :=
                                          chr(ord('0') + (no DIV 10));
                                    wrdbuf.len := 1
                                    END;
                                (*ENDIF*) 
                                wrdbuf.l[ wrdbuf.len + 1 ] :=
                                      chr(ord('0') + (no MOD 10));
                                wrdbuf.len := wrdbuf.len + 2;
                                wrdbuf.l[ wrdbuf.len ] := hyphen;
                                END;
                            (*ENDIF*) 
                            IF  nextpages^.parr[ j ] < 0
                            THEN
                                BEGIN
                                ulval := 1;
                                no := -(nextpages^.parr[ j ]) MOD 1000
                                END
                            ELSE
                                no := nextpages^.parr[ j ] MOD 1000;
                            (*ENDIF*) 
                            IF  no > 99
                            THEN
                                BEGIN
                                wrdbuf.len := succ(wrdbuf.len);
                                wrdbuf.l[ wrdbuf.len ] :=
                                      chr(ord('0') + (no DIV 100));
                                END;
                            (*ENDIF*) 
                            IF  no > 9
                            THEN
                                BEGIN
                                wrdbuf.len := succ(wrdbuf.len);
                                wrdbuf.l[ wrdbuf.len ] :=
                                      chr(ord('0') + ((no MOD 100) DIV 10));
                                END;
                            (*ENDIF*) 
                            wrdbuf.len := succ(wrdbuf.len);
                            wrdbuf.l[ wrdbuf.len ] :=
                                  chr(ord('0') + (no MOD 10));
                            IF  NOT last
                            THEN
                                BEGIN
                                wrdbuf.len := succ(wrdbuf.len);
                                wrdbuf.l[ wrdbuf.len ] := ','
                                END;
                            (*ENDIF*) 
                            putwrd(wrdbuf, false);
                            ulval := 0
                            END
                        (*ENDIF*) 
                        END;
                    (*ENDFOR*) 
                    nextpages := nextpages^.ppoint
                    END;
                (*ENDWHILE*) 
                out_one_line;
                ofval := 0;
                tival := inval;
                next  := next^.nword
                END
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
    (*ENDFOR*) 
    setval (inval, cwmaxlen + 1, nl_3, 0, 0, rmval - 1, valok);
    pseudoblank := m_pseudoblank
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      comtyp (VAR ln  : tct_long_line;
            pos : integer) : tp_command;
 
VAR
      comtval : tp_command;
      buf2    : char;
      buf3    : char;
      i       : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  ln.l[ pos + 1 ] IN [ 'a'..'i','j'..'r','s'..'z'  ]
    THEN
        buf2 := chr(ord(ln.l[ pos + 1 ]) + (ord('A') - ord('a')))
    ELSE
        buf2 := ln.l[ pos + 1 ];
    (*ENDIF*) 
    IF  ln.l[ pos + 2 ] IN [ 'a'..'i','j'..'r','s'..'z' ]
    THEN
        buf3 := chr(ord(ln.l[ pos + 2 ]) + (ord('A') - ord('a')))
    ELSE
        buf3 := ln.l[ pos + 2 ];
    (*ENDIF*) 
    CASE buf2  OF
        'A' :
            IF  buf3  = 'D'
            THEN
                comtval := c_ad
            ELSE
                comtval := c_unknown;
            (*ENDIF*) 
        'B' :
            BEGIN
            CASE buf3 OF
                'B' :
                    comtval := c_bb;
                'E' :
                    comtval := c_be;
                'M' :
                    comtval := c_bm;
                'R' :
                    comtval := c_br;
                'T' :
                    comtval := c_bt;
                OTHERWISE
                    comtval := c_unknown
                END
            (*ENDCASE*) 
            END;
        'C' :
            CASE buf3 OF
                'C' :
                    comtval := c_cc;
                'E' :
                    comtval := c_ce;
                'I' :
                    comtval := c_ci;
                'M' :
                    comtval := c_cm;
                'N' :
                    comtval := c_cn;
                'P' :
                    comtval := c_cp;
                'W' :
                    BEGIN
                    comtval := c_cw;
                    i       := pos + 3;
                    WHILE ((ln.l[ i ] = bsp_c1) AND (i <= ln.len)) DO
                        i := i + 1;
                    (*ENDWHILE*) 
                    IF  ((ln.l[ i ] <> ';') AND (i <= ln.len))
                    THEN
                        ln.l[ i - 1 ] := ';';
                    (*ENDIF*) 
                    END;
                OTHERWISE
                    comtval := c_unknown;
                END;
            (*ENDCASE*) 
        'D' :
            IF  buf3  = 'S'
            THEN
                comtval := c_ds
            ELSE
                IF  buf3 = 'C'
                THEN
                    BEGIN
                    comtval := c_dc;
                    i       := pos + 3;
                    WHILE ((ln.l[ i ] = bsp_c1) AND (i <= ln.len)) DO
                        i := i + 1;
                    (*ENDWHILE*) 
                    IF  ((ln.l[ i ] <> ';') AND (i <= ln.len))
                    THEN
                        ln.l[ i - 1 ] := ';';
                    (*ENDIF*) 
                    END
                ELSE
                    comtval := c_unknown;
                (*ENDIF*) 
            (*ENDIF*) 
        'F' :
            CASE buf3 OF
                'I' :
                    comtval := c_fi;
                'M' :
                    comtval := c_fm;
                'O' :
                    comtval := c_fo;
                'S' :
                    comtval := c_fs;
                OTHERWISE
                    comtval := c_unknown;
                END;
            (*ENDCASE*) 
        'G' :
            IF  buf3 = 'C'
            THEN
                comtval := c_gc
            ELSE
                IF  buf3 = 'L'
                THEN
                    comtval := c_gl
                ELSE
                    comtval := c_unknown;
                (*ENDIF*) 
            (*ENDIF*) 
        'H' :
            CASE buf3 OF
                'B' :
                    comtval := c_hb;
                'E' :
                    comtval := c_he;
                'I' :
                    comtval := c_hi;
                'M' :
                    comtval := c_hm;
                'S' :
                    comtval := c_hs;
                OTHERWISE
                    comtval := c_unknown;
                END;
            (*ENDCASE*) 
        'I' :
            IF  buf3  = 'M'
            THEN
                comtval := c_im
            ELSE
                IF  buf3  = 'N'
                THEN
                    comtval := c_inconst
                ELSE
                    comtval := c_unknown;
                (*ENDIF*) 
            (*ENDIF*) 
        'L' :
            IF  buf3  = 'L'
            THEN
                comtval := c_ll
            ELSE
                IF  buf3  = 'S'
                THEN
                    comtval := c_ls
                ELSE
                    comtval := c_unknown;
                (*ENDIF*) 
            (*ENDIF*) 
        'N' :
            CASE buf3 OF
                'B' :
                    comtval := c_nb;
                'D' :
                    comtval := c_nd;
                'E' :
                    comtval := c_ne;
                'F' :
                    comtval := c_nf;
                OTHERWISE
                    comtval := c_unknown;
                END;
            (*ENDCASE*) 
        'O' :
            IF  buf3  = 'C'
            THEN
                comtval := c_oc
            ELSE
                IF  buf3  = 'F'
                THEN
                    comtval := c_ofconst
                ELSE
                    IF  buf3 = 'P'
                    THEN
                        comtval := c_op
                    ELSE
                        comtval := c_unknown;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        'P' :
            IF  buf3  = 'A'
            THEN
                comtval := c_pa
            ELSE
                IF  buf3 = 'B'
                THEN
                    comtval := c_pb
                ELSE
                    IF  buf3  = 'L'
                    THEN
                        comtval := c_pl
                    ELSE
                        comtval := c_unknown;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        'S' :
            BEGIN
            IF  buf3 = 'B'
            THEN
                comtval := c_sb
            ELSE
                IF  buf3 = 'C'
                THEN
                    comtval := c_sc
                ELSE
                    IF  buf3 = 'E'
                    THEN
                        comtval := c_se
                    ELSE
                        IF  buf3  = 'N'
                        THEN
                            comtval := c_sn
                        ELSE
                            IF  buf3  = 'P'
                            THEN
                                comtval := c_sp
                            ELSE
                                IF  buf3  = 'S'
                                THEN
                                    comtval := c_ss
                                ELSE
                                    comtval := c_unknown
                                (*ENDIF*) 
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        'T' :
            IF  buf3  = 'M'
            THEN
                comtval := c_tm
            ELSE
                IF  buf3 = 'R'
                THEN
                    comtval := c_tr
                ELSE
                    IF  buf3  = 'T'
                    THEN
                        comtval := c_tt
                    ELSE
                        comtval := c_unknown;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        'U' :
            IF  buf3  = 'N'
            THEN
                comtval := c_un
            ELSE
                comtval := c_unknown;
            (*ENDIF*) 
        'V' :
            IF  buf3  = 'S'
            THEN
                comtval := c_vs
            ELSE
                comtval := c_unknown;
            (*ENDIF*) 
        OTHERWISE
            comtval := c_unknown;
        END;
    (*ENDCASE*) 
    comtyp := comtval;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      iprocess_input_module (VAR ln  : tct_long_line;
            VAR pos : tsp_int2);
 
VAR
      fileno   : tsp_int4;
      ferr     : tsp_vf_return;
      ferr_txt : tsp_errtext;
      bufadr   : tct_long_lineaddr;
      oldfilen : tsp_vfilename;
      old_line : integer;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    oldfilen := inp_filename;
    old_line := linecount;
    c44openfile (ln, pos, inp_filename, fileno, linecount, ferr);
    IF  ferr = vf_ok
    THEN
        BEGIN
        linecount := 0;
        WHILE (getline(fileno, inputbuf) = vf_ok) DO
            BEGIN
            process_line (inputbuf);
            END;
        (*ENDWHILE*) 
        bufadr := NIL;
        sqlfclose (fileno, false, 0, 0, bufadr, ferr, ferr_txt);
        inp_filename := oldfilen;
        linecount    := old_line;
        END
    ELSE
        BEGIN
        s40 := 'Schrott beim Fileoeffnen                ';
        s10mv3 (mxsp_c40, mxct_longline, s40, 1, hline.l, 1, 32);
        c02int4to_line (ord(ferr), false, 5, 32, hline.l);
        hline.len := 36;
        c02vfwrite (c44errfile, hline);
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      one_command (VAR ln     : tct_long_line;
            pos        : tsp_int2;
            VAR valok  : boolean;
            VAR norest : boolean);
 
VAR
      i              : tsp_int2;
      ct             : tp_command;
      val            : integer;
      argtyp         : char;
      mstuf          : integer;
      spval          : tsp_int2;
      wrdbuf         : tct_long_line;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    valok  := true;
    norest := false;
    IF  print_summary
    THEN
        BEGIN
        to_fill       := true;
        print_summary := false
        END;
    (*ENDIF*) 
    ct := comtyp (ln, pos);
    IF  ct = c_unknown
    THEN
        BEGIN
        s40 := 'ERROR  unknown command in line:         ';
        s10mv3 (mxsp_c40, mxct_longline, s40, 1, hline.l, 1, 32);
        c02int4to_line (linecount, false, 5, 32, hline.l);
        hline.len := 36;
        c02vfwrite (c44errfile, hline);
        s10mv2 (mxct_longline, mxct_longline, ln.l, pos, hline.l, 1, ln.len);
        hline.len := ln.len - pos;
        c02vfwrite (c44errfile, hline);
        s40 := '  im File:                              ';
        s10mv3 (mxsp_c40, mxct_longline, s40, 1, c41_glob.hline.l, 1, 11);
        s10mv11(mxsp_vfilename, mxct_longline, c41_glob.inp_filename, 1,
              c41_glob.hline.l, 12, 49);
        c02int4to_line (c41_glob.linecount, false, 5, 56, c41_glob.hline.l);
        c41_glob.hline.len := 60;
        c02vfwrite (c44errfile, c41_glob.hline);
        END
    ELSE
        IF  ct = c_vs
        THEN
            BEGIN
            (*===============================================*)
            (* write the version and the date of the script  *)
            (* module into the error-file (script-cmd '.vs') *)
            (*===============================================*)
            c02putname(hline, 1, n_vct_version);
            hline.l[ 13 ] := bsp_c1;
            hline.l[ 14 ] := bsp_c1;
            hline.len     := 14;
            c02putname(hline, 0, n_vct_date);
            hline.len     := 25;
            c02vfwrite (c44errfile, hline);
            END
        ELSE
            BEGIN
            val := getval (ln, pos, argtyp);
            CASE ct OF
                c_ad :
                    BEGIN
                    out_one_line;
                    setval (adval,val,argtyp,0,0,maxout - rmval,valok);
                    END;
                c_bb :
                    IF  blockoutput
                    THEN
                        sqlabort
                    ELSE
                        BEGIN
                        out_one_line;
                        IF  first <> nl_1
                        THEN
                            CASE first OF
                                ff :
                                    BEGIN
                                    phead;
                                    (*putc_first (ff);
                                          putc_next (bsp_c1);
                                          putc_next (cr);
                                          first := nl_0*)
                                    END;
                                nl_1 :
                                    BEGIN
                                    END;
                                nl_2 :
                                    BEGIN
                                    putc_first (nl_1);
                                    putc_next (bsp_c1);
                                    putc_next (cr);
                                    first := nl_1;
                                    END;
                                nl_3 :
                                    BEGIN
                                    putc_first (nl_2);
                                    putc_next (bsp_c1);
                                    putc_next (cr);
                                    first := nl_1;
                                    END;
                                END;
                            (*ENDCASE*) 
                        (*ENDIF*) 
                        blockoutput := true;
                        blocklines  := 0;
                        blocklength := 0;
                        END;
                    (*ENDIF*) 
                c_be :
                    IF  (pos + 2 <> ln.len) OR (NOT blockoutput)
                    THEN
                        sqlabort
                    ELSE
                        BEGIN
                        out_one_line;
                        putc_first (nl_0);
                        putc_next(cr);
                        blockoutput := false;
                        condpag (blocklength);
                        IF  lineno > bottom
                        THEN
                            BEGIN
                            phead;
                            IF  first <> nl_1
                            THEN
                                CASE first OF
                                    (* ff :
                                          BEGIN
                                          ist noch nicht recht klar
                                          putc_first (ff);
                                          putc_next (bsp_c1);
                                          putc_next (cr);
                                          first := nl_0
                                          END; *)
                                    nl_1 :
                                        BEGIN
                                        END;
                                    nl_2 :
                                        BEGIN
                                        putc_first (nl_1);
                                        putc_next (bsp_c1);
                                        putc_next (cr);
                                        first := nl_1;
                                        END;
                                    nl_3 :
                                        BEGIN
                                        putc_first (nl_2);
                                        putc_next (bsp_c1);
                                        putc_next (cr);
                                        first := nl_1;
                                        END;
                                    END
                                (*ENDCASE*) 
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        IF  contrcr
                        THEN
                            BEGIN
                            putc_first (nl_0);
                            putc_next (cr)
                            END;
                        (*ENDIF*) 
                        blockinput := true;
                        END;
                    (*ENDIF*) 
                c_bm :
                    BEGIN
                    out_one_line;
                    setval (bmval,val,argtyp,3,ftval + m3val,
                          pagelen - m1val - m2val - ttval - 1,valok);
                    bottom := plval - bmval;
                    m4val  := bmval - ftval - m3val;
                    END;
                c_br :
                    out_one_line;
                c_bt :
                    BEGIN
                    IF  val = 0
                    THEN
                        val := 1;
                    (*ENDIF*) 
                    gettl (ln, pos, footer[ val ]);
                    norest := true
                    END;
                c_cc :
                    BEGIN
                    command := chr(val)
                    END;
                c_ce :
                    BEGIN
                    out_one_line;
                    setval (ceval,val,argtyp,1,0,huge,valok)
                    END;
                c_ci :
                    catchword_index;
                c_cm :
                    norest := true;
                c_cn :
                    chn := true;
                c_cp :
                    IF  blockoutput
                    THEN
                        sqlabort
                    ELSE
                        condpag (val);
                    (*ENDIF*) 
                c_cw, c_dc :
                    catchword (ln, pos, ct);
                c_ds :
                    BEGIN
                    out_one_line;
                    setval (lsval,val,cr,1,0,huge,valok)
                    END;
                c_fi :
                    BEGIN
                    out_one_line;
                    to_fill := true
                    END;
                c_fm :
                    BEGIN
                    out_one_line;
                    setval (m3val,val,argtyp,1,0,bmval - ftval,valok);
                    m4val := bmval - ftval - m3val
                    END;
                c_fo :
                    BEGIN
                    out_one_line;
                    to_fill := true
                    END;
                c_fs :
                    BEGIN
                    out_one_line;
                    setval (ftval,val,argtyp,1,0,2,valok);
                    m4val := bmval - ftval - m3val
                    END;
                c_gc :
                    BEGIN
                    space_lines(huge);
                    IF  newpag > 0
                    THEN
                        newpag := - 7;
                    (*ENDIF*) 
                    save_rest (ln, pos, norest);
                    c44gmake_reset;
                    WHILE (c02getline(c44glossar, inputbuf) = vf_ok) DO
                        process_line (inputbuf);
                    (*ENDWHILE*) 
                    END;
                c_gl :
                    save_rest(ln, pos, norest);
                c_hb :
                    help_text := true;
                c_he :
                    help_text := false;
                c_hi :
                    BEGIN
                    out_one_line;
                    setval (hival, val, argtyp, 0, - tival,
                          rmval - inval + 1, valok)
                    END;
                c_hm :
                    BEGIN
                    out_one_line;
                    setval (m2val,val,argtyp,1,0,tmval - ttval,valok);
                    m1val := tmval - ttval - m2val
                    END;
                c_hs :
                    BEGIN
                    out_one_line;
                    IF  tmval - m2val < 7
                    THEN
                        i := tmval - m2val
                    ELSE
                        i := 7;
                    (*ENDIF*) 
                    setval (ttval,val,argtyp,1,0,i,valok);
                    m1val := tmval - ttval - m2val;
&                   IFDEF DEBUG
                    writeln ('one_command c_hs ::  ttval = ',ttval:3);
&                   ENDIF
                    END;
                c_im :
                    BEGIN
                    (*                     out_one_line; *)
&                   IFDEF DEBUG
                    writeln;
                    write('inputbuf ');
                    c02zwrite (inputbuf);
                    write('oline    ');
                    c02zwrite (oline);
                    write('oln2     ');
                    c02zwrite (oln2);
                    write('outbuf   ');
                    c02zwrite (outbuf);
                    write('outbuf2  ');
                    c02zwrite (outbuf2);
&                   ENDIF
                    norest := true;
                    pos    := pos + 3;
                    iprocess_input_module (ln, pos);
                    END;
                c_inconst :
                    BEGIN
                    out_one_line;
                    IF  ((argtyp <> nl_0) AND (argtyp <> nl_3))
                    THEN
                        setval (inval, val + ndval, bsp_c1, 0, 0, rmval - 1, valok)
                    ELSE
                        setval (inval,val,argtyp,0,0,rmval - 1,valok)
                    (*ENDIF*) 
                    END;
                c_ll :
                    BEGIN
                    out_one_line;
                    setval (rmval,val,argtyp,pagewidth,tival + 1,huge,valok)
                    END;
                c_ls :
                    BEGIN
                    out_one_line;
                    setval (lsval,val,argtyp,0,0,huge,valok)
                    END;
                c_nb :
                    new_text := true;
                c_nd :
                    BEGIN
                    ndval := 9;
                    setval (inval, ndval, nl_0, 0, 0, rmval - 1, valok)
                    END;
                c_ne :
                    new_text := false;
                c_nf :
                    BEGIN
                    out_one_line;
                    to_fill := false
                    END;
                c_oc :
                    BEGIN
                    i := pos + 3;
                    skipbl (ln, i);
                    IF  ((ln.l[ i ]  = '_') AND (ln.l[ i + 1 ]  = '/'))
                    THEN
                        BEGIN
                        i      := i + 2;
                        val    := ctoi (ln,i);
                        argtyp := bsp_c1;
                        IF  (outbuf2.len = 0)
                        THEN
                            outbuf2.l := blankline.l;
                        (*ENDIF*) 
                        setval (ulval,val,argtyp,1,0,huge,valok)
                        END
                    ELSE
                        BEGIN
                        s40 := 'ERROR  unknown command in line:         ';
                        s10mv3 (mxsp_c40, mxct_longline, s40, 1, hline.l, 1, 32);
                        c02int4to_line (linecount, false, 5, 32, hline.l);
                        hline.len := 36;
                        c02vfwrite (c44errfile, hline);
                        s10mv2 (mxct_longline, mxct_longline, ln.l, pos, hline.l, 1, ln.len);
                        hline.len := ln.len - pos;
                        c02vfwrite (c44errfile, hline);
                        s40 := '  im File:                              ';
                        s10mv3 (mxsp_c40, mxct_longline, s40, 1, c41_glob.hline.l, 1, 11);
                        s10mv11(mxsp_vfilename, mxct_longline, c41_glob.inp_filename, 1,
                              c41_glob.hline.l, 12, 49);
                        c02int4to_line (c41_glob.linecount, false, 5, 56, c41_glob.hline.l);
                        c41_glob.hline.len := 60;
                        c02vfwrite (c44errfile, c41_glob.hline);
                        END
                    (*ENDIF*) 
                    END;
                c_ofconst :
                    BEGIN
                    out_one_line;
                    IF  hival = 0
                    THEN
                        setval (ofval,val,argtyp,0, - tival,rmval - inval - 1,valok)
                    (*ENDIF*) 
                    END;
                c_op :
                    BEGIN
                    out_one_line;
                    IF  ((lineno > 0) AND (first <> ff) AND
                        (lineno <= bottom))
                    THEN
                        space_lines (huge);
                    (*ENDIF*) 
                    IF  ((curpag MOD 2 = 0) AND (curpag = newpag)) OR
                        ((curpag MOD 2 = 1) AND (curpag <> newpag))
                    THEN
                        BEGIN
                        outp          := 2;
                        outbuf.l[ 1 ] := ' ';
                        outbuf.len    := 1;
                        out_one_line;
                        space_lines (huge)
                        END
                    (*ENDIF*) 
                    END;
                c_pa :
                    IF  blockoutput
                    THEN
                        sqlabort
                    ELSE
                        BEGIN
                        out_one_line;
                        IF  ((lineno > 0) AND (first <> ff) AND
                            (lineno <= bottom))
                        THEN
                            space_lines (huge);
                        (*ENDIF*) 
                        IF  ((first <> ff) AND (lineno <= bottom))
                        THEN
                            setval (curpag,val,argtyp,curpag + 1, - 7,32000,valok)
                        ELSE
                            setval (curpag,val,argtyp,newpag, - 7,32000,valok);
                        (*ENDIF*) 
                        (* - 7 wegen der Numerierung der Inhaltsverzeichnisseiten *)
                        newpag := curpag;
                        IF  lineno > 0
                        THEN
                            lineno := 1000
                                  (* > bottom, auch wenn das fuer die *)
                                  (* naechste Page hochgesetzt wird *)
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                c_pb :
                    BEGIN
                    out_one_line; (* damit auch die letzte Zeile mit
                          Pseudoblanks richtig ausgegeben wird *)
                    pseudoblank := chr(val)
                    END;
                c_pl :
                    BEGIN
                    out_one_line;
                    i := m1val + ttval + m2val + m3val + ftval + m4val + 1;
                    setval (plval,val,argtyp,pagelen,i,huge,valok);
                    bottom := plval - m3val - ftval - m4val
                    END;
                c_sb :
                    BEGIN
                    space_lines (2);
                    to_fill := false;
                    condpag (5);
                    argtyp := nl_3;
                    tival  := tival - ofval;
                    ofval  := 0;
                    setval (tival, inval, argtyp, 0, 0, rmval, valok);
                    mstuf := level[ 1 ];
                    IF  val <> 0
                    THEN
                        level[ 1 ] := val;
                    (*ENDIF*) 
                    section_begin (ln, valok);
                    IF  NOT valok
                    THEN
                        level[ 1 ] := mstuf;
                    (*ENDIF*) 
                    section_number := 1;
                    END;
                c_sc :
                    BEGIN
                    space_lines (huge);
                    IF  newpag > 0
                    THEN
                        newpag := - 7;
                    (*ENDIF*) 
                    IF  val <> 0
                    THEN
                        BEGIN
                        ln.len := 0;
                        put_out_buf (ln, 1, false);
                        ln.l[ 1 ] := '.';
                        ln.len    := 1;
                        space_lines (val - 1)
                        END;
                    (*ENDIF*) 
                    c44_summary_dump
                    END;
                c_se :
                    BEGIN
                    out_one_line;
                    IF  act_level > 0
                    THEN
                        BEGIN
                        level[ act_level + 1 ] := 1;
                        level[ act_level ]     := level[ act_level ] + 1;
                        act_level              := act_level - 1;
                        IF  act_level = 0
                        THEN
                            BEGIN
                            s40 := '.-1000                                  ';
                            s10mv3 (mxsp_c40, mxct_longline, s40, 1, oln2.l,oln2.len+1,7);
                            oln2.len := oln2.len + 7;
                            END
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                    END;
                c_sn :
                    IF  val <> 0
                    THEN
                        section_number := val
                    ELSE
                        BEGIN
                        space_lines (1);
                        tival := inval;
                        IF  hival = 0
                        THEN
                            setval (ofval,4, ' ',0, - tival,rmval - inval - 1,valok);
                        (*ENDIF*) 
                        IF  section_number > 9
                        THEN
                            BEGIN
                            wrdbuf.l[ 1 ] := chr(section_number DIV 10 + ord('0'));
                            wrdbuf.len := 3
                            END
                        ELSE
                            wrdbuf.len := 2;
                        (*ENDIF*) 
                        wrdbuf.l[ wrdbuf.len-1 ] := chr(section_number MOD 10 + ord('0'));
                        wrdbuf.l[ wrdbuf.len ]:= '.';
                        putwrd (wrdbuf, false);
                        IF  (((l_outbuf <= ofval) OR (l_outbuf <= hival))
                            AND (tival < inval + ofval + hival))
                        THEN
                            BEGIN (*ofval or hival = 0*)
                            WHILE (l_outbuf < ofval + hival) DO
                                BEGIN
                                l_outbuf         := l_outbuf + 1;
                                outp             := outp + 1;
                                outbuf.l[ outp ] := bsp_c1
                                END;
                            (*ENDWHILE*) 
                            outwds := outwds - 1
                            END;
                        (*ENDIF*) 
                        section_number := succ(section_number);
                        END;
                    (*ENDIF*) 
                c_sp :
                    BEGIN
                    setval (spval,val,argtyp,1,0,huge,valok);
                    space_lines (spval)
                    END;
                c_ss :
                    BEGIN
                    out_one_line;
                    setval (lsval,val,cr,0,0,huge,valok)
                    END;
                c_tm :
                    BEGIN
                    out_one_line;
                    setval (tmval,val,argtyp,5,m2val + ttval,
                          pagelen - m3val - m4val - ftval - 1,valok);
                    m1val := tmval - ttval - m2val
                    END;
                c_tr :
                    BEGIN
                    out_one_line;
                    setnewchar (ln, val)
                    END;
                c_tt :
                    BEGIN
&                   IFDEF DEBUG
                    writeln ('one_command c_tt ::    val = ',val:3);
&                   ENDIF
                    IF  val = 0
                    THEN
                        val := 1;
                    (*ENDIF*) 
                    norest := true;
                    gettl (ln, pos, header[ val ]);
&                   IFDEF DEBUG
                    writeln ('one_command ln    ',ln.len:2,'>',ln.l:ln.len,'<');
                    writeln ('one_command header',header[ val ].len:2,
                          '>',header[ val ].l:header[ val ].len,'<');
                    writeln ('one_command c_tt(ende) val = ',val:3);
&                   ENDIF
                    END;
                c_un :
                    BEGIN
                    out_one_line;
                    argtyp := nl_3;
                    tival  := tival - ofval;
                    ofval  := 0;
                    setval (tival,val,argtyp,inval,0,rmval,valok);
                    END;
                END;
            (*ENDCASE*) 
            IF  NOT (ct IN [ c_bt, c_cc, c_ci, c_cm, c_cn, c_cp, c_cw,
                c_dc, c_nb, c_ne, c_oc, c_ofconst, c_pb, c_sb, c_sn,
                c_tt, c_un ])
            THEN
                BEGIN
                ofval := 0;
                tival := inval
                END
            ELSE
                IF  ct = c_ofconst
                THEN
                    tival := inval + hival
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      init_ok : boolean;
 
VAR
      i           : integer;
      ok          : boolean;
      dummyname   : tsp_name;
      dummybool   : boolean;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    c02init;
    c02linelength_init (mxct_longline);
    c02blankline (blankline);
    blankline.len := mxct_longline;
&   if $COMP=PTOC
    FOR i := 1 TO 72 DO
        block[ i ].adr := @block[ i ].l;
    (*ENDFOR*) 
&   else
    FOR i := 1 TO 72 DO
        block[ i ].adr := s30gad (block[ i ].l);
    (*ENDFOR*) 
&   endif
    ok            := c44files_init_ok;
    first         := nl_1;
    contrcr       := false;
    bmval         := 3;
    tmval         := 5;
    outbuf.len    := 0;
    outbuf2.len   := 0;
    oline.len     := 0;
    oln2.len      := 0;
    second        := false;
    backspace     := '?' ; (* nothing *)
    tab           := chr(9);
    esc           := chr(27);
    hyphen        := '-';
    pseudoblank   := ' ';
    command       := '.';
    nullchar      := chr(0);
    FOR i := 2 TO 10 DO
        level[ i ] := 1;
    (*ENDFOR*) 
    level[ 1 ]      := 0;
    act_level       := 0;
    max_level       := 0;
    blocklines      := 0;
    blocklength     := 0;
    print_summary   := false;
    blockinput      := false;
    blockoutput     := false;
    header[ 1 ].len := 0;
    header[ 2 ].len := 0;
    header[ 3 ].len := 0;
    header[ 4 ].len := 0;
    header[ 5 ].len := 0;
    header[ 6 ].len := 0;
    header[ 7 ].len := 0;
    footer[ 1 ].len := 0;
    footer[ 2 ].len := 0;
    lsval           := 0;
    inval           := 0;
    rmval           := pagewidth;
    tival           := 0;
    adval           := 0;
    ofval           := 0;
    hival           := 0;
    ceval           := 0;
    ulval           := 0;
    curpag          := 0;
    newpag          := 1;
    lineno          := c_lineno_init;
    plval           := pagelen;
    m1val           := 4;
    ttval           := 1;
    m2val           := 1;
    m3val           := 1;
    ftval           := 1;
    m4val           := 2;
    ndval           := 0;
    bottom          := pagelen - 3;
    outp            := 0;
    l_outbuf        := 0;
    outwds          := 0;
    FOR i := 0 TO 255 DO
        newchar[ i ].length := 0;
    (*ENDFOR*) 
    linecount      := 0;
    dir            := 0;
    notelevel      := 1;
    notice          := false;
    to_fill        := true;
    chn            := false;
    cwmaxlen       := 0;
    cntpagepos     := 0;
    catchwfound    := false;
    catchwinline   := 0;
    FOR i := 0 TO 255 DO
        catchwarr[ i ] := NIL;
    (*ENDFOR*) 
    new_text       := false;
    section_number := 0;
    help_text      := false;
    sqlargl  (hline.l);
    hline.len := s30lnr (hline.l, ' ', 1, mxsp_line);
    c04cc2init (hline, dummyname, dummybool, c44errfile);
    c45initscript;
    inp_filename :=
          'MAIN-INPUT-FILE                                                 ';
    init_ok := ok;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      process_line (VAR ln : tct_long_line);
 
VAR
      j           : integer;
      z           : integer;
      pos         : tsp_int2;
      tabpos      : integer;
      ok          : boolean;
 
BEGIN
WITH c41_glob DO
    BEGIN
    lineend := false;
    pos     := 1;
    IF  ln.l[ 1 ] = command
    THEN
        BEGIN
        WHILE ((pos <= ln.len) AND (ln.l[ pos ] = command) AND
              (NOT lineend)) DO
            BEGIN
            one_command (ln, pos, ok, lineend);
            IF  NOT ok
            THEN
                BEGIN
                s40 := 'ERROR  invalid value in line:           ';
                s10mv3 (mxsp_c40, mxct_longline, s40, 1, hline.l, 1, 30);
                c02int4to_line (linecount, false, 5, 30, hline.l);
                hline.len := 34;
                c02vfwrite (c44errfile, hline);
                s10mv2 (mxct_longline, mxct_longline, ln.l, pos, hline.l, 1, ln.len -
                      pos + 1);
                hline.len := ln.len - pos + 1;
                c02vfwrite (c44errfile, hline);
                s40 := '  im File:                              ';
                s10mv3 (mxsp_c40, mxct_longline, s40, 1, c41_glob.hline.l, 1, 11);
                s10mv11(mxsp_vfilename, mxct_longline, c41_glob.inp_filename, 1,
                      c41_glob.hline.l, 12, 49);
                c02int4to_line (c41_glob.linecount, false, 5, 56, c41_glob.hline.l);
                c41_glob.hline.len := 60;
                c02vfwrite (c44errfile, c41_glob.hline);
                END;
            (*ENDIF*) 
            IF  NOT lineend
            THEN
                BEGIN
                j := pos;
                WHILE ((j <= ln.len) AND (ln.l[ j ] <> ';')) DO
                    j := j + 1;
                (*ENDWHILE*) 
                IF  ln.l[ j ] = ';'
                THEN
                    pos := j + 1
                ELSE
                    lineend := true;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  NOT lineend AND (pos <= ln.len)
        THEN
            text_p (ln, pos);
        (*ENDIF*) 
        END
    ELSE
        text_p (ln, pos);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      f_flush;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  oline.len > 0
    THEN
        c02vfwrite (c44outfileno, oline);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      getline (infileno : tsp_int4;
            VAR ln   : tct_long_line) : tsp_vf_return;
 
VAR
      blockl : integer;
      i      : integer;
      len    : tsp_int4;
      ret    : tsp_vf_return;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  blockinput
    THEN
        BEGIN
        FOR blockl := 1 TO blocklines - 1 DO
            put_out_buf (block[ blockl ], 1, false);
        (*ENDFOR*) 
        lineno     := lineno + blocklength;
        blockinput := false;
        IF  lineno > bottom
        THEN
            pfoot;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    ct41getline (infileno, ln, ret, len);
    WHILE ((ret = vf_ok) AND (len = 0)) DO
        ct41getline (infileno, ln, ret, len);
    (*ENDWHILE*) 
    getline := ret;
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct41getline (infileno : tsp_int4;
            VAR ln   : tct_long_line;
            VAR ferr : tsp_vf_return;
            VAR len  : tsp_int4);
 
BEGIN
ferr := c02getline (infileno, ln);
len := ln.len;
c41_glob.linecount := succ(c41_glob.linecount);
IF  ferr = vf_ok
THEN
    BEGIN
    IF  len = 0
    THEN
        BEGIN
        (* empty lines without any blank are skipped till version 23 *)
        len := 1;
        ln.len := 1;
        ln.l[1] := bsp_c1
        END;
    (*ENDIF*) 
    c45process_cond_directive (ln.l, len, c41_err);
    IF  (len < 0)
    THEN
        BEGIN
        s10mv10 (mxsp_c60, mxct_longline,
              c41_err, 1, c41_glob.hline.l, 1, mxsp_c60);
        c41_glob.hline.len := 60;
        c02vfwrite (c44errfile, c41_glob.hline);
        c41_glob.s40 := '  im File:                              ';
        s10mv3 (mxsp_c40, mxct_longline, c41_glob.s40, 1,
              c41_glob.hline.l, 1, 11);
        s10mv11(mxsp_vfilename, mxct_longline, c41_glob.inp_filename, 1,
              c41_glob.hline.l, 12, 49);
        c02int4to_line (c41_glob.linecount, false, 5, 56, c41_glob.hline.l);
        c41_glob.hline.len := 60;
        c02vfwrite (c44errfile, c41_glob.hline);
        ln.len := 0;  (* is equal to blankline *)
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  ((len = 0) AND (ferr <> vf_ok))
THEN
    ln.len := 0;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sequential_program;
 
BEGIN
WITH c41_glob  DO
    BEGIN
    IF  init_ok
    THEN
        BEGIN
        WHILE (c02getline(c44imfileno, inputbuf) = vf_ok) DO
            BEGIN
            process_line (inputbuf);
            END;
        (*ENDWHILE*) 
        WHILE (getline(c44infileno, inputbuf) = vf_ok) DO
            BEGIN
            process_line (inputbuf);
            END;
        (*ENDWHILE*) 
        space_lines (huge);
        f_flush;
        c44close_files;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
BEGIN
WITH c41_glob  DO
    BEGIN
    dummy_nvers := n_vct_version;
    dummy_ndate := n_vct_date;
&   if $COMP=PTOC
    hline.adr   := @hline.l;
    oline.adr   := @oline.l;
    oln2.adr    := @oln2.l;
&   else
    hline.adr   := s30gad (hline.l);
    oline.adr   := s30gad (oline.l);
    oln2.adr    := s30gad (oln2.l);
&   endif
    c41_i := 1;
    WHILE c41_i <= 72 DO
        BEGIN
&       if $COMP=PTOC
        block[ c41_i ].adr := @block[ c41_i ].l;
&       else
        block[ c41_i ].adr := s30gad (block[ c41_i ].l);
&       endif
        c41_i := succ(c41_i)
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
sequential_program;
sqlfinish(true)
END
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :       1707
*-PRETTY-*  lines of code :       4301        PRETTY  3.09 
*-PRETTY-*  lines in file :       5046         1992-11-23 
.PA 
