.CM  SCRIPT , Version - 1.1 , last edited by holger
.ad 8
.bm 8
.fm 4
.bt $Copyright by   SAP AG, 1997$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VMT90$
.tt 2 $$$
.tt 3 $BarbaraJ$Test_Procedures$$$$1997-05-23$
***********************************************************
.nf


    ========== licence begin LGPL
    Copyright (C) 2000 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  : Test_Procedures
=========
.sp
Purpose : Druckroutinen als Testhilfen.
          Nur fuer die Dialogkomponenten.
          Entspricht im wesentlichen dem VTA01 vom Kern
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              m90blankline : tsp_dataline;
              m90prot : boolean;
              m90tab : char;
              m90term : boolean;
 
        PROCEDURE
              m90addr (
                    layer    : tsp_layer;
                    nam      : tsp_sname;
                    bufaddr  : tsp_bufaddr);
 
        PROCEDURE
              m90addr1 (
                    layer    : tsp_layer;
                    nam      : tsp_sname;
                    bufaddr  : tsp_bufaddr);
 
        PROCEDURE
              m90addr2 (
                    layer    : tsp_layer;
                    nam      : tsp_sname;
                    bufaddr  : tsp_bufaddr);
 
        PROCEDURE
              m90ascii (
                    layer   : tsp_layer;
                    VAR buf :  tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90asc1ii(
                    layer   : tsp_layer;
                    VAR buf :  tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90auftrag_header (
                    layer       : tsp_layer;
                    VAR  packet : tsp_packet );
 
        PROCEDURE
              m90bool (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    bool  : boolean );
 
        PROCEDURE
              m90buf (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf1 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf2 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf3 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf4 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf5 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf6 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90str (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    len     : integer);
 
        PROCEDURE
              m90str1 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    len     : integer);
 
        PROCEDURE
              m90str3 (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    len     : integer);
 
        PROCEDURE
              m90char (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    c     : char);
 
        PROCEDURE
              m90c12 (
                    layer : tsp_layer;
                    nam   : tsp_c12);
 
        PROCEDURE
              m90c30 (
                    layer : tsp_layer;
                    str30 : tsp_c30);
 
        PROCEDURE
              m90c40 (
                    layer : tsp_layer;
                    str40 : tsp_c40);
 
        PROCEDURE
              m90comment;
 
        PROCEDURE
              m90copystring (
                    VAR stringinfo : tsp_string;
                    text           : tsp_line;
                    length         : tsp_linepositions);
 
        PROCEDURE
              m90dectohex (
                    dec            : integer;
                    VAR stringinfo : tsp_string);
 
        PROCEDURE
              m90end;
 
        PROCEDURE
              m90filename (
                    layer : tsp_layer;
                    fn    : tsp_vfilename);
 
        PROCEDURE
              m90getchar (
                    VAR lineinfo  : tsp_dataline;
                    VAR character : char;
                    VAR ok        : boolean);
 
        PROCEDURE
              m90getint (
                    VAR lineinfo     : tsp_dataline;
                    VAR integervalue : integer;
                    VAR ok           : boolean);
 
        PROCEDURE
              m90getstring (
                    VAR lineinfo   : tsp_dataline;
                    VAR stringinfo : tsp_string;
                    VAR ok         : boolean);
 
        PROCEDURE
              m90hexint4 (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    int   : tsp_int4);
 
        PROCEDURE
              m90hostname (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    h     : tsp_vfilename);
 
        PROCEDURE
              m90init;
 
        PROCEDURE
              m90xtinit (
                    VAR term_ref  : tsp_int4;
                    VAR term_desc : tsp_terminal_description );
 
        PROCEDURE
              m90initio;
 
        PROCEDURE
              m90int (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    int   : integer);
 
        PROCEDURE
              m90int2 (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    int   : tsp_int2);
 
        PROCEDURE
              m90int4 (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    int   : tsp_int4);
 
        PROCEDURE
              m90real (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    zahl  : real );
 
        FUNCTION
              m90istest_on (
                    layer : tsp_layer ) : boolean;
 
        PROCEDURE
              m90limited_switch;
 
        PROCEDURE
              m90settrace (
                    s20 : tsp_c20);
 
        PROCEDURE
              m90line (
                    layer  : tsp_layer;
                    VAR ln : tsp_line);
 
        PROCEDURE
              m90lineio (
                    VAR prompt : tsp_line;
                    VAR answer : tsp_line);
 
        PROCEDURE
              m90lname (
                    layer : tsp_layer;
                    nam   : tsp_lname);
 
        PROCEDURE
              m90maxbuflength;
 
        PROCEDURE
              m90maxprotlines;
 
        PROCEDURE
              m90minbuf (
                    min_wanted : boolean);
 
        PROCEDURE
              m90name (
                    layer : tsp_layer;
                    nam   : tsp_name);
 
        PROCEDURE
              m90identifier (
                    layer : tsp_layer;
                    nam   : tsp_knl_identifier);
 
        PROCEDURE
              m90putchar (
                    VAR lineinfo : tsp_dataline;
                    character    : char;
                    VAR ok       : boolean);
 
        PROCEDURE
              m90putint (
                    VAR lineinfo : tsp_dataline;
                    integervalue : integer;
                    fieldlength  : tsp_fieldrange;
                    VAR ok       : boolean);
 
        PROCEDURE
              m90put2int (
                    VAR lineinfo : tsp_dataline;
                    integervalue : tsp_int2;
                    fieldlength  : tsp_fieldrange;
                    VAR ok       : boolean);
 
        PROCEDURE
              m90put4int (
                    VAR lineinfo : tsp_dataline;
                    integervalue : tsp_int4;
                    fieldlength  : tsp_fieldrange;
                    VAR ok       : boolean);
 
        PROCEDURE
              m90print (
                    tt : tsp_trace);
 
        PROCEDURE
              m90putprompt (
                    VAR dl       : tsp_dataline;
                    nam      : tsp_sname;
                    VAR ok       : boolean);
 
        PROCEDURE
              m90putstring (
                    VAR lineinfo   : tsp_dataline;
                    VAR stringinfo : tsp_string;
                    VAR ok         : boolean);
 
        PROCEDURE
              m90p2int4 (
                    layer : tsp_layer;
                    nam1  : tsp_sname;
                    int1  : tsp_int4;
                    nam2  : tsp_sname;
                    int2  : tsp_int4);
 
        PROCEDURE
              m90readint (
                    VAR int : integer);
 
        PROCEDURE
              m90readterm (
                    VAR lineinfo : tsp_dataline);
 
        PROCEDURE
              m90setmaxbuflength (
                    max_len : integer);
 
        PROCEDURE
              m90setpos (
                    VAR lineinfo : tsp_dataline;
                    position     : tsp_linepositions);
 
        PROCEDURE
              m90setswitch_parms (
                    protokoll       : boolean;
                    trace_schichten : tsp_c20;
                    test_schichten  : tsp_c20 );
 
        PROCEDURE
              m90settest (
                    layer : tsp_layer;
                    on    : boolean );
 
        PROCEDURE
              m90sinit;
 
        PROCEDURE
              m90skippos (
                    VAR lineinfo : tsp_dataline;
                    positions    : tsp_linepositions;
                    VAR ok       : boolean);
 
        PROCEDURE
              m90sname (
                    layer : tsp_layer;
                    nam   : tsp_sname);
 
        PROCEDURE
              m90string_readterm (
                    VAR lineinfo  : tsp_dataline;
                    VAR last_line : boolean);
 
        PROCEDURE
              m90str30 (
                    layer : tsp_layer;
                    str30 : tsp_c30);
 
        PROCEDURE
              m90switch;
 
        FUNCTION
              m90textlength (
                    text : tsp_line) : tsp_linepositions;
 
        PROCEDURE
              m90userid (
                    layer : tsp_layer;
                    nam   : tsp_knl_identifier);
 
        PROCEDURE
              m90nl;
 
        PROCEDURE
              m90wint ( int : tsp_int4 );
 
        PROCEDURE
              m90wchar ( ch : char;
                    count : integer );
 
        PROCEDURE
              m90wstring (
                    VAR str : tsp_any_packed_char;
                    strpos  : integer;
                    len     : integer );
 
        PROCEDURE
              m90w1string (
                    VAR str : tsp_any_packed_char;
                    strpos  : integer;
                    len     : integer );
 
        PROCEDURE
              m90w2string (
                    VAR str : tsp_any_packed_char;
                    strpos  : integer;
                    len     : integer );
 
        PROCEDURE
              m90wc30 (
                    str : tsp_c30;
                    len : integer );
 
        PROCEDURE
              m90wc64 (
                    str : tsp_c64;
                    len : integer );
 
        PROCEDURE
              m90resetcounter;
 
        PROCEDURE
              m90incrcounter ( i : integer );
 
        FUNCTION
              m90getcounter ( i: integer ) : tsp_int4;
 
        PROCEDURE
              m90module (
                    layer    : tsp_layer;
                    VAR auth : tsp_knl_identifier;
                    VAR appl : tsp_name;
                    VAR modn : tsp_name );
 
        PROCEDURE
              m90longdescriptor (
                    layer         : tsp_layer;
                    name          : tsp_sname;
                    VAR long_desc : tsp_long_descriptor;
                    full_info     : boolean );
 
        PROCEDURE
              m90ldb_longdescblock (
                    layer         : tsp_layer;
                    name          : tsp_sname;
                    VAR long_desc : tsp_long_desc_block;
                    full_info     : boolean );
 
        PROCEDURE
              m90anyld (
                    layer         : tsp_layer;
                    name          : tsp_sname;
                    VAR long_desc : tin_long_desc_type;
                    full_info     : boolean );
 
        PROCEDURE
              m90warn (
                    layer   : tsp_layer;
                    warnset : tsp_warningset;
                    always  : boolean );
 
        PROCEDURE
              m90buflength (
                    buflength : integer );
 
        PROCEDURE
              m90user_parms (
                    layer     : tsp_layer;
                    nam       : tsp_sname;
                    userparms : tsp4_xuser_record);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10fil (
                    size     : tsp_int4;
                    VAR m    : tsp_line;
                    pos      : tsp_int4;
                    len      : tsp_int4;
                    fillchar : char);
 
        PROCEDURE
              s10mv1 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c30;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv2 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c64;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
&       ifndef INLINK
 
      ------------------------------ 
 
        FROM
              write_protfile : VMT94;
 
        PROCEDURE
              m94create_prot (
                    VAR error : integer);
 
        PROCEDURE
              m94switch_prot (
                    first_file : boolean;
                    VAR error  : integer);
 
        PROCEDURE
              m94write_prot (
                    VAR ln    : tsp_line; anz : integer;
                    VAR error : integer);
 
        PROCEDURE
              m94close_prot;
 
      ------------------------------ 
 
        FROM
              Terminal-IO : VMT93;
 
        PROCEDURE
              m93endscreen (
                    local_sqltoff : boolean );
 
        PROCEDURE
              m93putscreen (
                    VAR text : tsp_line);
 
        PROCEDURE
              m93put (
                    VAR text : tsp_line; ft : tin_ls_fieldtype);
 
        PROCEDURE
              m9320put_screen_20 (
                    text : tsp_c20);
 
        PROCEDURE
              m9330put_screen_30 (
                    text : tsp_c30);
 
        PROCEDURE
              m93getscreen (
                    VAR text : tsp_line);
 
        PROCEDURE
              m93string_get_screen (
                    VAR text : tsp_line; VAR last_line : boolean);
 
        PROCEDURE
              m93initscreen (is_batch : boolean;
                    is_pascal_io : boolean;
                    local_sqlton  : boolean;
                    VAR term_ref  : tsp_int4;
                    VAR term_desc : tsp_terminal_description;
                    VAR batch_fn : tsp_vfilename;
                    VAR param_ln : tsp_line;
                    VAR is_ok    : boolean);
 
        PROCEDURE
              m93hold (
                    on : boolean);
 
      ------------------------------ 
 
        FROM
              ccc_count_init_output : VMT92;
 
        PROCEDURE
              m92initcount;
 
        PROCEDURE
              m92outputcount;
&       endif
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102 ;
 
        PROCEDURE
              sqlabort;
&       if $OS = VMSP
&       define STACK 1
&       endif
&       if $OS = MSDOS
&       define STACK 1
&       endif
&       ifdef STACK
 
      ------------------------------ 
 
        FROM
              RTE_kernel : VEN101;
 
        PROCEDURE
              vsinit;
 
        PROCEDURE
              vscheck (
                    VAR maxstacksize : tsp_int4);
&       endif
&       ifdef WINDOWS
 
      ------------------------------ 
 
        FROM
              RTE_kernel : VEN101;
 
        VAR
              e92initialized : boolean;
&       endif
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30: VSP30;
 
        FUNCTION
              s30gad (VAR b : tsp_buf) : tsp_objaddr;
 
        FUNCTION
              s30klen (VAR str : tsp_name;
                    val : char; cnt : integer) : integer;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj tsp_c30;
              tsp_moveobj tsp_line;
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tsp_c64;
              tsp_moveobj tsp_line;
 
        PROCEDURE
              m93putscreen;
 
              tin_screenline   tsp_line
 
        PROCEDURE
              m93put;
 
              tin_screenline   tsp_line
 
        PROCEDURE
              s10fil;
 
              tsp_moveobj          tsp_line
 
        FUNCTION
              s30klen;
 
              tsp_moveobj          tsp_name
 
        FUNCTION
              s30gad;
 
              tsp_moveobj          tsp_buf
              tsp_addr             tsp_objaddr
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : 
.sp
.cp 3
Created : 1980-01-30
.sp
.cp 3
Version : 1997-05-23
.sp
.cp 3
Release :  6.2.8.3       Date : 1997-05-23
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.nf
------------------------------------------------------
| ZUR ERWEITERUNG VON TRACE UND TEST DIE MIT (*+++*) |
| MARKIERTEN STATEMENTS AENDERN !                    |
------------------------------------------------------
.sp 2;.fo;.cp 5
PROCEDURE  TD_INIT:
.sp 1
Initialisiert das Terminal, den File 'PROT' f?ur Testausgaben
und g12runtime,
und fragt ob Trace f?ur die verschiedenen Schichten eingeschaltet
werden soll.
Bei Angabe dialog = true
wird noch ?ubers Terminal abgefragt, ob man die Testausgaben
auch ?ubers Terminal und Protfile haben will.
Eine ?Uberschrift f?ur den File 'prot' wird ?ubers  Terminal
angefordert.
Bei Angabe dialog = false unterbleibt der Dialog am Terminal.
Es gibt aber die Trace Ausgabe nicht ?ubers Terminal.
In den File 'prot' werden immer alle
Testausgaben geschrieben,
und entf?allt die  Protfile ?Uberschrift.
.sp
Bei Runtime_messungen mu?z m90init (enth?alt g12init_time)
vor dem Aufruf 'sequetial_program' stehen.
.sp 4
PROCEDURE  TD_INT:
.sp 1;.fo
Gibt den Namen nam mit der angegebenen Integerzahl aus.
.sp 4
PROCEDURE  TD_REAL:
.sp 1;.fo
Gibt den Namen nam mit der angegebenen Realzahl aus.
.sp 4
PROCEDURE  TD_CHAR:
.sp 1;.fo
Gibt den Namen nam mit dem angegebenen Charakter in
Hochkomma aus.
.sp 4
PROCEDURE  TD_LINE:
.sp 1;.fo
Gibt einen Text, der in Line angegeben ist,
aus.
.sp 4
PROCEDURE  TD_STRING30:
.sp 1;.fo
Gibt einen String (30 Lang), der in str angegeben ist,
aus.
.sp 4
PROCEDURE  TD_NAME:
.sp 1;.fo
Gibt einen Namen, der in nam angegeben ist,
aus.
.sp 4
PROCEDURE  TD_LOC_SET:
.sp 1;.fo
Gibt den Locationset, der in loc angegeben ist,
in Interndarstellung und Hexadecimal aus.
.sp 4
PROCEDURE  TD_VAL:
.sp 1;.fo
Gibt einen Value, der in val angegeben ist,
in Interndarstellung aus,
und Hexadecimal ?uber den Drucker.
.sp 4
PROCEDURE TD_KEY:
.sp 1;.fo
Gibt einen Key, der in k angegeben ist, aus.
.sp 4
PROCEDURE TD_FILENAME:
.sp 1;.fo
Gibt einen Filename, der in fn angegeben ist, aus.
.sp 4
PROCEDURE  TD_BUF:
.sp 1;.fo
Gibt einen Buffer, der in buf angegeben ist,
evtl. ?ubers Terminal und
?uber den File prot in Hexadecimaldarstellung aus.
Die Ausgabepositionen werden mit pos_anfang und pos_ende
angegeben. Ist pos_ende = 0, so wird ab pos = 1 und pos_ende
wird errechnet, d. h. alle Blanks im Ende des
Puffers werden nicht gedruckt.
.sp 4
PROCEDURE  TD_PRINT_BUF:
.sp
Die  Treminal-Ausgabe wird ausgeschaltet, und m90buf aufgerufen.
Anschlie?zend wird die  alte Terminal-Angabe (m90term) wieder
gesetzt.
.sp 4
PROCEDURE  CCCPRINT:
.sp;.fo
Druckroutine f?ur den Trace. Druckt am Anfang  einer
Routine 'vdn-name
Routinen-name *', wenn f?ur die entsprechende Schicht der Trace
verlangt wird.
Die Procedure wird bei dem Exec-Aufruf VDNPASC
automatisch in jede Routine gesetzt.
Alle Proceduren aus VGG09, VTA02 und VTA01 werden nicht
gedruckt.
.sp 4
PROCEDURE  TD_MESS_BUFFER:
.sp;.fo
Druckt einen Mess_bufer aus mit den Komponenten
mess_type, mess_string_length und mess_string.
.sp 4
PROCEDURE  TD_READ_INT:
.sp 1;.fo
Liest eine Integerzahl ?ubers Terminal ein.
.sp 4
.sp 2
PROCEDURE  CCCCOUNT:
.sp;.fo
Z?ahlt die Anzahl der Ausf?uhrungen einer Routine.
.sp 4
PROCEDURE  CCCINIT:
.sp;.fo
Initiatisiert die globale Variable f?ur die Zeitmessungen.
.sp 4
PROCEDURE  TIMERANF:
.sp;.fo
Berechnung der Anfangszeit.
.sp 4
PROCEDURE  TIMEREND:
.sp;.fo
Berechnung der verbrauchten Zeit und Aufsummierung
in der globalen Variablen.
.sp 4
PROCEDURE  CCCOUTP:
.sp;.fo
Schreibt f?ur eine Routine die globale Variable der
Messergebnisse in den File 'prot'.
.sp 4
PROCEDURE  m90setswitch_parms
                          ( protokoll : boolean;
                          trace_schichten : c20;
                          test_schichten : c20 );
.sp;
Funktion: Einschalten des Protokolls auf File
.sp;
Eingabe-Parameter:
.nf;
   - protokoll : TRUE - schaltet das Protokoll ein
                 FALSE - schaltet das Protokoll aus
   - traceschichten : Angabe aller Schichten-K?urzel, f?ur die
                 Traceausgaben erstellt werden sollen.
                 Sie m?ussen in Gro?zbuchstaben angegeben werden.
                 z.B. 'INQU                '-> IN- und QU-Schicht.
   - testschichten : entsprechend traceschichten f?ur die
                 Testausgaben.
.CM *-END-* specification -------------------------------
.fo;
.sp 4
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description                      :
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(* trace text von cccprint *)
CONST
      linend     = ' ';
      max_n      = 12;
 
TYPE
 
      states_td = RECORD
            on_text       : tsp_trace;
            off_text      : tsp_trace;
            on_count      : integer;
            maxlength     : integer;
            first_file    : boolean;
            protlinecnt   : integer;
            maxprotlines  : integer;
            minbuf        : boolean;
            last_schicht  : char;
            test_or_trace : boolean;
            trace_in      : boolean;
            trace_lo      : boolean;
            trace_na      : boolean;
            trace_wb      : boolean;
            trace_ye      : boolean;
            trace_dg      : boolean;
            trace_fc      : boolean;
            trace_pc      : boolean;
            trace_qu      : boolean;
            trace_cp      : boolean;
            test_schicht  : SET OF tsp_layer;
      END;
 
 
VAR
      m90 : states_td;
      m90digiset : SET OF char;
      m90upper_letters : SET OF char;
      m90lower_letters : SET OF char;
      m90specsigns    : SET OF char;
      m90table : PACKED ARRAY [ 1..256 ] OF char;
      m90outputline : tsp_dataline;
      m90counter    : ARRAY [1..10 ] OF tsp_int4;
 
 
(*------------------------------*) 
 
PROCEDURE
      m90init;
 
VAR
      term_ref  : tsp_int4;
      term_desc : tsp_terminal_description;
 
BEGIN
m90__init ( true, term_ref, term_desc );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90xtinit (
            VAR term_ref  : tsp_int4;
            VAR term_desc : tsp_terminal_description );
 
BEGIN
m90__init ( false, term_ref, term_desc );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90__init (
            local_sqlton  : boolean;
            VAR term_ref  : tsp_int4;
            VAR term_desc : tsp_terminal_description );
 
VAR
      ln           : tsp_line;
      batch_fn     : tsp_vfilename;
      i, err       : integer;
      is_batch     : boolean;
      is_pascal_io : boolean;
      sqlton_ok    : boolean;
 
BEGIN
&ifdef STACK
vsinit;
&endif
m92initcount;
m90initio;
m94create_prot (err);
(*t05get_term_param (is_batch, is_pascal_io, batch_fn, ln);*)
is_batch := false;
is_pascal_io := false;
FOR i := 1 TO mxsp_vfilename DO
    batch_fn  [i]  := ' ';
(*ENDFOR*) 
&ifndef BATCH
m93initscreen (is_batch, is_pascal_io, local_sqlton,
      term_ref, term_desc, batch_fn, ln, sqlton_ok);
&endif
m90.maxlength := mxsp_any_packed_char;
m90.first_file := true;
m90.protlinecnt := 0;
m90.maxprotlines := csp_maxint4;
m90.minbuf := false;
m90term := false;
m90prot := true;
m90.test_schicht := [ ] ;
set_trace_test (true);
IF  batch_fn [1]  = ' '
THEN
    m90sname (xx, 'PROTOKOLL   ')
ELSE
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO mxsp_vfilename DO
        ln [i]  := batch_fn [i] ;
    (*ENDFOR*) 
    m90write_line (ln)
    END;
(*ENDIF*) 
m90outputline := m90blankline;
&ifdef WINDOWS
e92initialized := true;
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90sinit;
 
BEGIN
&ifdef STACK
vsinit;
&endif
m90term      := false;
m90prot      := true;
m90.minbuf    := false;
m90.maxlength := mxsp_any_packed_char;
m90.test_schicht := [ ] ;
set_trace_test (true);
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90end;
 
BEGIN
m92outputcount;
&ifndef BATCH
m93endscreen ( true );
&endif
m94close_prot
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90real (
            layer : tsp_layer;
            nam   : tsp_sname;
            zahl  : real );
 
VAR
      dl : tsp_dataline;
      ok : boolean;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    m90putprompt  (dl, nam, ok);
    m90putreal    (dl, zahl, 10, ok);
    m90write_line (dl.text)
    END
(*ENDIF*) 
END; (* m90real *)
 
(*------------------------------*) 
 
PROCEDURE
      m90int (
            layer : tsp_layer; nam : tsp_sname;
            int   : integer);
 
VAR
      dl : tsp_dataline;
      ok : boolean;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    m90putprompt ( dl, nam, ok );
    m90putint (dl,int, 6, ok);
    m90write_line (dl.text)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90int2 (
            layer : tsp_layer; nam : tsp_sname;
            int   : tsp_int2);
 
VAR
      dl : tsp_dataline;
      ok : boolean;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    m90putprompt ( dl, nam, ok );
    m90putint (dl,int, 6, ok);
    m90write_line (dl.text)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90int4 (
            layer : tsp_layer;
            nam   : tsp_sname;
            int   : tsp_int4);
 
VAR
      dl : tsp_dataline;
      ok : boolean;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    m90putprompt ( dl, nam, ok );
    m90put4int (dl,int, 11, ok);
    m90write_line (dl.text)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90p2int4 (
            layer : tsp_layer;
            nam1  : tsp_sname;
            int1  : tsp_int4;
            nam2  : tsp_sname;
            int2  : tsp_int4);
 
VAR
      dl : tsp_dataline;
      i  : integer;
      ok : boolean;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    m90putprompt ( dl, nam1, ok );
    m90put4int (dl,int1, 11, ok);
    FOR i := 1 TO max_n DO
        dl.text [dl.pos+3+i ] := nam2 [i] ;
    (*ENDFOR*) 
    dl.text [dl.pos+3+max_n+2 ] := ':';
    dl.pos    := dl.pos + 3 + max_n + 4;
    dl.length := dl.pos + 1;
    m90put4int (dl,int2, 11, ok);
    m90write_line (dl.text)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90hexint4 (
            layer : tsp_layer;
            nam   : tsp_sname;
            int   : tsp_int4);
 
VAR
      dl : tsp_dataline;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    WITH dl DO
        BEGIN
        FOR i := 1 TO max_n DO
            text [i]  := nam [i] ;
        (*ENDFOR*) 
        text [max_n+2 ] := ':';
        length := max_n + 5;
        length := length + 1;
        text [length ] := '''';
        put4hexint (dl,int);
        length := length + 1;
        text [length ] := '''';
        length := length + 1;
        text [length ] := 'h';
        END;
    (*ENDWITH*) 
    m90write_line (dl.text)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put4hexint (
            VAR dl : tsp_dataline;
            int    : tsp_int4);
 
TYPE
 
      int4_map_int1 = RECORD
            CASE boolean OF
                true:
                    (i4 : tsp_int4);
                false:
                    (i1 : PACKED ARRAY [1..4 ] OF char);
                END;
            (*ENDCASE*) 
 
 
VAR
      map : int4_map_int1;
      i : integer;
 
BEGIN
WITH map DO
    BEGIN
    i4 := int;
    FOR i := 1 TO 4 DO
        put_hexint1(dl,ord(i1 [i] ));
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_hexint1 (
            VAR dl : tsp_dataline;
            int    : integer);
 
VAR
      upper, lower : integer;
 
BEGIN
upper := int DIV 16;
lower := int MOD 16;
put_hexhalf(dl,upper);
put_hexhalf(dl,lower);
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_hexhalf (
            VAR dl : tsp_dataline;
            int    : integer);
 
BEGIN
WITH dl DO
    BEGIN
    length := length + 1;
    IF  int <= 9
    THEN
        text [length ] := chr(ord('0') + int)
    ELSE
        text [length ] := chr(ord('A') + (int-10));
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90char (
            layer : tsp_layer;
            nam   : tsp_sname; c : char);
 
VAR
      ln : tsp_line;
      i : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO max_n DO
        ln [i]  := nam [i] ;
    (*ENDFOR*) 
    ln [max_n+2 ] := ':';
    ln [max_n+3 ] := '''';
    ln [max_n+4 ] := c;
    ln [max_n+5 ] := '''';
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90line (
            layer  : tsp_layer;
            VAR ln : tsp_line);
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    m90write_line (ln)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90name (
            layer : tsp_layer;
            nam   : tsp_name);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO mxsp_name DO
        IF  nam [i] = csp_unicode_mark
        THEN
            ln [i] := '.'
        ELSE
            ln [i]  := nam [i] ;
        (*ENDIF*) 
    (*ENDFOR*) 
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90identifier (
            layer : tsp_layer;
            nam   : tsp_knl_identifier);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO sizeof(tsp_knl_identifier) DO
        IF  nam [i] = csp_unicode_mark
        THEN
            ln [i] := '.'
        ELSE
            ln [i]  := nam [i] ;
        (*ENDIF*) 
    (*ENDFOR*) 
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90lname (
            layer : tsp_layer;
            nam   : tsp_lname);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO mxsp_lname DO
        ln [i]  := nam [i] ;
    (*ENDFOR*) 
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90sname (
            layer : tsp_layer;
            nam   : tsp_sname);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO mxsp_sname DO
        ln [i]  := nam [i] ;
    (*ENDFOR*) 
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90c12 (
            layer : tsp_layer;
            nam   : tsp_c12);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO 12  DO
        ln [i]  := nam [i] ;
    (*ENDFOR*) 
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90hostname (
            layer : tsp_layer;
            nam   : tsp_sname; h : tsp_vfilename);
 
VAR
      ln : tsp_line;
      i : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO max_n DO
        ln [i]  := nam [i] ;
    (*ENDFOR*) 
    ln [max_n+2 ] := ':';
    ln [max_n+4 ] := '''';
    FOR i := 1 TO mxsp_vfilename DO
        ln [i+max_n+4 ] := h [i] ;
    (*ENDFOR*) 
    ln [max_n+4+mxsp_vfilename+1 ] := '''';
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90filename (
            layer : tsp_layer;
            fn    : tsp_vfilename);
 
VAR
      i  : integer;
      ln : tsp_line;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO mxsp_vfilename DO
        ln [i]  := fn [i] ;
    (*ENDFOR*) 
    m90line (layer, ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90str30 (
            layer : tsp_layer;
            str30 : tsp_c30);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO 30 DO
        ln [i]  := str30 [i] ;
    (*ENDFOR*) 
    m90line (layer, ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90c30 (
            layer : tsp_layer;
            str30 : tsp_c30);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO 30 DO
        ln [i]  := str30 [i] ;
    (*ENDFOR*) 
    m90line (layer, ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90c40 (
            layer : tsp_layer;
            str40 : tsp_c40);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO 40 DO
        ln [i]  := str40 [i] ;
    (*ENDFOR*) 
    m90line (layer, ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90buf1 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_end );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90buf2 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_end );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90buf3 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_end );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90buf4 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_end );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90buf5 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_end );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90buf6 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_end );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90buf (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
VAR
      lwb : integer;
      upb : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    IF  (pos_anf < 1) OR (pos_anf > mxsp_any_packed_char)
    THEN
        BEGIN
        lwb := 1;
        m90int (layer, 'TD_BUF: lwb ', pos_anf)
        END
    ELSE
        lwb := pos_anf;
    (*ENDIF*) 
    IF  (pos_end < pos_anf) OR (pos_end > mxsp_any_packed_char)
    THEN
        BEGIN
        upb := pos_anf + 19;
        IF  upb > mxsp_any_packed_char
        THEN
            upb := mxsp_any_packed_char;
        (*ENDIF*) 
        m90int (layer, 'TD_BUF: upb ', pos_end)
        END
    ELSE
        upb := pos_end;
    (*ENDIF*) 
    IF  upb > lwb + m90.maxlength - 1
    THEN
        upb := lwb + m90.maxlength - 1;
    (*ENDIF*) 
    IF  m90.minbuf
    THEN
        min_puthexbuf (buf, lwb, upb)
    ELSE
        puthexbuf (buf, lwb, upb)
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90ascii (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
VAR
      lwb : integer;
      upb : integer;
 
BEGIN
init_ascii_table;
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    IF  (pos_anf < 1) OR (pos_anf > mxsp_any_packed_char)
    THEN
        BEGIN
        lwb := 1;
        m90int (layer, 'TD_BUF: lwb ', pos_anf)
        END
    ELSE
        lwb := pos_anf;
    (*ENDIF*) 
    IF  (pos_end < pos_anf) OR (pos_end > mxsp_any_packed_char)
    THEN
        BEGIN
        upb := pos_anf + 19;
        IF  upb > mxsp_any_packed_char
        THEN
            upb := mxsp_any_packed_char;
        (*ENDIF*) 
        m90int (layer, 'TD_BUF: upb ', pos_end)
        END
    ELSE
        upb := pos_end;
    (*ENDIF*) 
    IF  upb > lwb + m90.maxlength - 1
    THEN
        upb := lwb + m90.maxlength - 1;
    (*ENDIF*) 
    IF  m90.minbuf
    THEN
        min_puthexbuf (buf, lwb, upb)
    ELSE
        puthexascii (buf, lwb, upb)
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90asc1ii(
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            pos_end : integer);
 
BEGIN
m90ascii( layer, buf, pos_anf, pos_end );
END;
 
(*------------------------------*) 
 
PROCEDURE
      puthexbuf (
            VAR buf   : tsp_buf;
            startpos  : integer;
            endpos    : integer);
 
CONST
      s6length = 28;
 
VAR
      ll  : tsp_line;
      l1,l2,l3,l4 : tsp_dataline;
      s1,s2,s3,s4 : tsp_string;
      s5,s6,s7    : tsp_string;
      dec,spos,epos,i,k: integer;
      cpos   : integer;
      ok          : boolean;
      maxpos      : integer;
      lt          : PACKED ARRAY  [ 1..s6length ]  OF char;
      text        : tsp_objaddr;
 
BEGIN
text := s30gad ( buf );
maxpos := 20;
(* SET positions *)
IF  (startpos = 0) OR (endpos < startpos)
THEN
    BEGIN
    spos := 0;
    epos := mxsp_any_packed_char
    END
ELSE
    BEGIN
    spos := startpos - 1;
    epos := endpos
    END;
(*ENDIF*) 
(* INIT all lines *)
l1 := m90blankline;
l2 := m90blankline;
l3 := m90blankline;
l4 := m90blankline;
IF  (epos - spos) >= maxpos
THEN
    BEGIN
    k := (maxpos*3) + 4 - s6length;
    m90setpos (l1, k)
    END
ELSE
    k := 0;
(*ENDIF*) 
IF  endpos - startpos > 1000
THEN
    m90sname ( xx, 'BEGINBUF    ' );
(* stringconst *)
(*ENDIF*) 
ll  [1]   := 'p';
ll  [2]   := 'o';
ll  [3]   := 's';
ll  [4]   := ':';
m90copystring (s1,ll,4);
ll  [1]   := 'd';
ll  [2]   := 'e';
ll  [3]   := 'c';
ll  [4]   := ':';
m90copystring (s2,ll,4);
ll  [1]   := 'h';
ll  [2]   := 'e';
ll  [3]   := 'x';
ll  [4]   := ':';
m90copystring (s3, ll,4);
ll  [1]   := 'c';
ll  [2]   := 'h';
ll  [3]   := 'r';
ll  [4]   := ':';
m90copystring (s4,ll,4);
ll  [1]   := ' ';
ll  [2]   := ' ';
m90copystring (s5,ll,2);
lt := 'buffer FROM       TO        ';
FOR i := 1 TO s6length DO
    ll  [i]   := lt  [i]  ;
(*ENDFOR*) 
m90copystring (s6, ll, s6length);
m90putstring (l1, s6, ok);
m90setpos (l1,k+13);
m90put2int (l1, spos+1, 4, ok);
m90setpos (l1, k+22);
m90put2int (l1, epos, 4, ok);
l1.text  [ l1.pos+1 ]  := linend;
m90write_line (l1.text);
l1 := m90blankline;
REPEAT
    m90putstring (l1,s1,ok);
    m90putstring (l2,s2,ok);
    m90putstring (l3,s3,ok);
    m90putstring (l4,s4,ok);
    i := 0;
    REPEAT
        i := succ(i);
        spos := succ (spos);
        k := spos DIV 1000;
        cpos := spos - (1000 * k);
        m90put2int (l1,cpos,3,ok);      (* bufferpositions *)
        dec := ord (text^[ spos] );
        m90put2int  (l2,dec,3,ok);      (* decimal-value *)
        m90dectohex (dec,s7);          (* hex-value *)
        m90putstring (l3,s7,ok);
        IF  text^[spos ] IN ( m90specsigns + m90lower_letters
            + m90upper_letters + m90digiset )
        THEN
            BEGIN
            m90putstring (l4,s5,ok);
            m90putchar   (l4,text^[ spos ] ,ok)
            END
        ELSE
            m90skippos (l4,3,ok)
        (*ENDIF*) 
    UNTIL
        ((i = maxpos) OR (spos = epos));
    (*ENDREPEAT*) 
    l1.text  [ l1.pos+1 ]  := linend;
    l2.text  [ l2.pos+1 ]  := linend;
    l3.text  [ l3.pos+1 ]  := linend;
    l4.text  [ l4.pos+1 ]  := linend;
    m90write_line (l1.text);
    m90write_line (l2.text);
    m90write_line (l3.text);
    m90write_line (l4.text);
    l1 := m90blankline;
    IF  k > 0
    THEN
        BEGIN
        m90skippos (l1, maxpos-8, ok);
        m90put2int (l1,k,1,ok);
        l1.text [ l1.pos+1 ] := ' ';
        l1.text [ l1.pos+2 ] := '*';
        l1.text [ l1.pos+3 ] := '*';
        l1.text [ l1.pos+4 ] := linend;
        END
    ELSE
        l1.text   [2]   := linend;
    (*ENDIF*) 
    m90write_line (l1.text);
    l1 := m90blankline;
    l2 := m90blankline;
    l3 := m90blankline;
    l4 := m90blankline
UNTIL
    (spos = epos);
(*ENDREPEAT*) 
IF  endpos - startpos > 1000
THEN
    m90sname ( xx, 'ENDBUF      ' );
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      puthexascii (
            VAR buf   : tsp_buf;
            startpos  : integer;
            endpos    : integer);
 
CONST
      s6length = 28;
 
VAR
      ll  : tsp_line;
      l1,l2,l3,l4 : tsp_dataline;
      s1,s2,s3,s4 : tsp_string;
      s5,s6,s7    : tsp_string;
      dec,spos,epos,i,k: integer;
      cpos   : integer;
      ok          : boolean;
      maxpos      : integer;
      lt          : PACKED ARRAY  [ 1..s6length ]  OF char;
      cc          : char;
      text        : tsp_objaddr;
 
BEGIN
text := s30gad ( buf );
maxpos := 20;
(* SET positions *)
IF  (startpos = 0) OR (endpos < startpos)
THEN
    BEGIN
    spos := 0;
    epos := mxsp_any_packed_char
    END
ELSE
    BEGIN
    spos := startpos - 1;
    epos := endpos
    END;
(*ENDIF*) 
(* INIT all lines *)
l1 := m90blankline;
l2 := m90blankline;
l3 := m90blankline;
l4 := m90blankline;
IF  (epos - spos) >= maxpos
THEN
    BEGIN
    k := (maxpos*3) + 4 - s6length;
    m90setpos (l1, k)
    END
ELSE
    k := 0;
(*ENDIF*) 
(* stringconst *)
ll  [1]   := 'p';
ll  [2]   := 'o';
ll  [3]   := 's';
ll  [4]   := ':';
m90copystring (s1,ll,4);
ll  [1]   := 'd';
ll  [2]   := 'e';
ll  [3]   := 'c';
ll  [4]   := ':';
m90copystring (s2,ll,4);
ll  [1]   := 'h';
ll  [2]   := 'e';
ll  [3]   := 'x';
ll  [4]   := ':';
m90copystring (s3, ll,4);
ll  [1]   := 'a';
ll  [2]   := 's';
ll  [3]   := 'c';
ll  [4]   := ':';
m90copystring (s4,ll,4);
ll  [1]   := ' ';
ll  [2]   := ' ';
m90copystring (s5,ll,2);
lt := 'buffer FROM       TO        ';
FOR i := 1 TO s6length DO
    ll  [i]   := lt  [i]  ;
(*ENDFOR*) 
m90copystring (s6, ll, s6length);
m90putstring (l1, s6, ok);
m90setpos (l1,k+13);
m90put2int (l1, spos+1, 4, ok);
m90setpos (l1, k+22);
m90put2int (l1, epos, 4, ok);
l1.text  [ l1.pos+1 ]  := linend;
m90write_line (l1.text);
l1 := m90blankline;
REPEAT
    m90putstring (l1,s1,ok);
    m90putstring (l2,s2,ok);
    m90putstring (l3,s3,ok);
    m90putstring (l4,s4,ok);
    i := 0;
    REPEAT
        i := succ(i);
        spos := succ (spos);
        k := spos DIV 1000;
        cpos := spos - (1000 * k);
        m90put2int (l1,cpos,3,ok);      (* bufferpositions *)
        dec := ord (text^[ spos] );
        m90put2int  (l2,dec,3,ok);      (* decimal-value *)
        m90dectohex (dec,s7);          (* hex-value *)
        m90putstring (l3,s7,ok);
        cc := text^[spos] ;
        to_ebcdic(cc);
        IF  cc IN ( m90specsigns + m90lower_letters
            + m90upper_letters + m90digiset )
        THEN
            BEGIN
            m90putstring (l4,s5,ok);
            m90putchar   (l4,cc ,ok)
            END
        ELSE
            m90skippos (l4,3,ok)
        (*ENDIF*) 
    UNTIL
        ((i = maxpos) OR (spos = epos));
    (*ENDREPEAT*) 
    l1.text  [ l1.pos+1 ]  := linend;
    l2.text  [ l2.pos+1 ]  := linend;
    l3.text  [ l3.pos+1 ]  := linend;
    l4.text  [ l4.pos+1 ]  := linend;
    m90write_line (l1.text);
    m90write_line (l2.text);
    m90write_line (l3.text);
    m90write_line (l4.text);
    l1 := m90blankline;
    IF  k > 0
    THEN
        BEGIN
        m90skippos (l1, maxpos-8, ok);
        m90put2int (l1,k,1,ok);
        l1.text [ l1.pos+1 ] := ' ';
        l1.text [ l1.pos+2 ] := '*';
        l1.text [ l1.pos+3 ] := '*';
        l1.text [ l1.pos+4 ] := linend;
        END
    ELSE
        l1.text   [2]   := linend;
    (*ENDIF*) 
    m90write_line (l1.text);
    l1 := m90blankline;
    l2 := m90blankline;
    l3 := m90blankline;
    l4 := m90blankline
UNTIL
    (spos = epos)
(*ENDREPEAT*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      min_puthexbuf (
            VAR buf     :  tsp_buf;
            startpos    : integer;
            endpos      : integer);
 
CONST
      bytes_per_line = 30;
 
VAR
      l1, l2       : tsp_dataline;
      msg_str      : tsp_string;
      hex_str      : tsp_string;
      spos, epos   : integer;
      i            : integer;
      ok           : boolean;
      skip_output  : boolean;
      last_skipped : boolean;
      buf_msg      : tsp_c20;
      text         : tsp_objaddr;
 
BEGIN
text := s30gad ( buf );
(* SET positions *)
IF  (startpos = 0) OR (endpos < startpos)
THEN
    BEGIN
    spos := 0;
    epos := mxsp_any_packed_char
    END
ELSE
    BEGIN
    spos := startpos - 1;
    epos := endpos
    END;
(*ENDIF*) 
buf_msg := 'BUFFER FROM      TO ';
FOR i := 1 TO 20 DO
    msg_str.text  [i]  := buf_msg  [i]  ;
(*ENDFOR*) 
msg_str.length := 20;
l1 := m90blankline;
m90putstring (l1, msg_str, ok);
m90setpos (l1, 12);
m90put2int (l1, spos+1, 4, ok);
m90setpos (l1, 21);
m90put2int (l1, epos, 4, ok);
l1.text [ l1.pos+1 ]  := linend;
m90write_line (l1.text);
last_skipped := false;
REPEAT
    skip_output := false;
    IF  (spos >= bytes_per_line) AND (spos + bytes_per_line <= epos)
    THEN
        BEGIN
        i := spos + 1;
        skip_output := true;
        REPEAT
            IF  text^[i-bytes_per_line ] <> text^[i]
            THEN
                skip_output := false;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            NOT skip_output OR (i > spos + bytes_per_line)
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    IF  skip_output AND NOT last_skipped
    THEN
        BEGIN
        last_skipped := true;
        buf_msg := '   ...       TO     ';
        FOR i := 1 TO 15 DO
            msg_str.text  [i]  := buf_msg  [i]  ;
        (*ENDFOR*) 
        msg_str.length := 15;
        l1 := m90blankline;
        m90putstring (l1, msg_str, ok);
        m90setpos (l1, 8);
        m90put2int (l1, spos+1, 4, ok);
        END;
    (*ENDIF*) 
    IF  skip_output
    THEN
        spos := spos + bytes_per_line
    ELSE
        BEGIN
        IF  last_skipped
        THEN
            BEGIN
            m90setpos (l1, 16);
            m90put2int (l1, spos, 4, ok);
            l1.text [ l1.pos+1 ] := linend;
            m90write_line (l1.text);
            last_skipped := false
            END;
        (*ENDIF*) 
        l1 := m90blankline;
        l2 := m90blankline;
        IF  spos >= 999
        THEN
            BEGIN
            m90put2int (l1, (spos+1) DIV 1000, 1, ok);
            m90skippos (l1, 1, ok);
            m90put2int (l2, ((spos+1) DIV 100) MOD 10, 1, ok);
            m90put2int (l2, ((spos+1) DIV  10) MOD 10, 1, ok);
            m90put2int (l2,  (spos+1)          MOD 10, 1, ok)
            END
        ELSE
            BEGIN
            m90skippos (l1, 2, ok);
            m90put2int  (l2, spos+1, 3, ok)
            END;
        (*ENDIF*) 
        i := 0;
        REPEAT
            i := succ(i);
            spos := succ (spos);
            IF  (i MOD 10) = 1
            THEN
                BEGIN
                m90skippos (l1, 1, ok);
                IF  i > 1
                THEN
                    m90skippos (l2, 1, ok)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            m90dectohex (ord(text^[spos] ), hex_str);
            (* remove leading blank *)
            hex_str.text [1]  := hex_str.text [2] ;
            hex_str.text [2]  := hex_str.text [3] ;
            hex_str.length := 2;
            m90putstring (l1, hex_str, ok);
            IF  text^[spos ] IN ( m90specsigns + m90lower_letters
                + m90upper_letters + m90digiset )
            THEN
                BEGIN
                m90skippos (l2, 1, ok);
                m90putchar (l2, text^[spos] , ok)
                END
            ELSE
                IF  ((i MOD 2) = 1) AND ((i MOD 10) <> 1)
                THEN
                    BEGIN
                    m90putchar (l2, '|', ok);
                    m90skippos (l2, 1, ok)
                    END
                ELSE
                    m90skippos (l2, 2, ok)
                (*ENDIF*) 
            (*ENDIF*) 
        UNTIL
            (i = bytes_per_line) OR (spos >= epos);
        (*ENDREPEAT*) 
        l1.text  [ l1.pos+1 ]  := linend;
        l2.text  [ l2.pos+1 ]  := linend;
        m90write_line (l1.text);
        m90write_line (l2.text)
        END
    (*ENDIF*) 
UNTIL
    spos >= epos;
(*ENDREPEAT*) 
IF  last_skipped
THEN
    BEGIN
    m90setpos (l1, 16);
    m90put2int (l1, spos, 4, ok);
    l1.text [ l1.pos+1 ] := linend;
    m90write_line (l1.text)
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90readint (
            VAR int : integer);
 
VAR
      int_line : tsp_dataline;
      ok : boolean;
 
BEGIN
&ifndef BATCH
REPEAT
    m9330put_screen_30 ('Positive ganze Zahl angeben : ');
    WITH int_line DO
        BEGIN
        m93getscreen (text);
        pos := 0;
        WHILE (pos+1 < mxsp_line) AND (text [ pos+1 ] = ' ') DO
            pos := succ (pos);
        (*ENDWHILE*) 
        length := mxsp_line;
        WHILE (length > 1) AND (text [ length ] = ' ') DO
            length := pred (length);
        (*ENDWHILE*) 
        IF  length >= pos
        THEN
            m90getint (int_line, int, ok)
        ELSE
            ok := false;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    IF  NOT ok
    THEN
        m9320put_screen_20 ('fehlerhafte Eingabe!')
    (*ENDIF*) 
UNTIL
    ok;
(*ENDREPEAT*) 
m90int (xx, 'input       ', int)
&     endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90print (
            tt : tsp_trace);
 
CONST
      anf_schicht = 1;
 
VAR
      stacksize      : tsp_int4;
      i              : integer;
      ln             : tsp_dataline;
      ok             : boolean;
      switched_on    : boolean;
      trace_en_gg_sp : boolean;
      trace_output   : boolean;
      ft             : tin_ls_fieldtype;
 
BEGIN
&ifdef WINDOWS
IF  e92initialized
THEN
&   endif
    BEGIN
    switched_on := false;
    IF  m90.on_text = tt
    THEN
        BEGIN
        m90.on_count := m90.on_count - 1;
        IF  m90.on_count = 0
        THEN
            BEGIN
            IF  m90.off_text = 'STOP            '
            THEN
                BEGIN
                sqlabort;
                END
            ELSE
                BEGIN
                m90.on_text := '                ';
                m90.test_or_trace := true;
                switched_on := true
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  m90.test_or_trace
    THEN
        BEGIN
        IF  (m90.off_text = tt) AND NOT switched_on
        THEN
            BEGIN
            m90.test_or_trace := false;
            m90.off_text := '                '
            END
        ELSE
            BEGIN
            trace_output   := false;
            trace_en_gg_sp := false;
            CASE tt [ anf_schicht ]  OF
                'd' , 'D':
                    IF  m90.trace_dg
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'f' , 'F':
                    IF  m90.trace_fc
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'i' , 'I':
                    IF  m90.trace_in
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'l' , 'L':
                    IF  m90.trace_lo
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'n' , 'N':
                    IF  m90.trace_na
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'w' , 'W':
                    IF  m90.trace_wb
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'y' , 'Y':
                    IF  m90.trace_ye
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'q' , 'Q':
                    IF  m90.trace_qu
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'p' , 'P':
                    IF  m90.trace_pc
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                'c' , 'C':
                    IF  m90.trace_cp
                    THEN
                        BEGIN
                        trace_output := true;
                        m90.last_schicht := tt [ anf_schicht ]
                        END;
                    (*ENDIF*) 
                OTHERWISE:
                    trace_output := true
                END;
            (*ENDCASE*) 
            IF  trace_en_gg_sp
            THEN
                CASE m90.last_schicht OF
                    'd' , 'D':
                        IF  m90.trace_dg
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'f' , 'F':
                        IF  m90.trace_fc
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'i' , 'I':
                        IF  m90.trace_in
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'l' , 'L':
                        IF  m90.trace_lo
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'n' , 'N':
                        IF  m90.trace_na
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'w' , 'W':
                        IF  m90.trace_wb
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'y' , 'Y':
                        IF  m90.trace_ye
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'p' , 'P':
                        IF  m90.trace_pc
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'q' , 'Q':
                        IF  m90.trace_qu
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    'c' , 'C':
                        IF  m90.trace_cp
                        THEN
                            trace_output := true;
                        (*ENDIF*) 
                    OTHERWISE:
                        trace_output := false
                    END;
                (*ENDCASE*) 
            (*ENDIF*) 
            IF  trace_output
            THEN
                BEGIN
                ln := m90blankline;
                FOR i := 1 TO 16 DO
                    ln.text [i]  := tt [i] ;
                (*ENDFOR*) 
                ln.pos:= 17;
                ln.length:= 18;
&               ifdef STACK
                vscheck (stacksize);
                m90put4int (ln, stacksize, 10, ok);
&               endif
                i := 0;
                IF  m90prot
                THEN
                    m94write_prot (ln.text, ln.length, i);
                (*ENDIF*) 
                IF  i <> 0
                THEN
                    disk_full;
                (*ENDIF*) 
                IF  m90term
                THEN
                    BEGIN
                    WITH ft DO
                        BEGIN
                        field_att := cin_ls_enhanced;
                        fieldmode := [  ] ;
                        END;
                    (*ENDWITH*) 
&                   ifndef BATCH
                    m93put (ln.text, ft);
&                   endif
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90maxbuflength;
 
BEGIN
&ifndef BATCH
IF  m90term OR m90prot
    (*@^*)
THEN
    BEGIN
    m9330put_screen_30 ('Maximale Laenge fuer M90BUF:  ');
    m90readint (m90.maxlength)
    END
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90setmaxbuflength (
            max_len : integer);
 
BEGIN
IF  (max_len > 0) AND (max_len <= mxsp_any_packed_char)
THEN
    m90.maxlength := max_len
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90maxprotlines;
 
VAR
      int_line : tsp_dataline;
      ok       : boolean;
 
BEGIN
&ifndef BATCH
IF  m90term OR m90prot
THEN
    BEGIN
    m9330put_screen_30 ('Close/Open Prot nach x Zeilen ');
    m9330put_screen_30 ('Leereingabe = csp_maxint4     ');
    WITH int_line DO
        BEGIN
        m93getscreen (text);
        pos := 0;
        WHILE (pos+1 < mxsp_line) AND (text [ pos+1 ] = ' ') DO
            pos := succ (pos);
        (*ENDWHILE*) 
        length := mxsp_line;
        WHILE (length > 1) AND (text [ length ] = ' ') DO
            length := pred (length);
        (*ENDWHILE*) 
        IF  length >= pos
        THEN
            m90getint (int_line, m90.maxprotlines, ok)
        ELSE
            ok := false;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    IF  NOT ok
    THEN
        m90.maxprotlines := csp_maxint4;
    (*ENDIF*) 
    END
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90minbuf (
            min_wanted : boolean);
 
BEGIN
m90.minbuf := min_wanted
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90switch;
 
VAR
      hold : boolean;
 
BEGIN
&ifndef BATCH
m90term := param ('Ausg. aufs Terminal?');
IF  m90term
THEN
    BEGIN
    hold := param ('Hold screen?        ');
    m93hold (hold);
    END;
(*ENDIF*) 
m90prot := param ('Ausgabe Protfile ?  ');
IF  m90term OR m90prot
THEN
    set_trace_test (false)
&         endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90limited_switch;
 
VAR
      i : integer;
      ln : tsp_line;
 
BEGIN
&ifndef BATCH
m90switch;
m90.test_or_trace := false;
m9320put_screen_20 ('Start-tracetext:    ');
m93getscreen (ln);
FOR i:= 1 TO 16 DO
    m90.on_text  [i]  := ln  [i] ;
(*ENDFOR*) 
m9330put_screen_30 ('Start beim wievielten Text?   ');
m90readint (m90.on_count);
m9330put_screen_30 ('Stop-tracetext oder "STOP":   ');
m93getscreen (ln);
FOR i:=1 TO 16 DO
    m90.off_text  [i]  := ln  [i]
&         endif
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      set_trace_test (
            default : boolean);
 
CONST
      n_tr = 'Schichten fuer trace';
      n_te = 'Schichten fuer test ';
      n_sstr = '                    ';
      n_sste = '                    ';
 
VAR
      s20 : tsp_c20;
 
BEGIN
m90.on_text  := '                ';
m90.off_text := '                ';
m90.on_count := 0;
IF  default
THEN
    s20 := n_sstr
ELSE
    BEGIN
    put_prot_str20 (n_tr);
&   ifndef BATCH
    getzeil (true, s20);
&   else
    s20 := n_sstr;
&   endif
    put_prot_str20 (s20)
    END;
(*ENDIF*) 
m90settrace (s20);
m90.last_schicht := 'T';
IF  default
THEN
    s20 := n_sste
ELSE
    BEGIN
    put_prot_str20 (n_te);
&   ifndef BATCH
    getzeil (false, s20);
&   else
    s20 := n_sstr;
&   endif
    put_prot_str20 (s20)
    END;
(*ENDIF*) 
set_test (s20);
set_bool_test_or_trace;
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90settrace (
            s20 : tsp_c20);
 
BEGIN
m90.trace_dg := index_schicht('DG', s20);
m90.trace_fc := index_schicht('FC', s20);
m90.trace_in := index_schicht('IN', s20);
m90.trace_lo := index_schicht('LO', s20);
m90.trace_na := index_schicht('NA', s20);
m90.trace_wb := index_schicht('WB', s20);
m90.trace_ye := index_schicht('YE', s20);
m90.trace_pc := index_schicht('PC', s20);
m90.trace_qu := index_schicht('QU', s20);
m90.trace_cp := index_schicht('CP', s20)
END;
 
(*------------------------------*) 
 
PROCEDURE
      set_test (
            VAR s20 : tsp_c20);
 
BEGIN
m90.test_schicht := [ ] ;
IF  index_schicht ('FC', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [fc] ;
(*ENDIF*) 
IF  index_schicht ('DG', s20)
THEN
    m90.test_schicht := m90.test_schicht + [ vdg, d0..d9] ;
(*ENDIF*) 
IF  index_schicht ('IN', s20)
THEN
    m90.test_schicht := m90.test_schicht + [ vin] ;
(*ENDIF*) 
IF  index_schicht ('LO', s20)
THEN
    m90.test_schicht := m90.test_schicht + [ vlo] ;
(*ENDIF*) 
IF  index_schicht ('WB', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [wb] ;
(*ENDIF*) 
IF  index_schicht ('YE', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [ye] ;
(*ENDIF*) 
IF  index_schicht ('PC', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [pc] ;
(*ENDIF*) 
IF  index_schicht ('QU', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [qu] ;
(*ENDIF*) 
IF  index_schicht ('D0', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d0] ;
(*ENDIF*) 
IF  index_schicht ('D1', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d1] ;
(*ENDIF*) 
IF  index_schicht ('D2', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d2] ;
(*ENDIF*) 
IF  index_schicht ('D3', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d3] ;
(*ENDIF*) 
IF  index_schicht ('D4', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d4] ;
(*ENDIF*) 
IF  index_schicht ('D5', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d5] ;
(*ENDIF*) 
IF  index_schicht ('D6', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d6] ;
(*ENDIF*) 
IF  index_schicht ('D7', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d7] ;
(*ENDIF*) 
IF  index_schicht ('D8', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d8] ;
(*ENDIF*) 
IF  index_schicht ('D9', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [d9] ;
(*ENDIF*) 
IF  index_schicht ('CP', s20)
THEN
    m90.test_schicht := m90.test_schicht +  [cp] ;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      set_bool_test_or_trace;
 
BEGIN
m90.test_or_trace := (m90.test_schicht <> [  ] );
IF  NOT m90.test_or_trace
THEN
    BEGIN
    IF     m90.trace_fc
        OR m90.trace_dg
        OR m90.trace_in
        OR m90.trace_lo
        OR m90.trace_na
        OR m90.trace_wb
        OR m90.trace_ye
        OR m90.trace_pc
        OR m90.trace_qu
        OR m90.trace_cp
    THEN
        m90.test_or_trace := true
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
&ifndef BATCH
(*------------------------------*) 
 
FUNCTION
      param (
            str : tsp_c20) : boolean;
 
VAR
      ln : tsp_line;
      f_ok : boolean;
      i : integer;
      question : tsp_c30;
 
BEGIN
f_ok := false;
question := '                     : j/n    ';
FOR i:= 1 TO 20 DO
    question  [i]  := str  [i] ;
(*ENDFOR*) 
m9330put_screen_30 (question);
m93getscreen (ln);
IF  (ln  [1]  = 'j') OR (ln  [1]  = 'J')
THEN
    f_ok := true;
(*ENDIF*) 
param := f_ok
END;
 
&endif
&ifndef BATCH
(*------------------------------*) 
 
PROCEDURE
      getzeil (
            trace_wanted : boolean;
            VAR txt      : tsp_c20);
 
VAR
      i : integer;
      msg : PACKED ARRAY [ 1..60 ] OF char;
      ln : tsp_line;
 
BEGIN
IF  trace_wanted
THEN
    msg:='Schichten fuer trace:                                       '
ELSE
    msg:='Schichten fuer test:                                        ';
(*ENDIF*) 
FOR i:=1 TO 60 DO
    ln  [i]  := msg  [i] ;
(*ENDFOR*) 
FOR i:=61 TO mxsp_line DO
    ln  [i]  := ' ';
(*ENDFOR*) 
m93putscreen (ln);
m93getscreen (ln);
FOR i:= 1 TO 20 DO
    IF  ln [i]  IN m90lower_letters
    THEN
        txt [i]  := chr(ord(ln [i] ) + ord ('A') - ord ('a'))
    ELSE
        txt  [i]  := ln  [i] ;
    (*ENDIF*) 
(*ENDFOR*) 
END;
 
&endif
(*------------------------------*) 
 
FUNCTION
      index_schicht (
            ss : tsp_c2; s20 : tsp_c20) : boolean;
 
VAR
      f_ok : boolean;
      i    : integer;
 
BEGIN
f_ok := false;
i := 1;
REPEAT
    IF  ((ss [1]  = s20 [i] ) AND (ss [2]  = s20 [i+1] ))
    THEN
        f_ok := true;
    (*ENDIF*) 
    i := i + 1;
UNTIL
    ((f_ok) OR (i > 19));
(*ENDREPEAT*) 
index_schicht := f_ok
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_prot_str20 (
            str20 : tsp_c20);
 
VAR
      ln : tsp_line;
      i  : integer;
      ret_t15term : boolean;
 
BEGIN
ln := m90blankline.text;
FOR i := 1 TO 20 DO
    ln [i]  := str20 [i] ;
(*ENDFOR*) 
ret_t15term := m90term;
m90term := false;
m90write_line (ln);
m90term := ret_t15term
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90write_line (
            VAR ln : tsp_line);
 
VAR
      l : integer;
      err: integer;
 
BEGIN
IF  m90.protlinecnt = m90.maxprotlines
THEN
    BEGIN
    m94close_prot;
    m90.first_file := NOT m90.first_file;
    m94switch_prot (m90.first_file, err);
    m90.protlinecnt := 0;
    END
ELSE
    m90.protlinecnt := m90.protlinecnt + 1;
(*ENDIF*) 
l := mxsp_line;
WHILE ((ln [l]  = bsp_c1) AND (l >= 2)) DO
    l := l - 1;
(*ENDWHILE*) 
IF  m90prot
THEN
    BEGIN
    m94write_prot (ln, l, err);
    IF  err <> 0
    THEN
        BEGIN
&       ifndef BATCH
        m9330put_screen_30 ('*** Fehler beim protokollwrite');
&       endif
        disk_full;
        END;
    (*ENDIF*) 
    END;
&ifndef BATCH
(*ENDIF*) 
IF  m90term
THEN
    m93putscreen (ln);
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90initio;
 
VAR
      i : tsp_linepositions;
 
BEGIN
init_ascii_table;
m90digiset :=  [ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' ] ;
m90upper_letters := [ 'A','B','C','D','E','F','G','H','I','J','K','L',
      'M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'] ;
m90lower_letters := [ 'a','b','c','d','e','f','g','h','i','j','k','l',
      'm','n','o','p','q','r','s','t','u','v','w','x','y','z'] ;
(* ===================================================== *)
(* Sonderzeichen, die in EBCDIC und ASCII vorhanden sind *)
(* ===================================================== *)
m90specsigns    := [ '.', '<', '(', '+', '&',
      '!', '$', '*', ')', ';', '-', '/',
      ',', '%', '_', '>', '?',
      ':', '#', '@', '''','=', '"'] ;
WITH m90blankline DO
    BEGIN
    FOR i := 1 TO mxsp_line DO
        text   [i]   := ' ';
    (*ENDFOR*) 
    pos := 0;
    length := 1
    END;
(*ENDWITH*) 
IF  ord(bsp_c1) = 32
THEN
    m90tab:= chr(9)
ELSE
    m90tab:= chr(5);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      m90textlength (
            text: tsp_line): tsp_linepositions;
 
VAR
      i: tsp_linepositions;
 
BEGIN
i := mxsp_line;
WHILE ((text  [i]  = ' ') AND (i > 1)) DO
    i := pred (i);
(*ENDWHILE*) 
IF  (i = 1) AND (text   [i]  = ' ')
THEN
    i := 0;
(*ENDIF*) 
m90textlength := i
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90readterm (
            VAR lineinfo : tsp_dataline);
 
VAR
      dummy : boolean;
 
BEGIN
read_terminal (false, lineinfo, dummy)
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90string_readterm (
            VAR lineinfo  : tsp_dataline;
            VAR last_line : boolean);
 
BEGIN
read_terminal (true, lineinfo, last_line)
END;
 
(*------------------------------*) 
 
PROCEDURE
      read_terminal (
            read_string   : boolean; VAR lineinfo : tsp_dataline;
            VAR last_line : boolean);
 
VAR
      i : tsp_linepositions;
      ap_string : boolean;
 
BEGIN
(* eingabe ueber die konsole *)
lineinfo := m90blankline;
ap_string := FALSE;
WITH lineinfo DO
    BEGIN
&   ifndef BATCH
    IF  read_string
    THEN
        m93string_get_screen (text, last_line)
    ELSE
        m93getscreen (text);
    (*ENDIF*) 
&   endif
    length := mxsp_line;
    WHILE (length > 1) AND (text [length ] = ' ') DO
        length := pred (length);
    (*ENDWHILE*) 
    IF  (length = 1) AND (text [1]  = ' ')
    THEN
        length := 0;
    (*ENDIF*) 
    FOR i := 1 TO length DO
        BEGIN
        IF  text  [i]  = ''''
        THEN
            ap_string := NOT ap_string;
        (*ENDIF*) 
        IF  ('a' <= text  [i] ) AND (text  [i]  <= 'z') AND (NOT ap_string)
        THEN
            text  [i]  := chr(ord(text  [i] ) + ord('A') - ord('a'))
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90getchar (
            VAR lineinfo  : tsp_dataline;
            VAR character : char;
            VAR ok        : boolean);
 
VAR
      found: boolean;
      currpos : integer;
 
BEGIN
ok := true;
found:= false;
character := ' ';
WITH lineinfo DO
    BEGIN
    IF  pos > 0
    THEN
        IF  pos > length
        THEN
            BEGIN
            ok := false;
&           ifdef TRACE
            m90str30 (xx, 'getchar : input already passed')
&                 endif
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  ok
    THEN
        BEGIN
        currpos := pos;
        REPEAT
            currpos := succ (currpos);
            IF  text  [ currpos ]  <> ' '
            THEN
                IF  currpos > length
                THEN
                    ok := false
                ELSE
                    found := true
                (*ENDIF*) 
            (*ENDIF*) 
        UNTIL
            (found OR NOT ok);
        (*ENDREPEAT*) 
        IF  NOT ok
        THEN
&           ifdef TRACE
            m90str30 (xx, 'getchar : no char found       ')
&                 endif
        ELSE
            BEGIN
            character := text  [ currpos ] ;
            pos := currpos
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90putchar (
            VAR lineinfo: tsp_dataline; character: char;
            VAR ok      : boolean);
 
BEGIN
ok := true;
WITH lineinfo DO
    BEGIN
    IF  pos = mxsp_line
    THEN
        BEGIN
        ok := false;
&       ifdef TRACE
        m90str30 (xx, 'putchar : linelength exceeded ')
&             endif
        END
    ELSE
        BEGIN
        pos := succ (pos);
        text  [ pos ]  := character
        END;
    (*ENDIF*) 
    IF  pos > length
    THEN
        length := pos
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90getstring (
            VAR lineinfo: tsp_dataline; VAR stringinfo: tsp_string;
            VAR ok      : boolean);
 
VAR
      currpos, i : tsp_linepositions;
      found, end_of_string : boolean;
      character : char;
 
BEGIN
ok := true;
found := false;
end_of_string := false;
stringinfo.length := 0;
WITH lineinfo DO
    BEGIN
    IF  pos > 0
    THEN
        IF  pos > length
        THEN
            BEGIN
            ok := false;
&           ifdef TRACE
            m90str30 (xx, 'getstring:input already passed')
&                 endif
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
IF  ok
THEN
    WITH stringinfo DO
        BEGIN
        currpos := lineinfo.pos;
        REPEAT
            currpos := succ (currpos);
            character := lineinfo.text  [ currpos ] ;
            IF  (character = ' ') OR (character = '!')
            THEN
                end_of_string := found
            ELSE
                BEGIN
                found := true;
                length := succ (length);
                text  [ length ]  := character
                END;
            (*ENDIF*) 
            IF  currpos >= lineinfo.length
            THEN
                IF  found
                THEN
                    end_of_string := true
                ELSE
                    ok := false
                (*ENDIF*) 
            (*ENDIF*) 
        UNTIL
            end_of_string OR NOT ok;
        (*ENDREPEAT*) 
        IF  ok
        THEN
            lineinfo.pos := pred (currpos)
        (*ENDIF*) 
        END
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90putstring (
            VAR lineinfo   : tsp_dataline;
            VAR stringinfo : tsp_string;
            VAR ok         : boolean);
 
VAR
      i : tsp_linepositions;
 
BEGIN
ok := true;
IF  stringinfo.length = 0
THEN
    BEGIN
    ok := false;
&   ifdef TRACE
    m90str30 (xx, 'putstring:stringlength is zero')
&         endif
    END
ELSE
    WITH lineinfo DO
        BEGIN
        IF  (pos + stringinfo.length)>mxsp_line
        THEN
            BEGIN
            ok := false;
&           ifdef TRACE
            m90str30 (xx, 'putstring :linelength exceeded')
&                 endif
            END
        ELSE
            FOR i:=1 TO stringinfo.length DO
                BEGIN
                pos := succ (pos);
                text [ pos ]  := stringinfo.text  [i]
                END;
            (*ENDFOR*) 
        (*ENDIF*) 
        IF  pos > length
        THEN
            length := pos
        (*ENDIF*) 
        END
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90copystring (
            VAR stringinfo: tsp_string; text: tsp_line;
            length        : tsp_linepositions);
 
BEGIN
stringinfo.text := text;
stringinfo.length := length
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90setpos (
            VAR lineinfo: tsp_dataline;
            position    : tsp_linepositions);
 
BEGIN
WITH lineinfo DO
    BEGIN
    pos := position;
    IF  pos > length
    THEN
        length := pos
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90skippos (
            VAR lineinfo: tsp_dataline; positions: tsp_linepositions;
            VAR ok      : boolean);
 
BEGIN
ok := true;
WITH lineinfo DO
    IF  (pos + positions) > mxsp_line
    THEN
        BEGIN
        ok := false;
&       ifdef TRACE
        m90str30 (xx, 'skippos : linelength exceeded ')
&             endif
        END
    ELSE
        BEGIN
        pos := pos + positions;
        IF  pos > length
        THEN
            length := pos
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90lineio (
            VAR prompt : tsp_line;
            VAR answer : tsp_line);
 
BEGIN
&ifndef BATCH
m93putscreen (prompt);
m93getscreen (answer);
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90getint (
            VAR lineinfo: tsp_dataline; VAR integervalue: integer;
            VAR ok      : boolean);
 
CONST
      maxintl = 5 ;
 
VAR
      i,currpos : integer;
      intlength : tsp_linepositions;
      tin_vvalue     : boolean;
      found,neg : boolean;
      c         : char;
      fac       : integer;
 
BEGIN
ok := true;
neg := false;
tin_vvalue := false;
integervalue := 0;
found := false;
intlength := 0;
WITH lineinfo DO
    BEGIN
    IF  pos > 0
    THEN
        IF  pos > length
        THEN
            BEGIN
            ok := false;
&           ifdef TRACE
            m90str30 (xx, 'getint : input already passed ')
&                 endif
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  ok
    THEN
        BEGIN
        currpos := pos;
        REPEAT
            currpos := succ (currpos);
            c := text  [ currpos ] ;
            IF  c = ' '
            THEN
                BEGIN
                IF  tin_vvalue
                THEN
                    found := true
                (*ENDIF*) 
                END
            ELSE
                IF  c = '+'
                THEN
                    BEGIN
                    IF  tin_vvalue
                    THEN
                        ok := false
                    (*ENDIF*) 
                    END
                ELSE
                    IF  c = '-'
                    THEN
                        BEGIN
                        IF  tin_vvalue
                        THEN
                            ok := false
                        ELSE
                            neg:= true
                        (*ENDIF*) 
                        END
                    ELSE
                        IF  currpos > length
                        THEN
                            BEGIN
                            IF  tin_vvalue
                            THEN
                                found:=true
                            ELSE
                                ok := false
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  c in m90digiset
                            THEN
                                BEGIN
                                tin_vvalue := true;
                                intlength := succ (intlength);
                                IF  intlength > maxintl
                                THEN
                                    ok := false
                                (*ENDIF*) 
                                END
                            ELSE
                                ok := false
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        UNTIL
            (found OR NOT ok);
        (*ENDREPEAT*) 
        IF  NOT ok
        THEN
&           ifdef TRACE
            m90str30 (xx, 'getint : invalid input        ')
&                 endif
        ELSE
            BEGIN
            pos := pred (currpos);
            integervalue := 0;
            fac := 1;
            FOR i:= intlength DOWNTO 1 DO
                BEGIN
                currpos := pred (currpos);
                integervalue := integervalue + fac * (ord(text [ currpos ] )
                      - ord('0'));
                IF  i > 1
                THEN
                    fac := fac * 10
                (*ENDIF*) 
                END;
            (*ENDFOR*) 
            IF  neg
            THEN
                integervalue:=integervalue * (-1)
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90putprompt
            (
            VAR dl      : tsp_dataline;
            nam     : tsp_sname;
            VAR ok      : boolean );
 
VAR
      i : integer;
 
BEGIN
FOR i := 1 TO max_n DO
    dl.text [i]  := nam [i] ;
(*ENDFOR*) 
dl.text [max_n+2 ] := ':';
dl.length := max_n + 5;
dl.pos    := max_n + 4;
ok := true;
END; (* m90putprompt *)
 
(*------------------------------*) 
 
PROCEDURE
      m90put2int
            (
            VAR lineinfo: tsp_dataline; integervalue: tsp_int2;
            fieldlength : tsp_fieldrange;
            VAR ok      : boolean);
 
CONST
      minus  = '-';
      intlng = 6  ;
 
VAR
      field  : ARRAY [ 1..intlng ]  OF char;
      spos,i : integer;
      currlng: integer;
      rem    : integer;
 
BEGIN
ok := true;
currlng := 0;
IF  (fieldlength + lineinfo.pos) > mxsp_line
THEN
    BEGIN
    ok := false;
&   ifdef TRACE
    m90str30 (xx, 'put2int: linelength exceeded  ')
&         endif
    END
ELSE
    BEGIN
    FOR i:= 1 TO intlng DO
        field   [i]   := ' ';
    (*ENDFOR*) 
    rem := abs(integervalue);
    REPEAT
        currlng := succ (currlng);
        field [ currlng ]  := chr(rem MOD 10 + ord('0'));
        rem := rem DIV 10
    UNTIL
        rem = 0;
    (*ENDREPEAT*) 
    IF  integervalue < 0
    THEN
        BEGIN
        currlng := succ (currlng);
        field [ currlng ]  := minus
        END;
    (*ENDIF*) 
    WITH lineinfo DO
        BEGIN
        spos := pos + (fieldlength - currlng);
        FOR i:= pos + 1 TO spos DO
            text   [i]   := ' ';
        (*ENDFOR*) 
        FOR i := currlng DOWNTO 1 DO
            BEGIN
            spos := succ (spos);
            text [ spos ]  := field  [i]
            END;
        (*ENDFOR*) 
        pos := pos + fieldlength;
        IF  pos > length
        THEN
            length := pos
        (*ENDIF*) 
        END
    (*ENDWITH*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90putint (
            VAR lineinfo: tsp_dataline;
            integervalue: integer;
            fieldlength : tsp_fieldrange;
            VAR ok      : boolean);
 
CONST
      minus  = '-';
      intlng = 11 ;
 
VAR
      field  : ARRAY [ 1..intlng ]  OF char;
      spos,i : integer;
      currlng: integer;
      rem    : integer;
 
BEGIN
ok := true;
currlng := 0;
IF  (fieldlength + lineinfo.pos) > mxsp_line
THEN
    BEGIN
    ok := false;
&   ifdef TRACE
    m90str30 (xx, 'putint : linelength exceeded  ')
&         endif
    END
ELSE
    BEGIN
    FOR i:= 1 TO intlng DO
        field   [i]   := ' ';
    (*ENDFOR*) 
    rem := abs(integervalue);
    REPEAT
        currlng := succ (currlng);
        field [ currlng ]  := chr(rem MOD 10 + ord('0'));
        rem := rem DIV 10
    UNTIL
        rem = 0;
    (*ENDREPEAT*) 
    IF  integervalue < 0
    THEN
        BEGIN
        currlng := succ (currlng);
        field [ currlng ]  := minus
        END;
    (*ENDIF*) 
    WITH lineinfo DO
        BEGIN
        spos := pos + (fieldlength - currlng);
        FOR i:= pos + 1 TO spos DO
            text   [i]   := ' ';
        (*ENDFOR*) 
        FOR i := currlng DOWNTO 1 DO
            BEGIN
            spos := succ (spos);
            text [ spos ]  := field  [i]
            END;
        (*ENDFOR*) 
        pos := pos + fieldlength;
        IF  pos > length
        THEN
            length := pos
        (*ENDIF*) 
        END
    (*ENDWITH*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90science_real (
            x       : real;
            m       : integer;
            VAR mant    : real;
            VAR expo    : integer );
 
BEGIN
IF  ( x < 1.0 ) AND ( x >= 0.1 )
THEN
    BEGIN
    mant := x;
    expo := m;
    END
ELSE
    BEGIN
    IF  x < 0.1
    THEN
        BEGIN
        m90science_real ( x * 10.0, m - 1, mant, expo );
        END
    ELSE
        BEGIN
        m90science_real ( x / 10.0, m + 1, mant, expo );
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END; (* m90science_real *)
 
(*------------------------------*) 
 
PROCEDURE
      m90putreal (
            VAR lineinfo: tsp_dataline;
            realvalue   : real;
            fieldlength : tsp_fieldrange;
            VAR ok      : boolean);
 
CONST
      minus  = '-';
 
VAR
      field    : tsp_dataline;
      i        : integer;
      rem      : real;
      absvalue : real;
      mant     : real;
      expo     : integer;
      k        : integer;
 
BEGIN
ok := true;
IF  (fieldlength + lineinfo.pos) > mxsp_line
THEN
    BEGIN
    ok := false;
&   ifdef TRACE
    m90str30 (xx, 'putint : linelength exceeded  ')
&         endif
    END
ELSE
    BEGIN
    field := m90blankline;
    mant := 0;
    expo := 0;
    absvalue := abs(realvalue);
    m90science_real ( absvalue, 0, mant, expo );
    IF  realvalue < 0.0
    THEN
        BEGIN
        m90putchar ( lineinfo, minus, ok );
        END;
    (*ENDIF*) 
    IF  absvalue < 0.1
    THEN
        BEGIN
        m90putchar ( lineinfo, '0', ok );
        END;
    (*ENDIF*) 
    i := 0;
    rem := mant;
    REPEAT
        IF  i = expo
        THEN
            BEGIN
            m90putchar ( lineinfo, '.', ok );
            END;
        (*ENDIF*) 
        k := trunc ( rem * 10.0 );
        m90putchar ( lineinfo, chr (k + ord ('0')) , ok );
        rem := ( rem * 10 - k );
        i := succ (i);
    UNTIL
        (*
              ( rem <= 0.01 ) OR
              *)
        ( lineinfo.length >= mxsp_line ) OR
        ( i >= fieldlength )
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
(* ENDIF *)
END; (* m90putreal *)
 
(*------------------------------*) 
 
PROCEDURE
      m90put4int (
            VAR lineinfo: tsp_dataline; integervalue: tsp_int4;
            fieldlength : tsp_fieldrange;
            VAR ok      : boolean);
 
CONST
      minus  = '-';
      intlng = 11 ;
 
VAR
      field  : ARRAY [ 1..intlng ]  OF char;
      spos,i : integer;
      currlng: integer;
      rem    : tsp_int4;
 
BEGIN
ok := true;
currlng := 0;
IF  (fieldlength + lineinfo.pos) > mxsp_line
THEN
    BEGIN
    ok := false;
&   ifdef TRACE
    m90str30 (xx, 'put4int: linelength exceeded  ')
&         endif
    END
ELSE
    BEGIN
    FOR i:= 1 TO intlng DO
        field   [i]   := ' ';
    (*ENDFOR*) 
    rem := abs(integervalue);
    REPEAT
        currlng := succ (currlng);
        field [ currlng ]  := chr(rem MOD 10 + ord('0'));
        rem := rem DIV 10
    UNTIL
        rem <= 0;
    (*ENDREPEAT*) 
    IF  integervalue < 0
    THEN
        BEGIN
        currlng := succ (currlng);
        field [ currlng ]  := minus
        END;
    (*ENDIF*) 
    WITH lineinfo DO
        BEGIN
        spos := pos + (fieldlength - currlng);
        FOR i:= pos + 1 TO spos DO
            text   [i]   := ' ';
        (*ENDFOR*) 
        FOR i := currlng DOWNTO 1 DO
            BEGIN
            spos := succ (spos);
            text [ spos ]  := field  [i]
            END;
        (*ENDFOR*) 
        pos := pos + fieldlength;
        IF  pos > length
        THEN
            length := pos
        (*ENDIF*) 
        END
    (*ENDWITH*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90dectohex (
            dec           : integer;
            VAR stringinfo: tsp_string);
 
VAR
      i,first,sec: integer;
      temp : integer;
 
BEGIN
first := dec DIV 16;
IF  first = 0
THEN
    sec := dec
ELSE
    sec := dec - (first * 16);
(*ENDIF*) 
temp := first;
FOR i:=2 TO 3 DO
    BEGIN
    IF  temp > 9
    THEN
        stringinfo.text  [i]   := chr (ord('A') - 10 + temp)
    ELSE
        stringinfo.text  [i]   := chr (ord('0') + temp);
    (*ENDIF*) 
    temp := sec
    END;
(*ENDFOR*) 
stringinfo.text  [1]   := ' ';
stringinfo.length := 3
END;
 
(*------------------------------*) 
 
FUNCTION
      m90istest_on (
            layer : tsp_layer ) : boolean;
 
BEGIN
m90istest_on := (layer in m90.test_schicht);
IF  layer = xx
THEN
    m90istest_on := (m90.test_schicht <> [ ] );
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90settest (
            layer : tsp_layer; on : boolean );
 
BEGIN
IF  on
THEN
    m90.test_schicht := m90.test_schicht + [ layer ]
ELSE
    m90.test_schicht := m90.test_schicht - [ layer] ;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90userid (
            layer : tsp_layer;
            nam   : tsp_knl_identifier);
 
VAR
      ln : tsp_line;
      i  : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    ln := m90blankline.text;
    FOR i := 1 TO sizeof (nam) DO
        IF  nam [i] = csp_unicode_mark
        THEN
            ln [i] := '.'
        ELSE
            ln [i]  := nam [i] ;
        (*ENDIF*) 
    (*ENDFOR*) 
    m90write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90bool (
            layer : tsp_layer; nam : tsp_sname;
            bool  : boolean );
 
VAR
      dl : tsp_dataline;
      i  : integer;
      boolstr : tsp_sname;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    FOR i := 1 TO max_n DO
        dl.text [i]  := nam [i] ;
    (*ENDFOR*) 
    dl.text [max_n+2 ] := ':';
    IF  bool
    THEN
        boolstr := 'TRUE        '
    ELSE
        boolstr := 'FALSE       ';
    (*ENDIF*) 
    FOR  i := 1  TO  5  DO
        dl.text [i+max_n+3 ] := boolstr [i] ;
    (*ENDFOR*) 
    dl.length := 20;
    dl.pos    := 20;
    m90write_line (dl.text)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90setswitch_parms (
            protokoll       : boolean;
            trace_schichten : tsp_c20;
            test_schichten  : tsp_c20 );
 
CONST
      n_tr = 'Schichten fuer trace';
      n_te = 'Schichten fuer test ';
 
BEGIN
m90term := false;
m90prot := protokoll;
m90.on_text  := '                ';
m90.off_text := '                ';
m90.on_count := 0;
put_prot_str20 (n_tr);
put_prot_str20 (trace_schichten);
m90settrace (trace_schichten);
m90.last_schicht := 'T';
put_prot_str20 (n_te);
put_prot_str20 (test_schichten);
set_test (test_schichten);
set_bool_test_or_trace;
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90auftrag_header (
            layer       : tsp_layer;
            VAR  packet : tsp_packet );
 
VAR
      dl    : tsp_dataline;
      i     : integer;
      name  : tsp_sname;
      str60 : tsp_c60;
      ok    : boolean;
 
BEGIN
WITH packet  DO
    BEGIN
    dl := m90blankline;
    str60 :=
          'mess_code    :                    mess_type      :          ';
    FOR i := 1 TO 60  DO
        dl.text [i]  := str60 [i] ;
    (*ENDFOR*) 
    dl.text [24]  := 'X';
    dl.text [25]  := '''';
    dl.text [26]  := chr ((ord (mess_code [1] ) DIV 255) + ord('0'));
    dl.text [27]  := chr ((ord (mess_code [1] ) MOD 255) + ord('0'));
    dl.text [28]  := chr ((ord (mess_code [2] ) DIV 255) + ord('0'));
    dl.text [29]  := chr ((ord (mess_code [2] ) MOD 255) + ord('0'));
    dl.text [30]  := '''';
    CASE mess_type OF
        csp_m_adbs            :
            name := 'm_adbs      ';
        csp_m_adbsparse       :
            name := 'm_adbsparse ';
        csp_m_adbsexecute     :
            name := 'm_adbsexecut';
        csp_m_adbsinfo        :
            name := 'm_adbsinfo  ';
        csp_m_autility        :
            name := 'm_autility  ';
        csp_m_aincopy         :
            name := 'm_aincopy   ';
        csp_m_aendincopy      :
            name := 'm_aendincopy';
        csp_m_aoutcopy        :
            name := 'm_aoutcopy  ';
        csp_m_aendoutcopy     :
            name := 'm_aendoutcop';
        csp_m_ahello          :
            name := 'm_ahello    ';
        csp_m_afile           :
            name := 'm_afile     ';
        csp_m_adbssyntax      :
            name := 'm_adbssyntax';
        csp_m_adbscommit      :
            name := 'm_adbscommit';
        csp_m_adbsinfocommit  :
            name := 'm_adbsinfoco';
        csp_m_adbsload       :
            name := 'm_adbsload  ';
        csp_m_adbscatalog :
            name := 'm_adbscatalo';
        csp_m_adbsunload :
            name := 'm_adbsunload';
        csp_m_adbsgetparse :
            name := 'm_adbsgetpar';
        csp_m_adbsgetexecute :
            name := 'm_adbsgetexe';
        csp_m_adbsansi :
            name := 'm_adbsansi  ';
        csp_m_adbsdb2 :
            name := 'm_adbsdb2   ';
        csp_m_adbsoracle :
            name := 'm_adbsoracle';
        csp_m_adbsadabas :
            name := 'm_adbsadabas';
        csp_m_aparseansi :
            name := 'm_aparseansi';
        csp_m_aparsedb2 :
            name := 'm_aparsedb2 ';
        csp_m_aparseoracle :
            name := 'm_aparseorac';
        csp_m_aparseadabas :
            name := 'm_aparseadab';
        csp_m_aputval :
            name := 'm_aputval   ';
        csp_m_agetval :
            name := 'm_agetval   ';
        OTHERWISE:
            name := 'm_type unkno';
        END;
    (*ENDCASE*) 
    FOR i := 1  TO mxsp_sname  DO
        dl.text [52+i ] := name [i] ;
    (*ENDFOR*) 
    m90line (layer, dl.text);
    dl := m90blankline;
    str60 :=
          'senderid.spid:                    senderid.slocnr:          ';
    FOR i := 1 TO 60  DO
        dl.text [i]  := str60 [i] ;
    (*ENDFOR*) 
    dl.length := 22;
    dl.pos := 23;
    (*m90put4int (dl, senderid.spid, 6, ok);*)
    dl.length := 52;
    dl.pos := 53;
    (*m90put4int (dl, senderid.slocnr, 6, ok);*)
    m90line (layer, dl.text);
    dl := m90blankline;
    str60 :=
          'part1_length :                    part2_length   :          ';
    FOR i := 1 TO 60  DO
        dl.text [i]  := str60 [i] ;
    (*ENDFOR*) 
    dl.length := 22;
    dl.pos := 23;
    m90put2int (dl, part1_length, 6, ok);
    dl.length := 52;
    dl.pos := 53;
    m90put2int (dl, part2_length, 6, ok);
    m90line (layer, dl.text);
    dl := m90blankline;
    str60 :=
          'return_code  :                    error_code     :          ';
    FOR i := 1 TO 60  DO
        dl.text [i]  := str60 [i] ;
    (*ENDFOR*) 
    dl.length := 22;
    dl.pos := 23;
    m90put2int (dl, return_code, 6, ok);
    dl.length := 52;
    dl.pos := 53;
    m90put2int (dl, error_code, 6, ok);
    m90line (layer, dl.text);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      init_ascii_table;
 
VAR
      i : integer;
 
BEGIN
IF  ord(' ') = 32 (* schon ASCII *)
THEN
    FOR i := 1 TO 256 DO
        m90table [ i ] := chr(i-1)
    (*ENDFOR*) 
ELSE
    BEGIN
    (* asciiebcdic  => codetabellen [x] , x = ord(ascii) *)
    m90table [1]   := chr(0); (* nul *)
    m90table [2]   := chr(  1); (* soh *)
    m90table [3]   := chr(  2); (* stx *)
    m90table [4]   := chr(  3); (* etx *)
    m90table [5]   := chr( 55); (* eot *)
    m90table [6]   := chr( 45); (* enq *)
    m90table [7]   := chr( 46); (* ack *)
    m90table [8]   := chr( 47); (* bel *)
    m90table [9]   := chr( 22); (* bs *)
    m90table [10]  := chr(  5); (* ht *)
    m90table [11]  := chr( 37); (* lf *)
    m90table [12]  := chr( 11); (* vt *)
    m90table [13]  := chr( 12); (* ff *)
    m90table [14]  := chr( 13); (* cr *)
    m90table [15]  := chr( 14); (* so *)
    m90table [16]  := chr( 15); (* si *)
    m90table [17]  := chr( 16); (* dle *)
    m90table [18]  := chr( 17); (* dc1 *)
    m90table [19]  := chr( 18); (* dc2 *)
    m90table [20]  := chr( 19); (* dc3 *)
    m90table [21]  := chr( 60); (* dc4 *)
    m90table [22]  := chr( 61); (* nak *)
    m90table [23]  := chr( 50); (* syn *)
    m90table [24]  := chr( 38); (* etb *)
    m90table [25]  := chr( 24); (* can *)
    m90table [26]  := chr( 25); (* em *)
    m90table [27]  := chr( 63); (* sub *)
    m90table [28]  := chr( 39); (* esc *)
    m90table [29]  := chr( 28); (* fs *)
    m90table [30]  := chr( 29); (* gs *)
    m90table [31]  := chr( 30); (* rs *)
    m90table [32]  := chr( 31); (* us *)
    m90table [33]  := chr( 64); (* sp *)
    m90table [34]  := chr( 90); (* ! *)
    m90table [35]  := chr(127); (* " *)
    m90table [36]  := chr(123); (* # *)
    m90table [37]  := chr( 91); (* $ *)
    m90table [38]  := chr(108); (* % *)
    m90table [39]  := chr( 80); (* & *)
    m90table [40]  := chr(125); (* ' *)
    m90table [41]  := chr( 77); (* ( *)
    m90table [42]  := chr( 93); (* ) *)
    m90table [43]  := chr( 92); (* * *)
    m90table [44]  := chr( 78); (* + *)
    m90table [45]  := chr(107); (* , *)
    m90table [46]  := chr( 96); (* - *)
    m90table [47]  := chr( 75); (* . *)
    m90table [48]  := chr( 97); (* / *)
    m90table [49]  := chr(240); (* 0 *)
    m90table [50]  := chr(241); (* 1 *)
    m90table [51]  := chr(242); (* 2 *)
    m90table [52]  := chr(243); (* 3 *)
    m90table [53]  := chr(244); (* 4 *)
    m90table [54]  := chr(245); (* 5 *)
    m90table [55]  := chr(246); (* 6 *)
    m90table [56]  := chr(247); (* 7 *)
    m90table [57]  := chr(248); (* 8 *)
    m90table [58]  := chr(249); (* 9 *)
    m90table [59]  := chr(122); (* : *)
    m90table [60]  := chr( 94); (* ; *)
    m90table [61]  := chr( 76); (* < *)
    m90table [62]  := chr(126); (* = *)
    m90table [63]  := chr(110); (* > *)
    m90table [64]  := chr(111); (* ?? *)
    m90table [65]  := chr(124); (* @ *)
    m90table [66]  := chr(193); (* A *)
    m90table [67]  := chr(194); (* B *)
    m90table [68]  := chr(195); (* C *)
    m90table [69]  := chr(196); (* D *)
    m90table [70]  := chr(197); (* E *)
    m90table [71]  := chr(198); (* F *)
    m90table [72]  := chr(199); (* G *)
    m90table [73]  := chr(200); (* H *)
    m90table [74]  := chr(201); (* I *)
    m90table [75]  := chr(209); (* J *)
    m90table [76]  := chr(210); (* K *)
    m90table [77]  := chr(211); (* L *)
    m90table [78]  := chr(212); (* M *)
    m90table [79]  := chr(213); (* N *)
    m90table [80]  := chr(214); (* O *)
    m90table [81]  := chr(215); (* P *)
    m90table [82]  := chr(216); (* Q *)
    m90table [83]  := chr(217); (* R *)
    m90table [84]  := chr(226); (* S *)
    m90table [85]  := chr(227); (* T *)
    m90table [86]  := chr(228); (* U *)
    m90table [87]  := chr(229); (* V *)
    m90table [88]  := chr(230); (* W *)
    m90table [89]  := chr(231); (* X *)
    m90table [90]  := chr(232); (* Y *)
    m90table [91]  := chr(233); (* Z *)
    m90table [92]  := chr(173); (* [  *)
    m90table [93]  := chr(224); (* Backslash *)
    m90table [94]  := chr(189); (*  ] *)
    m90table [95]  := chr( 95); (* Nicht_Zeichen *)
    m90table [96]  := chr(109); (* _ *)
    m90table [97]  := chr(121); (* nach links geneigtes Hochkomma *)
    m90table [98]  := chr(129); (* a *)
    m90table [99]  := chr(130); (* b *)
    m90table [100] := chr(131); (* c *)
    m90table [101] := chr(132); (* d *)
    m90table [102] := chr(133); (* e *)
    m90table [103] := chr(134); (* f *)
    m90table [104] := chr(135); (* g *)
    m90table [105] := chr(136); (* h *)
    m90table [106] := chr(137); (* i *)
    m90table [107] := chr(145); (* j *)
    m90table [108] := chr(146); (* k *)
    m90table [109] := chr(147); (* l *)
    m90table [110] := chr(148); (* m *)
    m90table [111] := chr(149); (* n *)
    m90table [112] := chr(150); (* o *)
    m90table [113] := chr(151); (* p *)
    m90table [114] := chr(152); (* q *)
    m90table [115] := chr(153); (* r *)
    m90table [116] := chr(162); (* s *)
    m90table [117] := chr(163); (* t *)
    m90table [118] := chr(164); (* u *)
    m90table [119] := chr(165); (* v *)
    m90table [120] := chr(166); (* w *)
    m90table [121] := chr(167); (* x *)
    m90table [122] := chr(168); (* y *)
    m90table [123] := chr(169); (* z *)
    m90table [124] := chr(192); (* geschweifte Klammer auf *)
    m90table [125] := chr(106); (* senkrechter Strich *)
    m90table [126] := chr(208); (* geschweifte Klammer zu *)
    m90table [127] := chr(161); (* Wellenlinie *)
    m90table [128] := chr(  7); (* del *)
    m90table [129] := chr(  4);
    m90table [130] := chr(  6);
    m90table [131] := chr(  8);
    m90table [132] := chr(  9);
    m90table [133] := chr( 10);
    m90table [134] := chr( 20);
    m90table [135] := chr( 21);
    m90table [136] := chr( 23);
    m90table [137] := chr( 26);
    m90table [138] := chr( 27);
    m90table [139] := chr( 32);
    m90table [140] := chr( 33);
    m90table [141] := chr( 34);
    m90table [142] := chr( 35);
    m90table [143] := chr( 36);
    m90table [144] := chr( 40);
    m90table [145] := chr( 41);
    m90table [146] := chr( 42);
    m90table [147] := chr( 43);
    m90table [148] := chr( 44);
    m90table [149] := chr( 48);
    m90table [150] := chr( 49);
    m90table [151] := chr( 51);
    m90table [152] := chr( 52);
    m90table [153] := chr( 53);
    m90table [154] := chr( 54);
    m90table [155] := chr( 56);
    m90table [156] := chr( 57);
    m90table [157] := chr( 58);
    m90table [158] := chr( 59);
    m90table [159] := chr( 62);
    m90table [160] := chr( 65);
    m90table [161] := chr( 66);
    m90table [162] := chr( 67);
    m90table [163] := chr( 68);
    m90table [164] := chr( 69);
    m90table [165] := chr( 70);
    m90table [166] := chr( 71);
    m90table [167] := chr( 72);
    m90table [168] := chr( 73);
    m90table [169] := chr( 74);
    m90table [170] := chr( 79);
    m90table [171] := chr( 81);
    m90table [172] := chr( 82);
    m90table [173] := chr( 83);
    m90table [174] := chr( 84);
    m90table [175] := chr( 85);
    m90table [176] := chr( 86);
    m90table [177] := chr( 87);
    m90table [178] := chr( 88);
    m90table [179] := chr( 89);
    m90table [180] := chr( 98);
    m90table [181] := chr( 99);
    m90table [182] := chr(100);
    m90table [183] := chr(101);
    m90table [184] := chr(102);
    m90table [185] := chr(103);
    m90table [186] := chr(104);
    m90table [187] := chr(105);
    m90table [188] := chr(112);
    m90table [189] := chr(113);
    m90table [190] := chr(114);
    m90table [191] := chr(115);
    m90table [192] := chr(116);
    m90table [193] := chr(117);
    m90table [194] := chr(118);
    m90table [195] := chr(119);
    m90table [196] := chr(120);
    m90table [197] := chr(128);
    m90table [198] := chr(138);
    m90table [199] := chr(139);
    m90table [200] := chr(140);
    m90table [201] := chr(141);
    m90table [202] := chr(142);
    m90table [203] := chr(143);
    m90table [204] := chr(144);
    m90table [205] := chr(154);
    m90table [206] := chr(155);
    m90table [207] := chr(156);
    m90table [208] := chr(157);
    m90table [209] := chr(158);
    m90table [210] := chr(159);
    m90table [211] := chr(160);
    m90table [212] := chr(170);
    m90table [213] := chr(171);
    m90table [214] := chr(172);
    m90table [215] := chr(174);
    m90table [216] := chr(175);
    m90table [217] := chr(176);
    m90table [218] := chr(177);
    m90table [219] := chr(178);
    m90table [220] := chr(179);
    m90table [221] := chr(180);
    m90table [222] := chr(181);
    m90table [223] := chr(182);
    m90table [224] := chr(183);
    m90table [225] := chr(184);
    m90table [226] := chr(185);
    m90table [227] := chr(186);
    m90table [228] := chr(187);
    m90table [229] := chr(188);
    m90table [230] := chr(190);
    m90table [231] := chr(191);
    m90table [232] := chr(202);
    m90table [233] := chr(203);
    m90table [234] := chr(204);
    m90table [235] := chr(205);
    m90table [236] := chr(206);
    m90table [237] := chr(207);
    m90table [238] := chr(218);
    m90table [239] := chr(219);
    m90table [240] := chr(220);
    m90table [241] := chr(221);
    m90table [242] := chr(222);
    m90table [243] := chr(223);
    m90table [244] := chr(225);
    m90table [245] := chr(234);
    m90table [246] := chr(235);
    m90table [247] := chr(236);
    m90table [248] := chr(237);
    m90table [249] := chr(238);
    m90table [250] := chr(239);
    m90table [251] := chr(250);
    m90table [252] := chr(251);
    m90table [253] := chr(252);
    m90table [254] := chr(253);
    m90table [255] := chr(254);
    m90table [256] := chr(255);
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      to_ebcdic (
            VAR cc : char);
 
BEGIN
cc := m90table [ord(cc)+1] ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90comment;
 
CONST
      n_cm = 'Enter Comment       ';
 
VAR
      s20 : tsp_c20;
      ln, ln2 : tsp_line;
      i, len : integer;
 
BEGIN
s20 := n_cm;
FOR i:=1 TO 20 DO
    ln  [i]  := s20  [i] ;
(*ENDFOR*) 
FOR i:=21 TO mxsp_line DO
    ln  [i]  := ' ';
(*ENDFOR*) 
&ifndef BATCH
m93putscreen (ln);
m93getscreen (ln);
&endif
len := mxsp_line;
WHILE (len > 1) AND (ln [len ] = ' ') DO
    len := len - 1;
(*ENDWHILE*) 
IF  len > 1
THEN
    BEGIN
    ln2 := ln;
    FOR i := 1 TO len DO
        ln2 [i]  := '=';
    (*ENDFOR*) 
    m90write_line (ln2);
    m90write_line (ln);
    m90write_line (ln2);
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90nl;
 
BEGIN
m90line ( xx, m90outputline.text);
m90outputline := m90blankline;
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90wint ( int : tsp_int4 );
 
VAR
      ok : boolean;
 
BEGIN
m90put4int ( m90outputline, int, 11, ok);
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90wchar ( ch : char;
            count : integer );
 
VAR
      i : integer;
 
BEGIN
WITH m90outputline DO
    BEGIN
    IF  mxsp_line - pos < count
    THEN
        count := mxsp_line - pos;
    (*ENDIF*) 
    FOR i := 1 TO count DO
        text [pos + i ] := ch;
    (*ENDFOR*) 
    pos := pos + count;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90wstring (
            VAR str : tsp_any_packed_char;
            strpos  : integer;
            len     : integer );
 
VAR
      i : integer;
 
BEGIN
WITH m90outputline DO
    BEGIN
    IF  mxsp_line - pos < len
    THEN
        len := mxsp_line - pos;
    (*ENDIF*) 
    FOR i := 1 TO len DO
        text [pos+i ] := str [strpos + i - 1] ;
    (*ENDFOR*) 
    pos := pos + len;
    END;
(*ENDWITH*) 
END; (* m90wstring *)
 
(*------------------------------*) 
 
PROCEDURE
      m90w1string (
            VAR str : tsp_any_packed_char;
            strpos  : integer;
            len     : integer );
 
BEGIN
m90wstring ( str, strpos, len );
END; (* m90w1string *)
 
(*------------------------------*) 
 
PROCEDURE
      m90w2string (
            VAR str : tsp_any_packed_char;
            strpos  : integer;
            len     : integer );
 
BEGIN
m90wstring ( str, strpos, len );
END; (* m90w2string *)
 
(*------------------------------*) 
 
PROCEDURE
      m90wc30 (
            str : tsp_c30;
            len : integer );
 
BEGIN
WITH m90outputline DO
    BEGIN
    IF  mxsp_line - pos < len
    THEN
        len := mxsp_line - pos;
    (*ENDIF*) 
    IF  pos < mxsp_line
    THEN
        BEGIN
        s10mv1 ( mxsp_c30, mxsp_line, str, 1, text, pos + 1, len );
        pos := pos + len;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90wc64 (
            str : tsp_c64;
            len : integer );
 
BEGIN
WITH m90outputline DO
    BEGIN
    IF  mxsp_line - pos < len
    THEN
        len := mxsp_line - pos;
    (*ENDIF*) 
    IF  pos < mxsp_line
    THEN
        BEGIN
        s10mv2 ( mxsp_c64, mxsp_line, str, 1, text, pos + 1, len );
        pos := pos + len;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90resetcounter;
 
VAR
      i : integer;
 
BEGIN
FOR i := 1 TO 10 DO
    m90counter [i]  := 0;
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90incrcounter( i : integer );
 
BEGIN
m90counter [i]  := m90counter [i]  + 1;
END;
 
(*------------------------------*) 
 
FUNCTION
      m90getcounter( i : integer ) : tsp_int4;
 
BEGIN
m90getcounter := m90counter [i] ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      disk_full;
 
BEGIN
sqlabort;
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90str  (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            len     : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_anf+len );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90str1 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            len     : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_anf+len );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90str2 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            len     : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_anf+len );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90str3 (
            layer   : tsp_layer;
            VAR buf : tsp_buf;
            pos_anf : integer;
            len     : integer);
 
BEGIN
m90buf ( layer, buf, pos_anf, pos_anf+len );
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90module (
            layer    : tsp_layer;
            VAR auth : tsp_knl_identifier;
            VAR appl : tsp_name;
            VAR modn : tsp_name );
 
VAR
      i    : integer;
      l    : tsp_line;
      lpos : integer;
      namelen : integer;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    s10fil ( mxsp_line, l, 1, mxsp_line, bsp_c1 );
    lpos := 0;
    namelen := 0;
    FOR i := 1 TO sizeof (auth) DO
        BEGIN
        l[lpos+i] := auth[i];
        IF  auth [i] <> ' '
        THEN
            namelen := i;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    lpos := lpos + namelen + 1;
    l[lpos] := '.';
    FOR i := 1 TO mxsp_name DO
        l[lpos+i] := appl[i];
    (*ENDFOR*) 
    lpos := lpos + s30klen ( appl, bsp_c1, sizeof(appl) ) + 1;
    l[lpos] := '.';
    FOR i := 1 TO mxsp_name DO
        l[lpos+i] := modn[i];
    (*ENDFOR*) 
    lpos := lpos + s30klen ( modn, bsp_c1, sizeof(modn) ) + 1;
    m90write_line ( l );
    END;
(*ENDIF*) 
END; (* m90module *)
 
(*------------------------------*) 
 
PROCEDURE
      m90longdescriptor (
            layer         : tsp_layer;
            name          : tsp_sname;
            VAR long_desc : tsp_long_descriptor;
            full_info     : boolean );
 
BEGIN
IF  m90istest_on(layer)
THEN
    WITH long_desc DO
        BEGIN
        m90sname ( layer, name );
        m90sname ( layer, 'OLD LONGDESC' );
        IF  full_info
        THEN
            BEGIN
            m90int ( layer, 'ld_intern_po', ld_intern_pos );
            END;
        (*ENDIF*) 
        m90int ( layer, 'ld_valind   ', ld_valind);
        CASE ld_valmode OF
            vm_datapart     :
                m90name (layer, 'vm_datapart       ');
            vm_alldata      :
                m90name (layer, 'vm_allpart        ');
            vm_lastdata     :
                m90name (layer, 'vm_lastpart       ');
            vm_nodata       :
                m90name (layer, 'vm_nodata         ');
            vm_no_more_data :
                m90name (layer, 'vm_no_more_data   ');
            vm_last_putval :
                m90name (layer, 'vm_last_putval    ');
            vm_data_trunc :
                m90name (layer, 'vm_data_trunc     ');
            OTHERWISE
                m90int  (layer, 'vm_unknown  ', ord (ld_valmode));
            END;
        (*ENDCASE*) 
        m90int  (layer, 'ld_valpos   ', ld_valpos);
        m90int  (layer, 'ld_vallen   ', ld_vallen);
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END; (* m90longdescriptor *)
 
(*------------------------------*) 
 
PROCEDURE
      m90ldb_longdescblock (
            layer         : tsp_layer;
            name          : tsp_sname;
            VAR long_desc : tsp_long_desc_block;
            full_info     : boolean );
 
BEGIN
IF  m90istest_on(layer)
THEN
    WITH long_desc DO
        BEGIN
        m90sname ( layer, name );
        m90sname ( layer, 'NEW LONGDESC' );
        IF  full_info
        THEN
            BEGIN
            m90int4 ( layer, 'ldb_curr_pag', ldb_curr_pageno );
            m90int4 ( layer, 'ldb_curr_pos', ldb_curr_pos );
            m90int  ( layer, 'ldb_colno   ', ord(ldb_colno[1]) );
            m90int  ( layer, 'ldb_showkind', ord(ldb_show_kind[1]) );
            m90int  ( layer, 'ldb_serverdb', ord(ldb_serverdb_no [1]));
            m90int  ( layer, 'ldb_serverdb', ord(ldb_serverdb_no [2]));
            m90int4 ( layer, 'ldb_full_len', ldb_full_len );
            m90int4 ( layer, 'ldb_intern_p', ldb_intern_pos );
            END;
        (*ENDIF*) 
        m90int ( layer, 'ldb_valind  ', ldb_valind);
        CASE ldb_valmode OF
            vm_datapart     :
                m90name (layer, 'vm_datapart       ');
            vm_alldata      :
                m90name (layer, 'vm_allpart        ');
            vm_lastdata     :
                m90name (layer, 'vm_lastpart       ');
            vm_nodata       :
                m90name (layer, 'vm_nodata         ');
            vm_no_more_data :
                m90name (layer, 'vm_no_more_data   ');
            vm_last_putval :
                m90name (layer, 'vm_last_putval    ');
            vm_data_trunc :
                m90name (layer, 'vm_data_trunc     ');
            OTHERWISE
                m90int  (layer, 'vm_unknown  ', ord (ldb_valmode));
            END;
        (*ENDCASE*) 
        m90int2 (layer, 'ldb_valpos  ', ldb_valpos);
        m90int2 (layer, 'ldb_vallen  ', ldb_vallen);
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END; (* m90longdescblock *)
 
(*------------------------------*) 
 
PROCEDURE
      m90anyld (
            layer         : tsp_layer;
            name          : tsp_sname;
            VAR long_desc : tin_long_desc_type;
            full_info     : boolean );
 
BEGIN
IF  long_desc.lt_newlong
THEN
    m90ldb_longdescblock ( layer, name, long_desc.lt_new, full_info )
ELSE
    m90longdescriptor ( layer, name, long_desc.lt_old, full_info );
(*ENDIF*) 
END; (* m90anyld *)
 
(*------------------------------*) 
 
PROCEDURE
      m90warn (
            layer   : tsp_layer;
            warnset : tsp_warningset;
            always  : boolean );
 
VAR
      w : tsp_warnings;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    IF  always OR (warnset <> [])
    THEN
        BEGIN
        m90wchar ( '[', 1 );
        FOR w := warn1 TO warn15_serverdb_not_in_majority DO
            IF  w in warnset
            THEN
                m90wint ( ord(w) );
            (*ENDIF*) 
        (*ENDFOR*) 
        m90wchar ( ' ', 1 );
        m90wchar ( ']', 1 );
        m90nl;
        END;
    (*ENDIF*) 
(*ENDIF*) 
END; (* m90warn *)
 
(*------------------------------*) 
 
PROCEDURE
      m90buflength (
            buflength : integer );
 
BEGIN
m90.maxlength := buflength;
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90_hexto_line (
            c      : char;
            VAR dl : tsp_dataline);
 
VAR
      hex_byte : ARRAY [1..2] OF integer;
      i        : integer;
 
BEGIN
WITH dl DO
    BEGIN
    IF  ord(c) > 0
    THEN
        BEGIN
        hex_byte [1] := ord (c) DIV 16;
        hex_byte [2] := ord (c) MOD 16;
        FOR i := 1 TO 2 DO
            IF  hex_byte [i] > 9
            THEN
                text [pos+i] := chr (ord ('A') - 10 + hex_byte [i])
            ELSE
                text [pos+i] := chr (ord ('0')      + hex_byte [i])
            (*ENDIF*) 
        (*ENDFOR*) 
        END
    ELSE
        BEGIN
        text [pos+1] := '0';
        text [pos+2] := '0'
        END;
    (*ENDIF*) 
    pos := pos + 2
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90addr (
            layer    : tsp_layer;
            nam      : tsp_sname;
            bufaddr  : tsp_bufaddr);
 
CONST
      c_null   = '\00\00\00\00\00\00\00\00';
 
VAR
      i        : integer;
      dl       : tsp_dataline;
      ok       : boolean;
 
      addr_str : RECORD
            CASE boolean OF
                true:
                    (a : tsp_bufaddr);
                false:
                    (c : tsp_c8);
                END;
            (*ENDCASE*) 
 
 
BEGIN
(* The output of M90ADDR is in SWAPPED representation *)
(* (dependent from the processor type) !              *)
(* -- maybe a difference to SQLDBDIAG output --   hs  *)
(**)
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    BEGIN
    dl := m90blankline;
    m90putprompt ( dl, nam, ok );
    addr_str.c := c_null;
    addr_str.a := bufaddr;
    FOR i := 1 TO sizeof (bufaddr) DO
        m90_hexto_line (addr_str.c [i], dl);
    (*ENDFOR*) 
    m90write_line (dl.text)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90addr1 (
            layer    : tsp_layer;
            nam      : tsp_sname;
            bufaddr  : tsp_bufaddr);
 
BEGIN
m90addr (layer, nam, bufaddr);
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90addr2 (
            layer    : tsp_layer;
            nam      : tsp_sname;
            bufaddr  : tsp_bufaddr);
 
BEGIN
m90addr (layer, nam, bufaddr);
END;
 
(*------------------------------*) 
 
PROCEDURE
      m90user_parms (
            layer     : tsp_layer;
            nam       : tsp_sname;
            userparms : tsp4_xuser_record);
 
VAR
      i        : integer;
      dl       : tsp_dataline;
      ok       : boolean;
 
BEGIN
IF  (layer = xx) OR
    (m90.test_or_trace AND (layer in m90.test_schicht))
THEN
    WITH userparms, dl DO
        BEGIN
        m90sname (layer, nam);
        (* === *)
        m90sname (layer, ' START =====');
        (* === *)
        dl := m90blankline;
        m90putprompt ( dl, ' KEY        ', ok );
        FOR i := 1 TO sizeof (xu_key) DO
            dl.text [ i + pos ] := xu_key [ i ];
        (*ENDFOR*) 
        m90write_line (dl.text);
        (* === *)
        dl := m90blankline;
        m90putprompt ( dl, ' SERVERNODE ', ok );
        FOR i := 1 TO sizeof (xu_servernode) DO
            dl.text [ i + pos ] := xu_servernode [ i ];
        (*ENDFOR*) 
        m90write_line (dl.text);
        (* === *)
        dl := m90blankline;
        m90putprompt ( dl, ' SERVERDB   ', ok );
        FOR i := 1 TO sizeof (xu_serverdb) DO
            dl.text [ i + pos ] := xu_serverdb [ i ];
        (*ENDFOR*) 
        m90write_line (dl.text);
        (* === *)
        dl := m90blankline;
        m90putprompt ( dl, ' USER       ', ok );
        FOR i := 1 TO sizeof (xu_user) DO
            dl.text [ i + pos ] := xu_user [ i ];
        (*ENDFOR*) 
        m90write_line (dl.text);
        (* === *)
        dl := m90blankline;
        m90putprompt ( dl, ' PASSWORD   ', ok );
        FOR i := 1 TO sizeof (xu_password) DO
            m90_hexto_line (xu_password [i], dl);
        (*ENDFOR*) 
        m90write_line (dl.text);
        (* === *)
        dl := m90blankline;
        m90putprompt ( dl, ' SQLMODE    ', ok );
        FOR i := 1 TO sizeof (xu_sqlmode) DO
            dl.text [ i + pos ] := xu_sqlmode [ i ];
        (*ENDFOR*) 
        m90write_line (dl.text);
        (* === *)
        m90int (layer, ' CACHELIMIT ', xu_cachelimit);
        (* === *)
        m90int (layer, ' TIMEOUT    ', xu_timeout);
        (* === *)
        m90int (layer, ' ISOLATION  ', xu_isolation);
        (* === *)
        dl := m90blankline;
        m90putprompt ( dl, ' DBLANG     ', ok );
        FOR i := 1 TO sizeof (xu_dblang) DO
            dl.text [ i + pos ] := xu_dblang [ i ];
        (*ENDFOR*) 
        m90write_line (dl.text);
        (* ==== *)
        m90sname (layer, ' END =======');
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :       1611
*-PRETTY-*  lines of code :       4368        PRETTY  3.09 
*-PRETTY-*  lines in file :       5294         1992-11-23 
.PA 
