/* @lastChanged: "1998-02-16 12:00"
 
 * @filename:   vta02
 * @purpose:    "TA_test_procedures"
 * @release:    7.1.0.0
 * @see:        "-.-"
 *
 * @copyright:  (c) 1998-2004 SAP AG"
 */
 
.tt 1 $SAP$LiveCache$VTA02$
.tt 3 $$TA_test_procedures$1999-03-08$
 
.nf
 
 
    ========== licence begin  GPL
    Copyright (c) 1998-2004 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program 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 General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
 
.fo
***********************************************************
 
Module  : TA_test_procedures
 
Define  :
 
        PROCEDURE
              cccprint (tt : tsp_trace);
 
        PROCEDURE
              t02buf (debug  : tut_debug;
                    VAR buf  : tsp00_Buf;
                    startpos : integer;
                    endpos   : integer);
 
        PROCEDURE
              t02buf1 (debug  : tut_debug;
                    VAR buf  : tsp00_Buf;
                    startpos : integer;
                    endpos   : integer);
 
        FUNCTION
              t02buflength_max : tsp00_Int4;
 
        PROCEDURE
              t02c4int (debug : tut_debug;
                    nam       : tsp00_Sname;
                    int       : tsp00_C4);
 
        PROCEDURE
              t02c64 (debug : tut_debug; VAR msg : tsp00_C64);
 
        PROCEDURE
              t02int4 (debug : tut_debug;
                    nam      : tsp00_Sname;
                    int      : tsp00_Int4);
 
        FUNCTION
              t02is_minbuf : boolean;
 
        PROCEDURE
              t02limited_switch (VAR pfkey : tut_pfkey);
 
        PROCEDURE
              t02maxbuflength (VAR pfkey : tut_pfkey);
 
        PROCEDURE
              t02messtype (debug : tut_debug;
                    nam          : tsp00_Sname;
                    mess_type    : tgg00_MessType);
 
        PROCEDURE
              t02minbuf (min_wanted : boolean);
 
        PROCEDURE
              t02moveobj (debug  : tut_debug;
                    VAR moveobj  : tsp00_MoveObj;
                    moveobj_size : tsp00_Int4;
                    startpos     : tsp00_Int4;
                    endpos       : tsp00_Int4);
 
        PROCEDURE
              t02name (debug : tut_debug; nam  : tsp00_Name);
 
        PROCEDURE
              t02name1 (debug : tut_debug;
                    nam       : tsp00_Sname;
                    n         : tsp00_Name);
 
        PROCEDURE
              t02p2int4 (debug : tut_debug;
                    nam_1 : tsp00_Sname;
                    int_1 : tsp00_Int4;
                    nam_2 : tsp00_Sname;
                    int_2 : tsp00_Int4);
 
        PROCEDURE
              t02p4int4 (debug : tut_debug;
                    nam   : tsp00_Sname;
                    int_1 : tsp00_Int4;
                    int_2 : tsp00_Int4;
                    int_3 : tsp00_Int4;
                    int_4 : tsp00_Int4);
 
        PROCEDURE
              t02sinit;
 
        PROCEDURE
              t02sname (debug : tut_debug; nam : tsp00_Sname);
 
        PROCEDURE
              t02stackentry (debug : tut_debug;
                    VAR st         : tgg00_StackEntry;
                    entry_index    : integer);
 
        PROCEDURE
              t02str30 (debug : tut_debug; str30 : tsp00_C30);
 
        PROCEDURE
              t02switch (VAR pfkey : tut_pfkey);
 
        PROCEDURE
              t02tabid (debug : tut_debug;
                    nam       : tsp00_Sname;
                    VAR tabid : tgg00_Surrogate);
 
        FUNCTION
              t02trace (debug : tut_debug) : boolean;
 
        PROCEDURE
              t02vffn (debug : tut_debug;
                    nam : tsp00_Sname;
                    fn  : tsp00_VFilename);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              GG_edit_routines : VGG17;
 
        PROCEDURE
              g17c4int_to_line (int : tsp00_C4;
                    VAR ln_len      : integer;
                    VAR ln          : tsp00_Line);
 
        PROCEDURE
              g17int4to_line (int : tsp00_Int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp00_Line);
 
        PROCEDURE
              g17messtype_to_line (mess_type : tgg00_MessType;
                    VAR ln_len : integer;
                    VAR ln     : tsp00_Line);
 
        PROCEDURE
              g17onestackentry (VAR st : tgg00_StackEntry;
                    entry_index        : integer;
                    VAR ln             : tsp00_Line;
                    VAR is_second_ln   : boolean;
                    VAR second_ln      : tsp00_Line);
 
        FUNCTION
              g17printable_char (c : char) : boolean;
 
        PROCEDURE
              g17hexto_line (c : char;
                    VAR ln_len : integer;
                    VAR ln     : tsp00_Line);
 
      ------------------------------ 
 
        FROM
              TA_terminal_IO_of_ci : VTA03;
 
        VAR
              t03protfile : tut_vf_fileref;
              t03term     : tut_terminal;
 
        PROCEDURE
              t03abort;
 
        PROCEDURE
              t03get (VAR text : tsp00_Line; VAR pfkey : tut_pfkey);
 
        PROCEDURE
              t03newscreen_page;
 
        PROCEDURE
              t03put20 (text : tsp00_C20; text_attr : char);
 
        PROCEDURE
              t03put30 (text : tsp00_C30; text_attr : char);
 
        PROCEDURE
              t03put60 (text : tsp00_C60; text_attr : char);
 
        PROCEDURE
              t03write_prot (VAR ln : tsp00_Line;
                    length    : integer;
                    VAR error : integer);
 
      ------------------------------ 
 
        FROM
              TA_buf_display : VTA14;
 
        PROCEDURE
              t14bufdisplay (VAR term : tut_terminal;
                    VAR protfile      : tut_vf_fileref;
                    scan              : tut_diag_scan;
                    msg               : tsp00_C30;
                    VAR buf           : tsp00_MoveObj;
                    buf_size          : tsp00_Int4;
                    startpos          : tsp00_Int4;
                    endpos            : tsp00_Int4;
                    start_numbering   : tsp00_Int4;
                    VAR break_pos     : tsp00_Int4;
                    VAR pfkey         : tut_pfkey);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              g10mv (
                    mod_id      : tsp00_C6;            
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;          
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;       
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;       
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30lnr (VAR str : tsp00_Line;
                    val       : char;
                    start     : tsp00_Int4;
                    cnt       : tsp00_Int4) : tsp00_Int4;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        FUNCTION
              s30lnr;
 
              tsp00_MoveObj tsp00_Line
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1980-01-30
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1999-03-08
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2;.cp 3
***********************************************************
.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    :
 
 
CONST
      tdstop          = 'TDSTOP          ';
      msg_buflimit    = 'BUFFER LENGTH:      ';
      msg_start_trace = 'START TRACE:        ';
      msg_stop_trace  = 'STOP TRACE: / TDSTOP';
      msg_debug_help  = 'DEBUGGING (ta,ut):            ';
      msg_trace_count = 'COUNT START TRACE:  ';
      msg_trace_layer = 'TRACE LAYERS(ta,ut):';
 
TYPE
      t_moveobj_ptr = ^tsp00_MoveObj;
 
      states_td = RECORD
            on_text        : tsp00_Trace;
            off_text       : tsp00_Trace;
            on_count       : integer;
            maxlength      : integer;
            last_layer     : char;
            minbuf         : boolean;
            debug_or_trace : boolean;
            trace_ta       : boolean;
            trace_ut       : boolean;
            trace_xt       : boolean;
            debugging      : SET OF tut_debug;
            blankline      : tsp00_Line
      END;
 
 
      hexbuf_line = RECORD
            CASE integer OF
                1:
                    (ln : tsp00_Line);
                2:
                    (prefix : tsp00_C4)
                END;
            (*ENDCASE*) 
 
 
VAR
      td : states_td;
 
 
(*------------------------------*) 
 
PROCEDURE
      cccprint (tt : tsp_trace);
 
CONST
      start_layer = 1;
 
VAR
      switched_on    : boolean;
      trace_en_gg_sp : boolean;
      trace_output   : boolean;
      i              : integer;
      ln_len         : integer;
      ln             : tsp00_Line;
 
BEGIN
switched_on := false;
IF  td.on_text = tt
THEN
    BEGIN
    td.on_count := td.on_count - 1;
    IF  td.on_count = 0
    THEN
        BEGIN
        IF  td.off_text = tdstop
        THEN
            BEGIN
            t03abort;
            END
        ELSE
            BEGIN
            td.on_text        := bsp_c16;
            td.debug_or_trace := true;
            switched_on       := true
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  td.debug_or_trace
THEN
    BEGIN
    IF  (td.off_text = tt) AND NOT switched_on
    THEN
        BEGIN
        td.debug_or_trace := false;
        td.off_text      := bsp_c16
        END
    ELSE
        BEGIN
        trace_output   := false;
        trace_en_gg_sp := false;
        CASE tt [start_layer]  OF
            't' , 'T':
                IF  td.trace_ta
                THEN
                    BEGIN
                    trace_output  := true;
                    td.last_layer := tt [start_layer]
                    END;
                (*ENDIF*) 
            'u' , 'U':
                IF  td.trace_ut
                THEN
                    BEGIN
                    trace_output  := true;
                    td.last_layer := tt [start_layer]
                    END;
                (*ENDIF*) 
            'x' , 'X':
                IF  td.trace_xt
                THEN
                    BEGIN
                    trace_output  := true;
                    td.last_layer := tt [start_layer]
                    END;
                (*ENDIF*) 
            OTHERWISE
                trace_output := true
            END;
        (*ENDCASE*) 
        IF  trace_en_gg_sp
        THEN
            CASE td.last_layer OF
                't' , 'T':
                    IF  td.trace_ta
                    THEN
                        trace_output := true;
                    (*ENDIF*) 
                'u' , 'U':
                    IF  td.trace_ut
                    THEN
                        trace_output := true;
                    (*ENDIF*) 
                'x' , 'X':
                    IF  td.trace_xt
                    THEN
                        trace_output  := true;
                    (*ENDIF*) 
                OTHERWISE
                    trace_output := false
                END;
            (*ENDCASE*) 
        (*ENDIF*) 
        IF  trace_output
        THEN
            BEGIN
            ln := td.blankline;
            s10mv (sizeof (tt), sizeof (ln),
                  @tt, 1, @ln, 1, sizeof (tt));
            ln_len := sizeof (tt);
            t03write_prot (ln, ln_len, i)
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02buf (debug  : tut_debug;
            VAR buf  : tsp00_Buf;
            startpos : integer;
            endpos   : integer);
 
VAR
      dummy_pfkey : tut_pfkey;
      scan        : tut_diag_scan;
      dummy_pos   : integer;
      upb         : tsp00_Int4;
      moveobj_ptr : t_moveobj_ptr;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    moveobj_ptr := @buf;
    IF  endpos - startpos + 1 > td.maxlength
    THEN
        upb := startpos + td.maxlength - 1
    ELSE
        upb := endpos;
    (*ENDIF*) 
    IF  td.minbuf
    THEN
        scan := [utds_minbuf]
    ELSE
        scan := [ ];
    (*ENDIF*) 
    t14bufdisplay (t03term, t03protfile, scan,
          'BUFFER                        ',
          moveobj_ptr^, sizeof (buf), startpos, upb,
          startpos, dummy_pos, dummy_pfkey)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02buf1 (debug  : tut_debug;
            VAR buf  : tsp00_Buf;
            startpos : integer;
            endpos   : integer);
 
BEGIN
t02buf (debug, buf, startpos, endpos)
END;
 
(*------------------------------*) 
 
FUNCTION
      t02buflength_max : tsp00_Int4;
 
BEGIN
t02buflength_max := td.maxlength
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02c4int (debug : tut_debug;
            nam       : tsp00_Sname;
            int       : tsp00_C4);
 
VAR
      ln_len : integer;
      ln     : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    s10mv (sizeof(nam), sizeof(ln), @nam, 1, @ln, 1, sizeof(nam));
    ln_len      := sizeof (nam) + 2;
    ln [ln_len] := ':';
    ln_len      := ln_len + 1;
    IF  (int = cgg_nil_session) OR
        (int[1] > chr(127))
    THEN
        g17c4int_to_line (int, ln_len, ln)
    ELSE
        g17int4to_line (ord (int [1]) * 16777216
              +         ord (int [2]) *    65536
              +         ord (int [3]) *      256
              +         ord (int [4]),
              false, 11, ln_len, ln);
    (*ENDIF*) 
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02c64 (debug : tut_debug; VAR msg : tsp00_C64);
 
VAR
      i  : integer;
      ln : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    i := 1;
    WHILE i <= sizeof (msg) DO
        BEGIN
        IF  g17printable_char (msg [i])
        THEN
            ln [i] := msg [i]
        ELSE
            ln [i] := '.';
        (*ENDIF*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02int4 (debug : tut_debug;
            nam : tsp00_Sname;
            int : tsp00_Int4);
 
VAR
      ln : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    ta02name_int4_to_line (nam, 13, int, 11, 1, ln);
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      t02is_minbuf : boolean;
 
BEGIN
t02is_minbuf := td.minbuf
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02limited_switch (VAR pfkey : tut_pfkey);
 
VAR
      i  : integer;
      ln : tsp00_Line;
 
BEGIN
pfkey := pf_none;
t02switch (pfkey);
IF  pfkey = pf_none
THEN
    BEGIN
    td.debug_or_trace := false;
    t03put20 (msg_start_trace, cut_protected);
    t03get (ln, pfkey)
    END;
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    i := 1;
    WHILE i <= 16 DO
        BEGIN
        td.on_text [i] := ln [i];
        i := succ(i)
        END;
    (*ENDWHILE*) 
    t03put20 (msg_trace_count, cut_protected);
    ta02readint (td.on_count, pfkey)
    END;
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    t03put20 (msg_stop_trace, cut_protected);
    t03get (ln, pfkey)
    END;
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    i := 1;
    WHILE i <= 16 DO
        BEGIN
        td.off_text [i] := ln [i];
        i := succ(i)
        END;
    (*ENDWHILE*) 
    IF  td.off_text = tdstop
    THEN
        td.debug_or_trace := true
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02maxbuflength (VAR pfkey : tut_pfkey);
 
BEGIN
t03put20 (msg_buflimit, cut_protected);
ta02readint (td.maxlength, pfkey)
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02messtype (debug : tut_debug;
            nam          : tsp00_Sname;
            mess_type    : tgg00_MessType);
 
VAR
      ln_len : integer;
      ln     : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    s10mv (sizeof(nam), sizeof(ln), @nam, 1, @ln, 1, sizeof(nam));
    ln_len      := sizeof (nam) + 2;
    ln [ln_len] := ':';
    g17messtype_to_line (mess_type, ln_len, ln);
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02minbuf (min_wanted : boolean);
 
BEGIN
td.minbuf := min_wanted
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02moveobj (debug  : tut_debug;
            VAR moveobj  : tsp00_MoveObj;
            moveobj_size : tsp00_Int4;
            startpos     : tsp00_Int4;
            endpos       : tsp00_Int4);
 
VAR
      dummy_pfkey : tut_pfkey;
      scan        : tut_diag_scan;
      dummy_pos   : tsp00_Int4;
      upb         : tsp00_Int4;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    IF  endpos - startpos + 1 > td.maxlength
    THEN
        upb := startpos + td.maxlength - 1
    ELSE
        upb := endpos;
    (*ENDIF*) 
    IF  td.minbuf
    THEN
        scan := [utds_minbuf]
    ELSE
        scan := [ ];
    (*ENDIF*) 
    t14bufdisplay (t03term, t03protfile, scan,
          'MOVEOBJ                       ',
          moveobj, moveobj_size, startpos, upb,
          startpos, dummy_pos, dummy_pfkey)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02name (debug : tut_debug; nam : tsp00_Name);
 
VAR
      i  : integer;
      ln : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    i := 1;
    WHILE i <= sizeof (nam) DO
        BEGIN
        IF  g17printable_char (nam [i])
        THEN
            ln [i] := nam [i]
        ELSE
            ln [i] := '.';
        (*ENDIF*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02name1 (debug : tut_debug;
            nam       : tsp00_Sname;
            n         : tsp00_Name);
 
VAR
      i      : integer;
      ln_len : integer;
      ln     : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    s10mv (sizeof(nam), sizeof(ln), @nam, 1, @ln, 1, sizeof(nam));
    ln_len      := sizeof (nam) + 2;
    ln [ln_len] := ':';
    ln_len      := ln_len + 1;
    i := 1;
    WHILE i <= sizeof (n) DO
        BEGIN
        IF  g17printable_char (n [i])
        THEN
            ln [ln_len + i] := n [i]
        ELSE
            ln [ln_len + i] := '.';
        (*ENDIF*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02p2int4 (debug : tut_debug;
            nam_1 : tsp00_Sname;
            int_1 : tsp00_Int4;
            nam_2 : tsp00_Sname;
            int_2 : tsp00_Int4);
 
VAR
      ln : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    ta02name_int4_to_line (nam_1, 13, int_1, 11,  1, ln);
    ta02name_int4_to_line (nam_2, 13, int_2, 11, 40, ln);
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02p4int4 (debug : tut_debug;
            nam   : tsp00_Sname;
            int_1 : tsp00_Int4;
            int_2 : tsp00_Int4;
            int_3 : tsp00_Int4;
            int_4 : tsp00_Int4);
 
VAR
      ln : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    ta02name_int4_to_line (nam, 13, int_1, 11,  1, ln);
    g17int4to_line (int_2, false, 11, 29, ln);
    g17int4to_line (int_3, false, 11, 42, ln);
    g17int4to_line (int_4, false, 11, 55, ln);
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02readint (VAR int : integer; VAR pfkey : tut_pfkey);
 
VAR
      ln_len    : integer;
      intlength : integer;
      i         : integer;
      pos       : integer;
      startpos  : integer;
      factor    : tsp00_Int4;
      ln        : tsp00_Line;
 
BEGIN
pfkey := pf_none;
int   := 0;
t03get (ln, pfkey);
IF  pfkey = pf_none
THEN
    BEGIN
    ln_len    := s30lnr (ln, ' ', 1, sizeof (ln));
    intlength := 0;
    startpos  := 1;
    WHILE (startpos < ln_len - 1) AND (ln [startpos] = ' ') DO
        startpos := startpos + 1;
    (*ENDWHILE*) 
    IF  ln [startpos] = '-'
    THEN
        pos := startpos + 1
    ELSE
        pos := startpos;
    (*ENDIF*) 
    WHILE (pos <= ln_len) AND
          (ln [pos] >= '0') AND (ln [pos] <= '9') DO
        BEGIN
        intlength := intlength + 1;
        pos := pos + 1
        END;
    (*ENDWHILE*) 
    IF  (intlength = 0) OR (intlength > 5) OR (ln [pos] <> ' ')
    THEN
        pfkey := pf_end
    ELSE
        BEGIN
        pos    := pos - 1;
        int    := 0;
        factor := 1;
        i := 1;
        WHILE i <= intlength DO
            BEGIN
            int    := int + factor * (ord (ln [pos]) - ord ('0'));
            pos    := pos - 1;
            factor := factor * 10;
            i := succ(i)
            END;
        (*ENDWHILE*) 
        IF  int > MAX_INT2_SP00
        THEN
            pfkey := pf_end
        ELSE
            IF  ln [startpos] = '-'
            THEN
                int := - int
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  pfkey = pf_none
    THEN
        t02int4 (debug_always, 'input       ', int)
    ELSE
        t03put20 ('INVALID INTEGER !   ', cut_protected)
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02sinit;
 
VAR
      dummy_pf : tut_pfkey;
      i        : integer;
 
BEGIN
td.minbuf    := false;
td.maxlength := MOVEOBJ_MXSP00;
td.debugging := [ ];
i := 1;
WHILE i <= LINE_MXSP00 DO
    BEGIN
    td.blankline [i] := ' ';
    i := succ(i)
    END;
(*ENDWHILE*) 
ta02set_trace_test (true, dummy_pf);
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02sname (debug : tut_debug; nam : tsp00_Sname);
 
VAR
      i  : integer;
      ln : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    i := 1;
    WHILE i <= sizeof (nam) DO
        BEGIN
        IF  g17printable_char (nam [i])
        THEN
            ln [i] := nam [i]
        ELSE
            ln [i] := '.';
        (*ENDIF*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02stackentry (debug : tut_debug;
            VAR st         : tgg00_StackEntry;
            entry_index    : integer);
 
VAR
      is_second_ln : boolean;
      ln           : tsp00_Line;
      second_ln    : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    g17onestackentry (st, entry_index, ln, is_second_ln, second_ln);
    ta02write_line (ln);
    IF  is_second_ln
    THEN
        ta02write_line (second_ln)
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02str30 (debug : tut_debug; str30 : tsp00_C30);
 
VAR
      i  : integer;
      ln : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    i := 1;
    WHILE i <= sizeof (str30) DO
        BEGIN
        IF  g17printable_char (str30 [i])
        THEN
            ln [i] := str30 [i]
        ELSE
            ln [i] := '.';
        (*ENDIF*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02switch (VAR pfkey : tut_pfkey);
 
BEGIN
pfkey := pf_none;
ta02set_trace_test (false, pfkey)
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02tabid (debug : tut_debug;
            nam       : tsp00_Sname;
            VAR tabid : tgg00_Surrogate);
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    ta02surrogate (nam, tabid)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      t02trace (debug : tut_debug) : boolean;
 
BEGIN
t02trace := (debug = debug_always) OR
      (td.debug_or_trace AND (debug in td.debugging))
END;
 
(*------------------------------*) 
 
PROCEDURE
      t02vffn (debug : tut_debug;
            nam      : tsp00_Sname;
            fn       : tsp00_VFilename);
 
VAR
      i      : integer;
      ln_len : integer;
      ln     : tsp00_Line;
 
BEGIN
IF  (debug = debug_always) OR
    (td.debug_or_trace AND (debug in td.debugging))
THEN
    BEGIN
    ln := td.blankline;
    s10mv (sizeof(nam), sizeof(ln), @nam, 1, @ln, 1, sizeof(nam));
    ln_len      := sizeof (nam) + 2;
    ln [ln_len] := ':';
    ln_len      := ln_len + 1;
    i := 1;
    WHILE i <= sizeof (fn) DO
        BEGIN
        IF  g17printable_char (fn [i])
        THEN
            ln [ln_len + i] := fn [i]
        ELSE
            ln [ln_len + i] := '.';
        (*ENDIF*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    ta02write_line (ln)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02get_trace_test (trace_wanted : boolean;
            VAR txt   : tsp00_C20;
            VAR pfkey : tut_pfkey);
 
VAR
      i  : integer;
      ln : tsp00_Line;
 
BEGIN
pfkey := pf_none;
IF  trace_wanted
THEN
    t03put20 (msg_trace_layer, cut_bright_protected)
ELSE
    t03put30 (msg_debug_help, cut_bright_protected);
(*ENDIF*) 
t03get (ln, pfkey);
IF  pfkey = pf_none
THEN
    BEGIN
    i := 1;
    WHILE i <= 20 DO
        BEGIN
        IF  ln [i] in ['a'..'i', 'j'..'r', 's'..'z']
        THEN
            txt [i] := chr(ord(ln[i]) + ord ('A') - ord ('a'))
        ELSE
            txt [i] := ln [i];
        (*ENDIF*) 
        i := succ(i)
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02helptest;
 
BEGIN
t03newscreen_page;
t03put60('COMMAND INTERFACE: TA                                       ',
      cut_protected);
t03put60('UTILITY          : UT                                       ',
      cut_protected);
t03put60('DIAGNOSE / AUDIT : XT                                       ',
      cut_protected)
END;
 
(*------------------------------*) 
 
FUNCTION
      ta02label_in_str (lab : tsp00_C2; str : tsp00_C20) : boolean;
 
VAR
      found : boolean;
      i     : integer;
 
BEGIN
found := false;
i     := 1;
REPEAT
    IF  (lab [1] = str [i]) AND (lab [2] = str [i+1])
    THEN
        found := true
    ELSE
        i := i + 1
    (*ENDIF*) 
UNTIL
    found OR (i > 19);
(*ENDREPEAT*) 
ta02label_in_str := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02name_int4_to_line (n : tsp00_Sname;
            n_len   : integer;
            int     : tsp00_Int4;
            int_len : integer;
            ln_pos  : integer;
            VAR ln  : tsp00_Line);
 
CONST
      c_nil_page_no = MAX_INT4_SP00;
 
VAR
      len       : integer;
      n_nil_pno : tsp00_Sname;
 
BEGIN
IF  n_len > SNAME_MXSP00
THEN
    len := SNAME_MXSP00
ELSE
    len := n_len;
(*ENDIF*) 
s10mv (sizeof (n), sizeof (ln), @n, 1, @ln, ln_pos, len);
ln [ln_pos + n_len] := ':';
IF  (int = c_nil_page_no) AND (int_len >= 7)
THEN
    BEGIN
    n_nil_pno := 'NIL PNO     ';
    s10mv (sizeof (n_nil_pno), sizeof (ln), @n_nil_pno, 1,
          @ln, ln_pos + n_len + 2, 7)
    END
ELSE
    g17int4to_line (int, false, int_len, ln_pos + n_len + 1, ln)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02put_prot_str20 (str20 : tsp00_C20);
 
VAR
      err : integer;
      ln  : tsp00_Line;
 
BEGIN
ln := td.blankline;
s10mv (sizeof (str20), sizeof (ln), @str20, 1,
      @ln, 1, sizeof (str20));
t03write_prot (ln, sizeof (str20), err)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02set_trace_test (default_tt : boolean;
            VAR pfkey : tut_pfkey);
 
VAR
      s20  : tsp00_C20;
      i    : integer;
      help : boolean;
 
BEGIN
td.on_text  := '                ';
td.off_text := '                ';
td.on_count := 0;
IF  default_tt
THEN
    s20 := bsp_c20
ELSE
    BEGIN
    ta02get_trace_test (true, s20, pfkey);
    ta02put_prot_str20 (s20)
    END;
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    td.trace_ta   := ta02label_in_str ('TA', s20);
    td.trace_ut   := ta02label_in_str ('UT', s20);
    td.trace_xt   := ta02label_in_str ('XT', s20);
    td.last_layer := 'T';
    IF  default_tt
    THEN
        s20 := bsp_c20
    ELSE
        BEGIN
        REPEAT
            ta02get_trace_test (false, s20, pfkey);
            help := (pfkey = pf_help);
            IF  NOT (pfkey in [pf_cancel, pf_end])
            THEN
                BEGIN
                IF  pfkey = pf_help
                THEN
                    help := true
                ELSE
                    BEGIN
                    i := 1;
                    WHILE i <= 20 DO
                        BEGIN
                        IF  s20 [i] = '?'
                        THEN
                            help := true;
                        (*ENDIF*) 
                        i := succ(i)
                        END
                    (*ENDWHILE*) 
                    END;
                (*ENDIF*) 
                IF  help
                THEN
                    ta02helptest;
                (*ENDIF*) 
                END
            (*ENDIF*) 
        UNTIL
            NOT help;
        (*ENDREPEAT*) 
        IF  NOT default_tt AND (pfkey = pf_none)
        THEN
            ta02put_prot_str20 (s20)
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    ta02test_set (s20);
    td.debug_or_trace := ((td.debugging <> [ ])
          OR td.trace_ta OR td.trace_ut OR td.trace_xt)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02surrogate (nam : tsp00_Sname;
            VAR tabid    : tgg00_Surrogate);
 
VAR
      i      : integer;
      ln_len : integer;
      ln     : tsp00_Line;
 
BEGIN
ln := td.blankline;
s10mv (sizeof(nam), sizeof(ln), @nam, 1, @ln, 1, sizeof(nam));
ln_len      := sizeof (nam) + 2;
ln [ln_len] := ':';
ln_len      := ln_len + 1;
i := 1;
WHILE i <= sizeof(tabid) DO
    BEGIN
    g17hexto_line (tabid [i], ln_len, ln);
    IF  i = sizeof (tgg00_ServerdbNo)
    THEN
        ln_len := ln_len + 1;
    (*ENDIF*) 
    i := succ(i)
    END;
(*ENDWHILE*) 
ta02write_line (ln)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02test_set (VAR s20 : tsp00_C20);
 
BEGIN
td.debugging := [ ];
IF  ta02label_in_str ('TA', s20)
THEN
    td.debugging := td.debugging + [debug_ta];
(*ENDIF*) 
IF  ta02label_in_str ('UT', s20)
THEN
    td.debugging := td.debugging + [debug_ut];
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02write (VAR ln : tsp00_Line; ln_len : integer);
 
VAR
      err : integer;
 
BEGIN
t03write_prot (ln, ln_len, err)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta02write_line (VAR ln : tsp00_Line);
 
VAR
      err : integer;
 
BEGIN
t03write_prot (ln, s30lnr (ln, ' ', 1, sizeof (ln)), err)
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
