Showing posts with label HP Pascal. Show all posts
Showing posts with label HP Pascal. Show all posts

2015/03/23

Tracing using SDA

The problem

About one or two weeks ago, I needed to find a problem in virtual memory allocation/de-allocation, since a process was running out of virtual memory. In our system we already had some tracing in a library in place, using conditional compilation. However, when building the entire system the trace just gave too much data.

The solution

I stumbled upon an article at http://labs.hoffmanlabs.com about the C-macro tr_print. That was just what I was looking for.

The definition of the macro can be found by issueing the following command

$ libr/text sys$library:sys$lib_c.tlb /extract=vms_macros /output=tt:

Note: I used output to tt:, which is effectively my terminal, so I do not extract to a file, but straight to the screen. The last part of the file shows the definition of C-macro tr_print, which was the only thing I was interested in.

Since we code in HP Pascal, at first I tried to write code like is included in the tr_print macro, but that did not quite work out. Some issues with parameter passing, I guess. Not spending too much time on getting it to work, I decided to create a small C file with a function taking only one string parameter, and to call the C function from a Pascal module.

The source code

The created C file looks like this (stripped from all mandatory style elements):

writetrc_c.c

#include <vms_macros.h>
#include <stdlib.h>

void _write_trc_c( const char *trace_string )
{

    /* NOTE: THE DOUBLE PARENTHESES ARE REQUIRED IN THIS MACRO BY DESIGN */

    tr_print(( trace_string ));

}

and the pascal module looks like this:

writetrc.pas

[
    ENVIRONMENT
    (
        'writetrc.pen'
    )
]

MODULE writetrc;

[GLOBAL,ASYNCHRONOUS]
PROCEDURE write_trc(
    p_trace_string : VARYING [$m1] OF CHAR
);

{----- External Routine Declarations ------}

[EXTERNAL]
PROCEDURE _write_trc_c(
    p_trace_str : [IMMEDIATE] C_STR_T
); EXTERNAL;

{---------- Variable Declarations ---------}
VAR
    lv_trace_string     : [VOLATILE] STRING($m1 + 1); 
                          { volatile to get rid of compiler warning }
    lv_trace_str_ptr    : C_STR_T := NIL;

BEGIN

    { Calling a C routine, so zero terminated string required }

    lv_trace_string := p_trace_string + CHR(0);
    lv_trace_str_ptr := C_STR( lv_trace_string );

    { C-function checks if the trace is activated   }
    { If not, it immediately returns                }

    _write_trc_c( lv_trace_str_ptr );

END; { of PROCEDURE write_trc }

END.

Compilation

Compilation of the C source is done as follows:

$ define DECC$TEXT_LIBRARY SYS$LIBRARY:SYS$LIB_C.TLB
$ cc writetrc_c.c /debug /noopt

Logical DECC$TEXT_LIBRARY needs to be set to let the C compiler find vms_macros.h.
Compilation of the Pascal source is done as follows:

$ pas writetrc /debug /noopt

Note: for development and test, we standard compile with /debug /noopt

Linking

When linking a program that uses the functions above, you must include /SYSEXE. The link command will then look like:

$ link example writetrc.opt/opt /sysexe

Where the file writetrc.opt contains the following 2 lines:

writetrc_c.obj
writetrc.obj

Example program

Just to demonstrate, here is a small example program, that writes "Hello, World! 2015" to screen and in the trace buffer.

[
    INHERIT
    (
        'writetrc.pen'
    )
]
PROGRAM example( INPUT, OUTPUT );

VAR
    i : INTEGER;
    s : STRING(40);
BEGIN
    i := 2015;
    s := 'Hello, World!';
    writetrc( s + DEC(i) );
    WRITELN( s, ' ', i );
END.

Compile as usual and link as described earlier.

Running the example

Open a second terminal to start SDA with the correct privileges. You need at least privilege ALTPRI to start the trace, and another privilege to increase the buffer size. Since I don't know yet which one, I use priv=all for now.

$ set proc /priv=all
$ analyze/system
SDA> TR LOAD
SDA> TR START TRACE ! optionally with /BUFFER=<nr of pages>
SDA>

Go back to the other terminal and run the example:

$ run example
Hello, World! 2015
$

Go back to the system analyzer session.

SDA> TR STOP TRACE
SDA> TR SHOW TRACE

You should get a screen with a header, and one trace line with timestamp and text "Hello, World!  00002015"  (slightly different formatted than the output of the WRITELN statement).

Finally, exit the system analyzer with:

SDA> TR UNLOAD
SDA> EXIT

That's all, folks!

2012/11/30

Playing with descriptors in HP Pascal

Some times you want to have the possibility to pass multiple parameters of the same type to a function or procedure. HP Pascal makes this possible by using the [LIST] attribute. For more information on the attribute [LIST] and the ARGUMENTand ARGUMENT_LIST_LENGTHpredeclared routines, see the HP Pascal for OpenVMS - Language Reference Manual.

The problem I faced was that I wanted to use STRING parameters. This only works when you define a type based on STRING, e.g.
TYPE
    t_string_20 : STRING(20);
When you do so, and define a procedure like this:
PROCEDURE p( p_text : [LIST] t_string_20 );
then you can only pass parameters that have been declared using t_string_20. Of course that was not what I wanted.

After playing around with this problem for a while, I came up with the following solution. If the procedure is declared as external, then the parameters are passed using descriptors. It is possible to specify STRING instead of t_string_20 in the declaration. The external definition for the procedure p mentioned above will be:
[EXTERNAL]
PROCEDURE p( p_text : [LIST] STRING ); EXTERNAL;
Now all that is left, is accessing the parameters within the actual procedure using the descriptors. This can be done in a hidden procedure definition, like this:
[HIDDEN]
PROCEDURE p_hidden( p_text : [LIST] DSC1$TYPE );
BEGIN
    { some code }
END;
The type DSC1$TYPE is defined in the environment file SYS$LIBRARY:STARLET.PEN (source: SYS$LIBRARY:STARLET.PAS) as follows:
DSC1$TYPE = RECORD
    DSC$W_MAXSTRLEN : $UWORD;
    DSC$B_DTYPE : $UBYTE;
    DSC$B_CLASS : $UBYTE;
    DSC$A_POINTER : UNSIGNED;
END;
To use it you have to add the environment file in the [INHERIT] attribute (again, for more info, see the language reference manual mentioned above):
[INHERIT ( 'SYS$LIBRARY:STARLET')]
Of course, now the hidden procedure p_hidden is not yet linked to the external define procedure p. This can be done by telling the compiler that the procedure p_hidden should be known to the outside world as procedure p. For this we can use the [GLOBAL] attribute. The procedure p_hidden now looks like this:
[HIDDEN,GLOBAL(p)]
PROCEDURE p_hidden( p_text : [LIST] DSC1$TYPE );
BEGIN
    { some code }
END;
In the implementation of procedure p_hidden, the parameters can be accessed using the predeclared ARGUMENT and the list length can be determined with ARGUMENT_LIST_LENGTH.
[HIDDEN,GLOBAL(p)]
PROCEDURE p_hidden( p_text : [LIST] DSC1$TYPE );
VAR
    d : DSC1$TYPE;
     i : INTEGER;
BEGIN
    FOR i := 1 TO ARGUMENT_LIST_LENGTH( p_text ) DO
    BEGIN
        d := ARGUMENT( p_text, i );
    END;
END;
Now the descriptor can be accessed. Since I work with STRING parameters, I only want to allow descriptor type DSC$K_DTYPE_VT and descriptor class DSC$K_CLASS_VS (both defined in SYS$LIBRARY:STARLET.PAS). So I can check those after fetching the parameter.
d := ARGUMENT( p_text, i );
IF ( d.DSC$B_DTYPE = DSC$K_DTYPE_VT )
    AND
    ( d.DSC$B_CLASS = DSC$K_CLASS_VS )
THEN BEGIN
    { do something with the parameter }
END;
To actually do something with the actual string data pointed to by the DSC$A_POINTER field, you need to do something smart, like type casting. A STRING in HP Pascal has a maximum length of 65535, and is compatible with VARYING OF CHAR. Since I had some trouble with typecasting with a STRING variable, I defined a type t_varying_max and a pointer t_varying_max_ptr to access the actual string data in the descriptor.
TYPE
    t_varying_max = VARYING [ 65535 ] OF CHAR;
    t_varying_max_ptr = ^t_varying_max;
VAR
    long_string_ptr : t_varying_max_ptr;
    work_buffer : t_varying_max;
The type t_varying_max_ptr can now be used to copy the parameter in a local buffer:
long_string_ptr := d.DSC$A_POINTER::t_varying_max_ptr;
work_buffer := long_string_ptr^;
Finally, the procedure could look like this:
[HIDDEN,GLOBAL(p)]
PROCEDURE p_hidden( p_text : [LIST] DSC1$TYPE );
TYPE
    t_varying_max = VARYING [ 65535 ] OF CHAR;
    t_varying_max_ptr = ^t_varying_max;
VAR
    long_string_ptr : t_varying_max_ptr;
    work_buffer : t_varying_max;
    d : DSC1$TYPE;
     i : INTEGER;
BEGIN
    FOR i := 1 TO ARGUMENT_LIST_LENGTH( p_text ) DO
    BEGIN
        d := ARGUMENT( p_text, i );
        IF ( d.DSC$B_DTYPE = DSC$K_DTYPE_VT )
            AND
            ( d.DSC$B_CLASS = DSC$K_CLASS_VS )
        THEN BEGIN
            long_string_ptr :=
                d.DSC$A_POINTER::t_varying_max_ptr;
            work_buffer := long_string_ptr^;
            WRITELN( work_buffer );
        END;
    END;
END;
The nice thing about this is that it also works with VAR parameters, so it is also possible to output strings this way. If a string passed as VAR parameter is not large enough, it is possible to check first if the data supposed to be written to it will fit in the parameter using the DSC$W_MAXSTRLEN field of the parameter.

I succesfully implemented split and join functions this way.