Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-1/language-sources/blissnet-descriptor.req
There are 15 other files named blissnet-descriptor.req in the archive. Click here to see a list.
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
! OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
! COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION 1985.
! ALL RIGHTS RESERVED.

! These macros are used to declare and initialize binary data descriptors.
! The standard XPORT macros, $XPO_DESCRIPTOR and $XPO_DESC_INIT, are
! unsuitable because they allocate one byte per addressable unit;
! rather useless on 36-bit machines.  These macros are essentially
! duplicates of the corresponding XPORT macros except that they
! accept only the BYTES allocation parameter, and initialize
! XPO$A_ADDRESS to a character pointer (8-bit-byte pointer)
! instead of an address.
!
%IF %BLISS(BLISS36)                ! Only do this for 36-bit machines
%THEN

KEYWORDMACRO
    $XPN_DESCRIPTOR(
	class=FIXED,					! descriptor class
	binary_data					! binary data descriptor
	) =

	%IF NOT $xpo$key_test( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED), 'CLASS=' )
	%THEN
	    %EXITMACRO
	%FI

	%IF NOT %NULL(binary_data) AND NOT $xpo$paren_test(binary_data)
	%THEN
	    %WARN( 'BINARY_DATA=descriptor is not permitted' )
	    %EXITMACRO
	%FI

	%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
	%THEN
	    BLOCK[XPO$K_B_BLN]  FIELD( %EXPAND $xpo$b_fields )
	%ELSE
	    BLOCK[XPO$K_S_BLN]  FIELD( %EXPAND $xpo$f_fields )
	%FI

	%IF NOT %NULL(binary_data)
	%THEN
	    PRESET( [XPO$B_DTYPE] = XPO$K_DTYPE_BU,
		    [XPO$B_CLASS] = %EXPAND $xpo$desc_class(class),
		    [XPO$A_ADDRESS] = CH$PTR ($xpo$arg2( %REMOVE(binary_data) ),0,8),
	    %IF %IDENTICAL(class,FIXED) OR %IDENTICAL(class,DYNAMIC)
	    %THEN
		    [XPO$H_LENGTH] = $xpn$$bin_len( %REMOVE(binary_data) )
	    %ELSE
		    [XPO$H_MAXLEN] = $xpn$$bin_len( %REMOVE(binary_data) )
	    %FI
	    )						! End of BINARY_DATA PRESET list
	%FI %,

    $XPN_DESC_INIT(
	desc,						! address of descriptor
	descriptor,					! address of descriptor
	class=FIXED,					! descriptor class
	binary_data					! binary data descriptor
	) =

	%IF NOT $xpo$key_test( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED), 'CLASS=' )
	%THEN
	    %EXITMACRO
	%FI

	%IF NOT %NULL(binary_data) AND NOT $xpo$paren_test(binary_data)
	%THEN
	    %WARN( 'BINARY_DATA=descriptor is not permitted' )
	    %EXITMACRO
	%FI

	%IF $xpo$conflict( desc, descriptor )
	%THEN
	    %WARN( 'DESC= and DESCRIPTOR= are mutually exclusive' )
	%FI

	%EXPAND $xpo$required( desc descriptor, 'DESC= or DESCRIPTOR=' )

	BEGIN
	BIND $xpo$desc = descriptor :  %EXPAND $xpo$force( $XPN_DESCRIPTOR( %QUOTE CLASS=BOUNDED ) );

	%IF %NULL( binary_data )
	%THEN
	    $xpo$desc[XPO$H_LENGTH] = 0;
	    $xpo$desc[XPO$B_DTYPE] = XPO$K_DTYPE_BU;
	    $xpo$desc[XPO$B_CLASS] = $xpo$desc_class( class );
	    $xpo$desc[XPO$A_ADDRESS] = 0;
	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
	    %THEN
		$xpo$desc[XPO$H_MAXLEN] = 0;
		$xpo$desc[XPO$H_PFXLEN] = 0;
	    %FI
	%ELSE
	    $xpn$$bin_desc( $xpo$desc, class, binary_data )
	%FI

	XPO$_NORMAL					! normal completion code
	END %;


MACRO
    $xpn$$bin_desc( desc, class, data_desc ) [] =

	%IF NOT %NULL( $xpo$arg3( %REMOVE(data_desc) ) )
	%THEN
	    %IF NOT $xpo$key_test( $xpo$arg3( %REMOVE(data_desc) ), (BYTES) )
	    %THEN
		%EXITMACRO
	    %FI
	%FI

	%IF NOT $xpo$paren_test( data_desc )
	%THEN
	    BEGIN
	    BIND $bin$$desc = data_desc :  %EXPAND $xpo$force( $XPN_DESCRIPTOR() );
		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
		%THEN
		    desc[XPO$H_LENGTH] = 0;
		%ELSE
		    desc[XPO$H_LENGTH] = .$bin$$desc[XPO$H_LENGTH];
		%FI
	    desc[XPO$B_DTYPE] = .$bin$$desc[XPO$B_DTYPE];
	    desc[XPO$B_CLASS] = %EXPAND $xpo$desc_class( class );
	    desc[XPO$A_ADDRESS] = .$bin$$desc[XPO$A_ADDRESS];
		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
		%THEN
		    desc[XPO$H_MAXLEN] =.$bin$$desc[XPO$H_LENGTH];
		    desc[XPO$H_PFXLEN] = 0;
		%FI
	    END;
	%ELSE
	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
	    %THEN
		desc[XPO$H_LENGTH] = 0;
	    %ELSE
		desc[XPO$H_LENGTH] = $xpn$$bin_len( %REMOVE(data_desc) );
	    %FI
	    desc[XPO$B_DTYPE] = XPO$K_DTYPE_BU;
	    desc[XPO$B_CLASS] = %EXPAND $xpo$desc_class( class );
            desc[XPO$A_ADDRESS] = CH$PTR ($xpo$arg2( %REMOVE(data_desc)), 0, 8 );
	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
	    %THEN
		desc[XPO$H_MAXLEN] = $xpn$$bin_len( %REMOVE(data_desc) );
		desc[XPO$H_PFXLEN] = 0;
	    %FI
	%FI %;

MACRO
    $xpn$$bin_len( length, address, keyword ) =
        %IF %NULL ( keyword )
        %THEN
            length
        %ELSE
            %IF %IDENTICAL( keyword, BYTES )
            %THEN
	        length
	    %ELSE
                %WARN ('$XPN_DESC_INIT called with allocation unit other than BYTES');
                %EXITMACRO
            %FI
        %FI %;

%ELSE  ! the following is for non-36 bit machines

MACRO $XPN_DESCRIPTOR=$XPO_DESCRIPTOR,
      $XPN_DESC_INIT=$XPO_DESC_INIT;

%FI    ! system-dependant portion