Conference turris::pascal

2664.0. "Pascal V5.5 ACCVIO with SUBSTR() function" by CSC32::D_SANFORD () Tue Mar 18 1997 12:55

    Pascal V5.5-52, OpenVMS Alpha V6.2, V7.1 - ACCVIO with SUBSTR()
    Pascal V5.4, OpenVMS Alpha V6.2 ok
    Pascal V5.4-41, OpenVMS VAX V6.0 ok

    SUBSTR() fails with an ACCVIO after upgrading to Pascal V5.5-52 on OpenVMS
    Alpha.

    Included below is a command file to duplicate the problem along with
    notes from the customer.

    Regards, Drew Sanford
    Customer Support Center
    C970225-6728

$ !
$ ! We have just switched from Pascal V5.3-35 (on an Alpha 3000/400,
$ ! running OpenVMS V6.2) to Pascal V5.5-55 (on an Alphastation 255/233,
$ ! running OpenVMS V7.1).  (We had the same problem when we tried
$ ! Pascal V5.5 on the older Alpha and OpenVMS V6.2.)
$ !
$ ! I'm including a reproducer at the end of this message.  It
$ ! comprises two source files, A.FOR and B.PAS.  The call tree is:
$ ! 
$ ! A (Fortran)
$ ! |
$ ! |--hlk$new_protect_rest (Pascal) (externally called protectrest)
$ !     |
$ !     |--hlk$protect_dataset (Fortran)
$ !
$ ! The Pascal function's arguments are all character strings, but it
$ ! is designed to handle a variable number of actual arguments.  For
$ ! that reason, each formal argument is defined as a somewhat
$ ! generic character string descriptor (with an array of length
$ ! 65535 to cover all possible actual strings).  The intention is
$ ! that we will use the length of each actual parameter to copy the
$ ! actual string to a fixed-length string inside the function.
$ !
$ ! Historically, this worked fine.  With Pascal 5.5, however, there
$ ! is an accvio when processing the following statement, which
$ ! copies the actual argument to the fixed-length string.
$ !
$ !        ustatus := str$trim (
$ !            d_name ,
$ !            substr( dataset.strptr^, 1, dataset.length ) ,
$ !            d_len
$ !            ) ;
$ !
$ ! I found that the accvio is due to the program trying to copy 65535
$ ! characters from the actual argument to someplace else, probably a
$ ! temporary location on the stack.  I believe it is doing it as
$ ! part of the substr function.  In Pascal 5.3, it simply copied
$ ! either the size of the substring or the size of the destination
$ ! string.  (I'm not sure which and can test it if you need me to.)
$ !
$ ! My main question is whether there is some other idiom we should
$ ! be using to provide the functionality of the CHARACTER*(*) type
$ ! declaration in Fortran and the ability to have some formal
$ ! arguments that have no corresponding actual arguments.  I believe
$ ! I could write my own loop to copy the first n characters from
$ ! each passed string to each destination string, but that could be
$ ! many places in our code and I'd like to avoid doing that, if
$ ! possible.
$ !
$ create call-pascal.for
        PROGRAM A

        IMPLICIT NONE

        INTEGER*4       PROTECTREST

        INTEGER*4       STATUS

        STATUS = PROTECTREST ( 'RESTNAME', 'APPNAME',
     1                         'FAMILY', 'NOWAIT' )

        PRINT *, 'Status = ', STATUS

        END

        INTEGER*4 FUNCTION HLK$PROTECT_DATASET ( FAMILY,
     1                                           APPLICATION,
     1                                           DATASET )

        IMPLICIT NONE

        CHARACTER*(*) FAMILY
        CHARACTER*(*) APPLICATION
        CHARACTER*(*) DATASET

        PRINT *, 'Family: ', FAMILY, '  Application: ',
     1           APPLICATION, '  Dataset: ', DATASET

        HLK$PROTECT_DATASET = 1

        RETURN

        END
$ create test.pas
[INHERIT(   'sys$library:pascal$lib_routines',
            'sys$library:pascal$str_routines' )]
MODULE b (input, output);

CONST
    maxint_uword = 65535 ;

TYPE
    uword	= [WORD(1)] 0..65535 ;
    ubyte	= [BYTE(1)] 0..255 ;
    string$max	= packed array [ 1..maxint_uword ] of char ;
    string$ptr	= ^string$max ;

    string$descr =
	[QUAD(1)] RECORD
	    length  : [POS(0)]  uword;
	    dtype   : [POS(16)] ubyte;
	    class   : [POS(24)] ubyte;
	    strptr  : [POS(32)] string$ptr
	    END;

VAR

    str$_tru	    : [VALUE, EXTERNAL] UNSIGNED ;



[ EXTERNAL, UNBOUND ] function hlk$protect_dataset (
       family      : [ class_s ] packed array [ l1..u1 : integer ] of char ;
       application : [ class_s ] packed array [ l2..u2 : integer ] of char ;
       dataset     : [ class_s ] packed array [ l3..u3 : integer ] of char
   ) : unsigned ; EXTERNAL;



[GLOBAL(protectrest), UNBOUND]
FUNCTION hlk$new_protect_rest
    (VAR dataset	: [READONLY, TRUNCATE, UNSAFE] string$descr;
     VAR application	: [READONLY, TRUNCATE, UNSAFE] string$descr;
     VAR family		: [READONLY, TRUNCATE, UNSAFE] string$descr;
     VAR waitmode	: [READONLY, TRUNCATE, UNSAFE] string$descr)
    :UNSIGNED;

    {
    FUNCTIONAL DESCRIPTION:

	    This function is designed solely for the support of
	    existing FORTRAN and MACRO programs which rely upon
	    the use of 'optional' arguments that may place a 0
	    into the argument list.

    FORMAL PARAMETERS:

	    dataset	    : fixed-length string, input.
			      The dataset to be protected.

	    application	    : fixed-length string, input.
			      The application context of the dataset.

	    family	    : fixed-length string, input.
			      The family context of the dataset.

	    waitmode	    : fixed-length string, input.
			      Indicates whether the caller wants to
			      wait until the request can be granted.
			      Supported values are: 'WAIT' and 'NOWAIT'.

    ROUTINE VALUE:

	    Returns an unsigned integer indicating the overall completion
	    status of the request.

    SIDE EFFECTS:

	    Any unexpected errors are signaled immediately.
    }

    var
	d_name : packed array [ 1..40 ] of char ;
	a_name : packed array [ 1..8 ] of char ;
	f_name : packed array [ 1..8 ] of char ;
	w_mode : packed array [ 1..6 ] of char ;
	d_len, a_len, f_len, w_len : uword ;
	ustatus : unsigned ;

    begin
    ESTABLISH( lib$sig_to_stop );

    d_name := ' ' ;
    d_len  := 1 ;
    if present( dataset )
    then
	begin
	if iaddress( dataset ) <> 0
	then
	    begin
	    ustatus := str$trim (
		d_name ,
		substr( dataset.strptr^, 1, dataset.length ) ,
		d_len
		) ;
	    if not odd(ustatus)
	    then
		begin
		if ustatus = str$_tru
		then
		    lib$signal( 2 )
		else
		    lib$signal( ustatus ) ;
		end ;
	    end ;
	end ;

    a_name := ' ' ;
    a_len := 1 ;
    if present( application )
    then
	begin
	if iaddress( application ) <> 0
	then
	    begin
	    ustatus := str$trim (
		a_name ,
		substr( application.strptr^, 1, application.length ) ,
		a_len
		) ;
	    if not odd(ustatus)
	    then
		begin
		if ustatus = str$_tru
		then
		    lib$signal( 3 )
		else
		    lib$signal( ustatus ) ;
		end ;
	    end ;
	end ;

    f_name := ' ' ;
    f_len := 1 ;
    if present( family )
    then
	begin
	if iaddress( family ) <> 0
	then
	    begin
	    ustatus := str$trim (
		f_name ,
		substr( family.strptr^, 1, family.length ) ,
		f_len
		) ;
	    if not odd(ustatus)
	    then
		begin
		if ustatus = str$_tru
		then
		    lib$signal( 4 )
		else
		    lib$signal( ustatus ) ;
		end ;
	    end ;
	end ;

    w_mode := 'NOWAIT' ;
    w_len := 6 ;
    if present( waitmode )
    then
	begin
	if iaddress( waitmode ) <> 0
	then
	    begin
	    ustatus := str$trim (
		w_mode ,
		substr( waitmode.strptr^, 1, waitmode.length ) ,
		w_len
		) ;
	    if not odd(ustatus)
	    then
		begin
		if ustatus = str$_tru
		then
		    lib$signal( 5 )
		else
		    lib$signal( ustatus ) ;
		end ;
	    end ;
	end ;

    hlk$new_protect_rest := hlk$protect_dataset (
	dataset     := substr( d_name, 1, d_len ),
	application := substr( a_name, 1, a_len ),
	family      := substr( f_name, 1, f_len )
	) ;

    REVERT;
    end ;

end { module } .
$ !
$ fortran call-pascal
$ pascal test
$ link call-pascal,test
$ run call-pascal

    I'm moving this to CLT::DEC_PASCAL_BUGS so I can track it.
    
    				-John