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.

No comments:

Post a Comment