                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 1
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	      1 !
    0	      2 !			  COPYRIGHT (c) 1983, 1984 BY
    0	      3 !	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
    0	      4 !
    0	      5 ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
    0	      6 ! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
    0	      7 ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
    0	      8 ! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
    0	      9 ! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
    0	     10 ! TRANSFERRED.
    0	     11 !
    0	     12 ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
    0	     13 ! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
    0	     14 ! CORPORATION.
    0	     15 !
    0	     16 ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
    0	     17 ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
    0	     18 !
    0	     19 
    0	     20 !++
    0	     21 ! FACILITY:
    0	     22 !   XPORT - BLISS Transportability Support Package
    0	     23 !
    0	     24 ! ABSTRACT:
    0	     25 !   This REQUIRE file defines all XPORT user macros and symbols.
    0	     26 !
    0	     27 ! ENVIRONMENT:
    0	     28 !   User mode
    0	     29 !
    0	     30 ! AUTHOR: Ward Clark, CREATION DATE: 17-Mar-81
    0	     31 !
    0	     32 ! MODIFIED BY: Edward G. Freedman
    0	     33 !
    0	     34 ! REVISION HISTORY:
    0	     35 !
    0	     36 !	 3-Apr-84	LYS	Change $XPO_IDENT and XPO$K_LEVEL
    0	     37 !				for version 1.3.
    0	     38 !
    0	     39 !	10-May-84	LYS	Fixed $ALIGN macro so that it updates
    0	     40 !				$XPO_MAX_BIT and $XPO_MAX_FULLWD if
    0	     41 !				necessary.
    0	     42 !
    0	     43 ! END OF REVISION HISTORY
    0	     44 !--

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 2
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	     46 !
    0	     47 ! XPORT.REQ Version Identifiers
    0	     48 !
    0	     49 ! This macro should be updated with every change to XPORT.REQ.
    0	     50 ! See the corresponding macro in XPOSYS.REQ ($XPO$SYS_IDENT) for
    0	     51 ! the definition of the format.
    0	     52 !
    0	     53 
    0	     54 MACRO
    0	     55     $XPO_IDENT = 'V1.3-51' %;	! Update this with every change to XPORT.REQ
    0	     56 
    0	     57 LITERAL
    0	     58     XPO$K_VERSION = 1,					! Current XPORT version
    0	     59     XPO$K_LEVEL = 3;					!    and level
    0	     60 
    0	     61 !
    0	     62 ! XPORT Control Block and Macro Definitions
    0	     63 !
    0	     64 
    0	     65 LITERAL
    0	     66     XPO$K_FAILURE =					! Standard XPORT failure routine value
    0	     67 	%BLISS16( %X'FFFF' )
    0	     68 	%BLISS32( 0 )
    0	     69 	%BLISS36( %O'777777' );
    0	     70 
    0	     71 COMPILETIME
    0	     72     $xpo$temp = 0,					! Temporary variable
    0	     73     $xpo$temp1 = 0,
    0	     74     $xpo$temp2 = 0,
    0	     75     $xpo$key_ok = 0;
    0	     76 
    0	     77 MACRO
    0	     78     $XPO$FORCE [] =
M   0	     79 	%QUOTE %EXPAND %REMAINING %,
    0	     80 
    0	     81 
    0	     82     $XPO$REQUIRED( value, parameter_name ) =
M   0	     83 	%IF %NULL(value)
M   0	     84 	%THEN
M   0	     85 	    %WARN( parameter_name, ' parameter must be specified' )
M   0	     86 	    %QUOTE %QUOTE %EXITMACRO
M   0	     87 	%FI %,
    0	     88 
    0	     89 
    0	     90     $XPO$CONFLICT( list ) =
M   0	     91 	0 %QUOTE %EXPAND $xpo$$conflict(list,%REMAINING) GTR 1 %,
    0	     92 
    0	     93     $xpo$$conflict( list ) [] =
M   0	     94 	%IF NOT %NULL( %QUOTE %EXPAND %REMOVE(list) )
M   0	     95 	%THEN + 1
M   0	     96 	%FI
M   0	     97 	%QUOTE %EXPAND $xpo$$conflict( %REMAINING ) %,
    0	     98 
    0	     99 
    0	    100     $XPO$KEY_CHECK( value, keyword_list ) =
M   0	    101 	%ASSIGN( $xpo$key_ok, 0 )
M   0	    102 	$xpo$$key_test( value, %REMOVE(keyword_list) )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 3
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    103 	%NUMBER( $xpo$key_ok ) %,
    0	    104 
    0	    105 
    0	    106     $XPO$KEY_TEST( value, keyword_list, parameter_name ) =
M   0	    107 	%ASSIGN( $xpo$key_ok, 0 )
M   0	    108 	$xpo$$key_test( value, %REMOVE(keyword_list) )
M   0	    109 
M   0	    110 	%IF $xpo$key_ok
M   0	    111 	%THEN
M   0	    112 	    1
M   0	    113 	%ELSE
M   0	    114 	    %PRINT( '"', value, '" is an invalid ', parameter_name, ' parameter value' )
M   0	    115 	    %MESSAGE( '"', value, '" is an invalid ', parameter_name, ' parameter value' )
M   0	    116 	    %WARN(  '... possible values are ', $xpo$key_words( %REMOVE( keyword_list ) ) )
M   0	    117 	    0
M   0	    118 	%FI %,
    0	    119 
    0	    120 
    0	    121     $xpo$$key_test( value, keyword ) [] =
M   0	    122 
M   0	    123 	%IF %IDENTICAL(value,keyword)
M   0	    124 	%THEN
M   0	    125 	    %ASSIGN( $xpo$key_ok, 1 )
M   0	    126 	%ELSE
M   0	    127 	    $xpo$$key_test( value, %REMAINING )
M   0	    128 	%FI %,
    0	    129 
    0	    130 
    0	    131     $xpo$key_words[ keyword ] =
M   0	    132 	%IF %COUNT NEQ 0
M   0	    133 	%THEN
M   0	    134 	    ', ',
M   0	    135 	%FI
M   0	    136 	%STRING( keyword ) %,
    0	    137 
    0	    138 
    0	    139     $XPO$PAREN_TEST( parameter ) =
M   0	    140 	%IF %NULL(parameter)
M   0	    141 	%THEN
M   0	    142 	    0
M   0	    143 	%ELSE
M   0	    144 	    $xpo$$paren( %REMOVE(parameter), parameter )
M   0	    145 	%FI %,
    0	    146 
    0	    147     $xpo$$paren( no_parens, parens ) =
M   0	    148 	%IF %LENGTH EQL 2
M   0	    149 	%THEN
M   0	    150 	    %IF %IDENTICAL( no_parens, parens )
M   0	    151 	    %THEN
M   0	    152 		0
M   0	    153 		%EXITMACRO
M   0	    154 	    %FI
M   0	    155 	%FI
M   0	    156 	1 %,
    0	    157 
    0	    158 
    0	    159     $XPO$ARG1( arg1 ) =

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 4
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    160 	arg1 %,
    0	    161 
    0	    162 
    0	    163     $XPO$ARG2( arg1, arg2 ) =
M   0	    164 	arg2 %,
    0	    165 
    0	    166 
    0	    167     $XPO$ARG3( arg1, arg2, arg3 ) =
M   0	    168 	arg3 %,
    0	    169 
    0	    170 
    0	    171     $XPO$EX_ROUTINE( routine_name, linkage_attr ) =	! Declare an external routine
M   0	    172 	EXTERNAL ROUTINE routine_name :
M   0	    173 
M   0	    174 	%IF %NULL(linkage_attr)
M   0	    175 	%THEN
M   0	    176 	    %BLISS16(BLISS)  %BLISS32(BLISS)  %BLISS36(BLISS36C)
M   0	    177 	%ELSE
M   0	    178 	    linkage_attr
M   0	    179 	%FI
M   0	    180 
M   0	    181 	%BLISS32( ADDRESSING_MODE(LONG_RELATIVE) ) ;  %,
    0	    182 
    0	    183 
    0	    184     $XPO$EX_FAILURE( failure ) =
M   0	    185 	%IF $xpo$key_check( failure, (XPO$FAILURE, XPO$IO_FAILURE, XPO$PS_FAILURE, XPO$GM_FAILURE, XPO$FM_FAILURE,
M   0	    186 					STR$FAILURE, STR$X_FAILURE, STR$C_FAILURE, STR$A_FAILURE,
M   0	    187 					STR$S_FAILURE, STR$B_FAILURE) )
M   0	    188 	%THEN
M   0	    189 	    %QUOTE %EXPAND $xpo$force( $xpo$ex_routine( failure ) )
M   0	    190 	%FI %,
    0	    191 
    0	    192 
    0	    193     XPO$I_FAILURE =					! ***** OBSOLETE *****
M   0	    194 	%INFORM( 'XPO$I_FAILURE has been renamed to XPO$IO_FAILURE' )
M   0	    195 	XPO$IO_FAILURE %,
    0	    196 
    0	    197 
    0	    198     XPO$F_FAILURE =					! ***** OBSOLETE *****
M   0	    199 	%INFORM( 'XPO$F_FAILURE has been renamed to XPO$FM_FAILURE' )
M   0	    200 	XPO$FM_FAILURE %,
    0	    201 
    0	    202 
    0	    203     XPO$G_FAILURE =					! ***** OBSOLETE *****
M   0	    204 	%INFORM( 'XPO$G_FAILURE has been renamed to XPO$GM_FAILURE' )
M   0	    205 	XPO$GM_FAILURE %,
    0	    206 
    0	    207 
    0	    208     XPO$P_FAILURE =					! ***** OBSOLETE *****
M   0	    209 	%INFORM( 'XPO$P_FAILURE has been renamed to XPO$PM_FAILURE' )
M   0	    210 	XPO$PM_FAILURE %,
    0	    211 
    0	    212 
    0	    213     $XPO$DEFAULT( argument, default ) =
M   0	    214 	%IF %NULL(argument)
M   0	    215 	%THEN
M   0	    216 	    default

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 5
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    217 	%ELSE
M   0	    218 	    argument
M   0	    219 	%FI %,
    0	    220 
    0	    221 
    0	    222     $XPO$NAME15 [] =
M   0	    223 	%NAME( %EXACTSTRING( MIN(%CHARCOUNT(%STRING(%REMAINING)),15), 0, %REMAINING ) ) %,
    0	    224 
    0	    225 
    0	    226     $XPO$VALUE( block, field_name, value ) [] =
M   0	    227 	block[ $XPO$NAME15(block,field_name) ] = value ; %,
    0	    228 
    0	    229 
    0	    230     $XPO$KEY_NAME( block, keyword ) [] =
M   0	    231 	$XPO$NAME15(block,'K_',keyword) %,
    0	    232 
    0	    233 
    0	    234     $XPO$KEYWORD( block ) [ keyword ] =
M   0	    235 	%IF %NULL(keyword)
M   0	    236 	%THEN
M   0	    237 	    %WARN('Null keyword specified')
M   0	    238 	%ELSE
M   0	    239 	    block[ $XPO$NAME15(block,'V_',keyword) ] = 1 ;
M   0	    240 	%FI %,
    0	    241 
    0	    242 
    0	    243     $XPO$SHOW_NUMB( number, base ) [] =
M   0	    244 	%IF number GEQ base
M   0	    245 	%THEN
M   0	    246 	    %ASSIGN( $xpo$temp, number/base )
M   0	    247 	    $XPO$SHOW_NUMB( %NUMBER($xpo$temp), base )
M   0	    248 	%FI
M   0	    249 
M   0	    250 	%ASSIGN( $xpo$temp, number MOD base )
M   0	    251 	%IF $xpo$temp LEQ 9
M   0	    252 	%THEN
M   0	    253 	    %ASSIGN( $xpo$temp, %C'0' + $xpo$temp )
M   0	    254 	%ELSE
M   0	    255 	    %ASSIGN( $xpo$temp, %C'A' + $xpo$temp - 10 )
M   0	    256 	%FI
M   0	    257 	, %CHAR( $xpo$temp ) %,
    0	    258 
    0	    259     $XPO$POSITION ( position ) [] =
M   0	    260 	%IF NOT $xpo$paren_test( position )
M   0	    261 	%THEN
M   0	    262 	    %UPVAL * (position)		! assume fullwords
M   0	    263 	%ELSE
M   0	    264 	    %IF %NULL ( $xpo$arg2( %REMOVE(position) ) )
M   0	    265 	    %THEN
M   0	    266 		%UPVAL * (position)		! assume fullwords
M   0	    267 	    %ELSE
M   0	    268 		%IF $xpo$key_test( $xpo$arg2( %REMOVE(position) ), (FULLWORDS, UNITS), 'POSITION=' )
M   0	    269 		%THEN
M   0	    270 		    %IF %IDENTICAL ( $xpo$arg2( %REMOVE(position) ), FULLWORDS )
M   0	    271 		    %THEN
M   0	    272 			%UPVAL * ($xpo$arg1( %REMOVE(position) ) )
M   0	    273 		    %ELSE

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 6
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    274 			$xpo$arg1( %REMOVE(position) )
M   0	    275 		    %FI
M   0	    276 		%ELSE				! return null
M   0	    277 		%FI
M   0	    278 	    %FI
M   0	    279 	%FI %;
    0	    280 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 7
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	    282 !
    0	    283 ! XPORT Transportable FIELD definition macros
    0	    284 !
    0	    285 
    0	    286 LITERAL
    0	    287     $xpo$bits_byte =					! Bits per "byte"
    0	    288 		%BLISS16(8) %BLISS32(8) %BLISS36(9),
    0	    289 
    0	    290     $xpo$bits_word = 2 * $xpo$bits_byte;		! Bits per "word"
    0	    291 
    0	    292 COMPILETIME						! Compile-time variables:
    0	    293     $xpo$full_based = 0,				!    fullword-based structure indicator
    0	    294     $xpo$full_index = 0,				!    fullword index (within block)
    0	    295     $xpo$bit_index = 0,					!    bit index (within fullword)
    0	    296     $xpo$max_fullwd = 0,				!    maximum value index in current block
    0	    297     $xpo$max_bit = 0,					!    maximum bit index (within maximum value)
    0	    298     $xpo$bits = 0,					!    field size in bits
    0	    299     $xpo$1st_actual = 0,				!    first calculated access-acutal
    0	    300     $xpo$2nd_actual = 0,				!    second calculated access_actual (bit displacement)
    0	    301     $xpo$unit_index = 0,				!    addressable unit index (within block)
    0	    302     $xpo$set_size = 0,					!    size of field set in units
    0	    303     $xpo$distinct = 0,					!    distinct literal value
    0	    304     $xpo$show_field = 0,				!    $SHOW( FIELDS ) indicator
    0	    305     $xpo$show_lit = 0,					!    $SHOW( LITERALS ) indicator
    0	    306     $xpo$show_info = 0;					!    $SHOW( INFO ) indicator
    0	    307 
    0	    308 %IF %BLISS(BLISS32)
L   0	    309 %THEN
    0	    310 COMPILETIME
    0	    311     $xpo$first_$field = 1;
    0	    312 %FI
    0	    313 
    0	    314 MACRO
    0	    315     $FIELD =						! Block initialization:
M   0	    316 	%ASSIGN( $xpo$full_based, 1 )			!    fullword-based structure
M   0	    317 	%ASSIGN( $xpo$full_index, 0 )			!    value index (within block)
M   0	    318 	%ASSIGN( $xpo$bit_index, 0 )			!    bit index (within value)
M   0	    319 	%ASSIGN( $xpo$max_fullwd, 0 )			!    maximum value index in current block
M   0	    320 	%ASSIGN( $xpo$max_bit, 0 )			!    maximum bit index (within maximum value)
M   0	    321 
M   0	    322 %IF %BLISS(BLISS32)
M   0	    323 %THEN
M   0	    324 	%IF $xpo$first_$field
M   0	    325 	%THEN
M   0	    326 	    %ASSIGN( $xpo$first_$field, 0 )
M   0	    327 
M   0	    328 	    %IF %DECLARED( %QUOTE %QUOTE %QUOTE $DESCRIPTOR )
M   0	    329 	    %THEN
M   0	    330 		MACRO $xpo$vms_descriptor( string ) =
M   0	    331 		    %QUOTE %EXPAND %QUOTE $DESCRIPTOR( string ) %QUOTE % ;
M   0	    332 		UNDECLARE %QUOTE %QUOTE %QUOTE $DESCRIPTOR;
M   0	    333 		MACRO $descriptor( string ) =
M   0	    334 		    %IF %IDENTICAL( string, %STRING(string) )
M   0	    335 		    %THEN
M   0	    336 			$xpo$vms_descriptor( string )
M   0	    337 		    %ELSE
M   0	    338 			$xpo$descriptor( string )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 8
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    339 		    %FI %QUOTE % ;
M   0	    340 	    %ELSE
M   0	    341 		MACRO $descriptor( keyword ) =
M   0	    342 		    $xpo$descriptor( keyword ) %QUOTE % ;
M   0	    343 	    %FI
M   0	    344 	%FI
M   0	    345 %FI
M   0	    346 
M   0	    347 	FIELD %,
    0	    348 
    0	    349 
    0	    350     $UNIT_FIELD =
M   0	    351 	$FIELD
M   0	    352 	%ASSIGN( $xpo$full_based, 0 ) %,		! Change to a unit-based structure
    0	    353 
    0	    354 
    0	    355     $xpo$field( bits, sign, null_field ) =		! Define a single transportable field
M   0	    356 	%IF bits GTR %BPVAL OR null_field
M   0	    357 	%THEN
M   0	    358 	    %ASSIGN( $xpo$bits, 0 )
M   0	    359 	    %IF NOT null_field
M   0	    360 	    %THEN
M   0	    361 		%IF $xpo$show_info
M   0	    362 		%THEN
M   0	    363 		    %INFORM( 'space reserved for field but null field defined' )
M   0	    364 		%FI
M   0	    365 	    %FI
M   0	    366 	%ELSE
M   0	    367 	    %ASSIGN( $xpo$bits, bits )
M   0	    368 	%FI
M   0	    369 
M   0	    370 	%IF NOT %BLISS(BLISS32) AND
M   0	    371 	    $xpo$bits + $xpo$bit_index GTR %BPVAL
M   0	    372 	%THEN
M   0	    373 	    $ALIGN(FULLWORD)
M   0	    374 	    %IF $xpo$show_info
M   0	    375 	    %THEN
M   0	    376 		%INFORM( 'BLISS fullword alignment has been assumed' )
M   0	    377 	    %FI
M   0	    378 	%FI
M   0	    379 
M   0	    380 								!   generate field specs based on current indices
M   0	    381 	%IF $xpo$full_based
M   0	    382 	%THEN
M   0	    383 	    %ASSIGN( $xpo$1st_actual, $xpo$full_index )
M   0	    384 	    %ASSIGN( $xpo$2nd_actual, $xpo$bit_index )
M   0	    385 	    %ASSIGN( $xpo$unit_index, $xpo$full_index * %UPVAL + $xpo$bit_index / %BPUNIT )
M   0	    386 	%ELSE
M   0	    387 	    %ASSIGN( $xpo$1st_actual, $xpo$full_index * %UPVAL + $xpo$bit_index / %BPUNIT )
M   0	    388 	    %ASSIGN( $xpo$2nd_actual, $xpo$bit_index MOD %BPUNIT )
M   0	    389 	    %ASSIGN( $xpo$unit_index, $xpo$1st_actual )
M   0	    390 	%FI
M   0	    391 
M   0	    392 							! Generate field specification:
M   0	    393 	$xpo$1st_actual,				!    fullword index or addressable unit index
M   0	    394 	$xpo$2nd_actual,				!    bit index within fullword/unit
M   0	    395 	$xpo$bits,					!    field size in bits

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 9
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    396 	sign						!    sign extension
M   0	    397 
M   0	    398 	%IF $xpo$show_field
M   0	    399 	%THEN
M   0	    400 	    %PRINT( '			  [',		! Display generated field definition
M   0	    401 		%NUMBER($xpo$1st_actual), ',',
M   0	    402 		%NUMBER($xpo$2nd_actual), ',',
M   0	    403 		%NUMBER($xpo$bits), ',',
M   0	    404 		sign, ']   (+',
M   0	    405 		%IF %BLISS(BLISS32)
M   0	    406 		%THEN
M   0	    407 		    '%X''' $XPO$SHOW_NUMB( $xpo$unit_index, 16 ),
M   0	    408 		%ELSE
M   0	    409 		    '%O''' $XPO$SHOW_NUMB( $xpo$unit_index, 8 ),
M   0	    410 		%FI
M   0	    411 		''')' )
M   0	    412 	%FI
M   0	    413 
M   0	    414 	%ASSIGN( $xpo$full_index, $xpo$full_index + (($xpo$bit_index + bits)/%BPVAL) )	! update current indices
M   0	    415 	%ASSIGN( $xpo$bit_index, ($xpo$bit_index + bits) MOD %BPVAL )
M   0	    416 
M   0	    417 	%IF $xpo$full_index GTR $xpo$max_fullwd OR				! update high-water mark
M   0	    418 	    ($xpo$full_index EQL $xpo$max_fullwd AND
M   0	    419 		$xpo$bit_index GTR $xpo$max_bit)
M   0	    420 	%THEN
M   0	    421 	    %ASSIGN( $xpo$max_fullwd, $xpo$full_index )
M   0	    422 	    %ASSIGN( $xpo$max_bit, $xpo$bit_index )
M   0	    423 	%FI %,
    0	    424 
    0	    425 
    0	    426     $ALIGN( boundary ) =				! Align next field on a specified boundary
M   0	    427 	%IF NOT $xpo$key_test( boundary, ( BYTE, WORD, FULLWORD, UNIT ) )
M   0	    428 	%THEN
M   0	    429 	    %EXITMACRO
M   0	    430 	%FI
M   0	    431 
M   0	    432 	%IF %IDENTICAL( boundary, FULLWORD )
M   0	    433 	%THEN
M   0	    434 	    %IF $xpo$bit_index GTR 0
M   0	    435 	    %THEN
M   0	    436 		%ASSIGN( $xpo$full_index, $xpo$full_index + 1 )
M   0	    437 		%ASSIGN( $xpo$bit_index, 0 )
M   0	    438 	    %FI
M   0	    439 
M   0	    440 	%FI
M   0	    441 
M   0	    442 	%IF %IDENTICAL( boundary, BYTE )
M   0	    443 	%THEN
M   0	    444 	    %IF ($xpo$bit_index MOD $xpo$bits_byte) EQL 0 %THEN %EXITMACRO %FI
M   0	    445 
M   0	    446 	    %ASSIGN( $xpo$bit_index, $xpo$bit_index - ($xpo$bit_index MOD $xpo$bits_byte) + $xpo$bits_byte )
M   0	    447 	%FI
M   0	    448 
M   0	    449 	%IF %IDENTICAL( boundary, WORD )
M   0	    450 	%THEN
M   0	    451 	    %IF ($xpo$bit_index MOD $xpo$bits_word) EQL 0 %THEN %EXITMACRO %FI
M   0	    452 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 10
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    453 	    %ASSIGN( $xpo$bit_index, $xpo$bit_index - ($xpo$bit_index MOD $xpo$bits_word) + $xpo$bits_word )
M   0	    454 	%FI
M   0	    455 
M   0	    456 	%IF %IDENTICAL( boundary, UNIT )
M   0	    457 	%THEN
M   0	    458 	    %IF ($xpo$bit_index MOD %BPUNIT) EQL 0 %THEN %EXITMACRO %FI
M   0	    459 
M   0	    460 	    %ASSIGN( $xpo$bit_index, $xpo$bit_index - ($xpo$bit_index MOD %BPUNIT) + %BPUNIT )
M   0	    461 	%FI
M   0	    462 
M   0	    463 	%IF $xpo$bit_index GEQ %BPVAL
M   0	    464 	%THEN
M   0	    465 	    %ASSIGN( $xpo$full_index, $xpo$full_index + 1 )
M   0	    466 	    %ASSIGN( $xpo$bit_index, 0 )
M   0	    467 	%FI
M   0	    468 
M   0	    469 	%IF $xpo$full_index GTR $xpo$max_fullwd OR		! if we've passed the high-water mark, update it
M   0	    470 	    ($xpo$full_index EQL $xpo$max_fullwd AND
M   0	    471 		$xpo$bit_index GTR $xpo$max_bit)
M   0	    472 	%THEN
M   0	    473 	    %ASSIGN( $xpo$max_fullwd, $xpo$full_index )
M   0	    474 	    %ASSIGN( $xpo$max_bit, $xpo$bit_index )
M   0	    475 	%FI %,
    0	    476 
    0	    477 
    0	    478     $OVERLAY( field0, field1 ) =			! Reset value index, etc. to a previously defined field
M   0	    479 	%IF %LENGTH NEQ 1 AND %LENGTH NEQ 4
M   0	    480 	%THEN
M   0	    481 	    %WARN( 'Invalid argument list' )
M   0	    482 	    %EXITMACRO
M   0	    483 	%FI
M   0	    484 
M   0	    485 	%IF %LENGTH EQL 4
M   0	    486 	%THEN
M   0	    487 	    %IF $xpo$full_based
M   0	    488 	    %THEN
M   0	    489 		%ASSIGN( $xpo$full_index, field0 )
M   0	    490 		%ASSIGN( $xpo$bit_index, field1 )
M   0	    491 	    %ELSE
M   0	    492 		%ASSIGN( $xpo$full_index, (field0) / %UPVAL )
M   0	    493 		%ASSIGN( $xpo$bit_index, (field1) + ((field0) MOD %UPVAL) * %BPUNIT )
M   0	    494 	    %FI
M   0	    495 	%ELSE
M   0	    496 	    %IF NOT %DECLARED( %NAME(field0) )
M   0	    497 	    %THEN
M   0	    498 		%WARN( field0, ' is not defined' )
M   0	    499 		%EXITMACRO
M   0	    500 	    %FI
M   0	    501 
M   0	    502 	    %IF $xpo$full_based
M   0	    503 	    %THEN
M   0	    504 		%ASSIGN( $xpo$full_index, %FIELDEXPAND(field0,0) )
M   0	    505 		%ASSIGN( $xpo$bit_index, %FIELDEXPAND(field0,1) )
M   0	    506 	    %ELSE
M   0	    507 		%ASSIGN( $xpo$full_index, %FIELDEXPAND(field0,0) / %UPVAL )
M   0	    508 		%ASSIGN( $xpo$bit_index, %FIELDEXPAND(field0,1) + (%FIELDEXPAND(field0,0) MOD %UPVAL) * %BPUNIT )
M   0	    509 	    %FI

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 11
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    510 	%FI
M   0	    511 
M   0	    512 	%IF $xpo$full_index GTR $xpo$max_fullwd OR		! if we've passed the high-water mark, update it
M   0	    513 	    ($xpo$full_index EQL $xpo$max_fullwd AND
M   0	    514 		$xpo$bit_index GTR $xpo$max_bit)
M   0	    515 	%THEN
M   0	    516 	    %ASSIGN( $xpo$max_fullwd, $xpo$full_index )
M   0	    517 	    %ASSIGN( $xpo$max_bit, $xpo$bit_index )
M   0	    518 	%FI %,
    0	    519 
    0	    520 
    0	    521     $CONTINUE =						! Continue block at high-water-mark
M   0	    522 	%ASSIGN( $xpo$full_index, $xpo$max_fullwd )
M   0	    523 	%ASSIGN( $xpo$bit_index, $xpo$max_bit ) %,
    0	    524 
    0	    525 
    0	    526     $BASE =
M   0	    527 	%ASSIGN( $xpo$full_index, 0 )
M   0	    528 	%ASSIGN( $xpo$bit_index, 0 )
M   0	    529 	0,0,0,0 %,
    0	    530 
    0	    531 
    0	    532     $BYTE =						! A single, unsigned "byte"
M   0	    533 	$BYTES(1) %,
    0	    534 
    0	    535 
    0	    536     $BYTES( number ) =					! Any number of unsigned bytes
M   0	    537 	$xpo$field( (number) * $xpo$bits_byte, 0, 0 ) %,
    0	    538 
    0	    539 
    0	    540     $INTEGER =						! Signed BLISS value (aligned)
M   0	    541 	$xpo$field( %BPVAL, 1, 0 ) %,
    0	    542 
    0	    543 
    0	    544     $TINY_INTEGER =					! Signed 1-"byte" value
M   0	    545 	$xpo$field( $xpo$bits_byte, 1, 0 ) %,
    0	    546 
    0	    547 
    0	    548     $SHORT_INTEGER =					! Signed 2-"byte" value
M   0	    549 	$xpo$field( 2 * $xpo$bits_byte, 1, 0 ) %,
    0	    550 
    0	    551 
    0	    552     $LONG_INTEGER =					! Signed 4-"byte" value
M   0	    553 	$xpo$field( 4 * $xpo$bits_byte, 1, 0 ) %,
    0	    554 
    0	    555 
    0	    556     $ADDRESS =						! Unsigned address
M   0	    557 	$xpo$field( %BPADDR , 0, 0 ) %,
    0	    558 
    0	    559 
    0	    560     $POINTER =						! Unsigned character pointer
M   0	    561 	$xpo$field( %BPVAL, 0, 0 ) %,
    0	    562 
    0	    563 
    0	    564     $BIT =						! Single bit
M   0	    565 	$BITS(1) %,
    0	    566 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 12
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	    567 
    0	    568     $BITS( number ) =					! Collection of bits
M   0	    569 	$xpo$field( (number), 0, 0 ) %,
    0	    570 
    0	    571 
    0	    572     $SUB_BLOCK( fullwords ) =				! Sub-structure
M   0	    573 	$ALIGN(FULLWORD)
M   0	    574 	%IF %NULL(fullwords)
M   0	    575 	%THEN
M   0	    576 	    $xpo$field( 0, 0, 1 )
M   0	    577 	%ELSE
M   0	    578 	    $xpo$field( (fullwords) * %BPVAL, 0, 1 )
M   0	    579 	%FI %,
    0	    580 
    0	    581     $xpo$descriptor( class ) =				! String or binary data descriptor sub-block
M   0	    582 	%IF NOT %NULL(class)
M   0	    583 	%THEN
M   0	    584 	    %IF NOT $xpo$key_test( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED, UNDEFINED
M   0	    585 						, STATIC, VARYING, DYNAMIC_VARYING) )	! *** OBSOLETE ***
M   0	    586 	    %THEN
M   0	    587 		0,0,0,0
M   0	    588 		%EXITMACRO
M   0	    589 	    %FI
M   0	    590 	%FI
M   0	    591 
M   0	    592 	%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	    593 		OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)	! *** OBSOLETE ***
M   0	    594 	%THEN
M   0	    595 	    $SUB_BLOCK( STR$K_B_BLN )
M   0	    596 	%ELSE
M   0	    597 	    $SUB_BLOCK( STR$K_F_BLN )
M   0	    598 	%FI %,
    0	    599 
    0	    600 
    0	    601 %IF %BLISS(BLISS16) OR %BLISS(BLISS36) %THEN
U   0	    602     $DESCRIPTOR( keyword ) =
U   0	    603 	%EXPAND $xpo$descriptor( keyword ) %,
U   0	    604 %FI
    0	    605 
    0	    606 
    0	    607     $REF_DESCRIPTOR =
M   0	    608 	$ADDRESS %,
    0	    609 
    0	    610 
    0	    611 %IF %BLISS(BLISS36)
L   0	    612 %THEN
U   0	    613 
U   0	    614     $STRING( length ) =					! Character string for BLISS36
U   0	    615 	$ALIGN(UNIT)
U   0	    616 	$xpo$field( (((length)+4)/5) * %BPVAL, 0, 0 ) %,
U   0	    617 
U   0	    618 %ELSE
    0	    619 
    0	    620     $STRING( length ) =					! Character string for BLISS16 and BLISS32
M   0	    621 	$ALIGN(UNIT)
M   0	    622 	$xpo$field( (length) * %BPUNIT, 0, 0 ) %,
    0	    623 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 13
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	    624 %FI
    0	    625 
    0	    626 
    0	    627 %IF %BLISS(BLISS36)
L   0	    628 %THEN
U   0	    629 
U   0	    630     $SIXBIT( length ) =					! Six-bit character string for BLISS36
U   0	    631 	%IF (length) MOD 3 NEQ 0
U   0	    632 	%THEN
U   0	    633 	    %WARN( 'A six-bit string must be in units of 3 characters' )
U   0	    634 	%FI
U   0	    635 	%IF $xpo$bit_index MOD (%BPVAL/2) NEQ 0
U   0	    636 	%THEN
U   0	    637 	    %WARN( 'A six-bit string must be half-word aligned' )
U   0	    638 	%FI
U   0	    639 
U   0	    640 	$xpo$field( (((length)+2)/3)*(%BPVAL/2), 0, 0 ) %,
U   0	    641 
U   0	    642 %ELSE
    0	    643 
    0	    644     $SIXBIT( length ) =					! Six-bit character string for BLISS16 and BLISS32
M   0	    645 	%WARN( 'Six-bit strings are not available for this architecture' ) %,
    0	    646 
    0	    647 %FI
    0	    648 
    0	    649 
    0	    650     $LENGTH =										! *** OBSOLETE ***
M   0	    651 	%INFORM( '$LENGTH is obsolete - use $FIELD_SET_SIZE' )				! *** OBSOLETE ***
M   0	    652 	$FIELD_SET_SIZE %,								! *** OBSOLETE ***
    0	    653 
    0	    654 
    0	    655     $FIELD_SET_SIZE =					! Length of field set in fullwords
M   0	    656 	%EXPAND $CONTINUE
M   0	    657 	%IF NOT $xpo$full_based
M   0	    658 	%THEN
M   0	    659 	    %WARN( '$FIELD_SET_SIZE may not be used with $UNIT_FIELD' )
M   0	    660 	%FI
M   0	    661 
M   0	    662 	%ASSIGN( $xpo$set_size, $xpo$full_index + ($xpo$bit_index NEQ 0) )
M   0	    663 	%NUMBER( $xpo$set_size )
M   0	    664 
M   0	    665 	%IF $xpo$show_lit
M   0	    666 	%THEN
M   0	    667 	    %PRINT( '			  ', %NUMBER($xpo$set_size), ' fullwords' )
M   0	    668 	%FI
M   0	    669 
M   0	    670 	%ASSIGN( $xpo$full_based, 1 ) %,
    0	    671 
    0	    672 
    0	    673     $FIELD_SET_UNITS =					! Length of field set in addressable units
M   0	    674 	%EXPAND $CONTINUE
M   0	    675 	%ASSIGN( $xpo$set_size,  $xpo$full_index * %UPVAL + ( ($xpo$bit_index + %BPUNIT - 1) / %BPUNIT )  )
M   0	    676 	%NUMBER( $xpo$set_size )
M   0	    677 
M   0	    678 	%IF $xpo$show_lit
M   0	    679 	%THEN
M   0	    680 	    %PRINT( '			  ', %NUMBER($xpo$set_size), ' addressable units' )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 14
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    681 	%FI
M   0	    682 
M   0	    683 	%ASSIGN( $xpo$full_based, 1 ) %,
    0	    684 
    0	    685 
    0	    686     $LITERAL =						! Initialize for constant creation
M   0	    687 	%ASSIGN( $xpo$distinct, 0 )
M   0	    688 	LITERAL %,
    0	    689 
    0	    690 
    0	    691     $DISTINCT =						! Assign constant value
M   0	    692 	%ASSIGN( $xpo$distinct, $xpo$distinct + 1 )
M   0	    693 	%NUMBER( $xpo$distinct )
M   0	    694 
M   0	    695 	%IF $xpo$show_lit
M   0	    696 	%THEN
M   0	    697 	    %PRINT( '			  ', %NUMBER($xpo$distinct) )
M   0	    698 	%FI %,
    0	    699 
    0	    700 
    0	    701     $SUB_FIELD( primary, sub0, sub1, sub2, sub3 ) =
M   0	    702 	%IF %LENGTH NEQ 2 AND %LENGTH NEQ 5
M   0	    703 	%THEN
M   0	    704 	    %WARN( 'Invalid argument list' )
M   0	    705 	    0,0,0,0
M   0	    706 	    %EXITMACRO
M   0	    707 	%FI
M   0	    708 
M   0	    709 	%IF NOT %DECLARED( primary )
M   0	    710 	%THEN
M   0	    711 	    %WARN( '"', primary, '" has not been declared' )
M   0	    712 	    0,0,0,0
M   0	    713 	    %EXITMACRO
M   0	    714 	%FI
M   0	    715 
M   0	    716 	%IF %LENGTH EQL 2
M   0	    717 	%THEN
M   0	    718 	    %IF NOT %DECLARED( sub0 )
M   0	    719 	    %THEN
M   0	    720 		%WARN( '"', sub0, '" has not been declared' )
M   0	    721 		0,0,0,0
M   0	    722 		%EXITMACRO
M   0	    723 	    %FI
M   0	    724 										! Generate access-actuals from
M   0	    725 	    %IF $xpo$full_based							! two field names:
M   0	    726 	    %THEN
M   0	    727 		%FIELDEXPAND(primary,0) + %FIELDEXPAND(sub0,0) +		! 1 - fullword index into block
M   0	    728 		    ((%FIELDEXPAND(primary,1) + %FIELDEXPAND(sub0,1)) / %BPVAL ),
M   0	    729 		(%FIELDEXPAND(primary,1) + %FIELDEXPAND(sub0,1)) MOD %BPVAL,	! 2 - bit index into fullword
M   0	    730 	    %ELSE
M   0	    731 		%FIELDEXPAND(primary,0) + %FIELDEXPAND(sub0,0) +		! 1 - unit index into block
M   0	    732 		    ((%FIELDEXPAND(primary,1) + %FIELDEXPAND(sub0,1)) / %BPUNIT ),
M   0	    733 		(%FIELDEXPAND(primary,1) + %FIELDEXPAND(sub0,1)) MOD %BPUNIT,	! 2 - bit index into unit
M   0	    734 	    %FI
M   0	    735 	    %FIELDEXPAND(sub0,2),						! 3 - field size in bits
M   0	    736 	    %FIELDEXPAND(sub0,3)						! 4 - sign extension
M   0	    737 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 15
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    738 	%ELSE									! Generate access-actuals from a
M   0	    739 	    %IF $xpo$full_based							! field name and 4 access-actuals:
M   0	    740 	    %THEN
M   0	    741 		%FIELDEXPAND(primary,0) + sub0 +				! 1 - fullword index into block
M   0	    742 		    ((%FIELDEXPAND(primary,1) + sub1) / %BPVAL ),
M   0	    743 		(%FIELDEXPAND(primary,1) + sub1) MOD %BPVAL,			! 2 - bit index into fullword
M   0	    744 	    %ELSE
M   0	    745 		%FIELDEXPAND(primary,0) + sub0 +				! 1 - unit index into block
M   0	    746 		    ((%FIELDEXPAND(primary,1) + sub1) / %BPUNIT ),
M   0	    747 		(%FIELDEXPAND(primary,1) + sub1) MOD %BPUNIT,			! 2 - bit index into unit
M   0	    748 	    %FI
M   0	    749 	    sub2,								! 3 - field size in bits
M   0	    750 	    sub3								! 4 - sign extension
M   0	    751 	%FI %,
    0	    752 
    0	    753 
    0	    754     $BLOCK =										! *** OBSOLETE ***
M   0	    755 	%INFORM( 'The $BLOCK macro is obsolete - use BLOCK' )				! *** OBSOLETE ***
M   0	    756 	BLOCK %,									! *** OBSOLETE ***
    0	    757 
    0	    758 
    0	    759     $BLOCKVECTOR =									! *** OBSOLETE ***
M   0	    760 	%INFORM( 'The $BLOCKVECTOR macro is obsolete - use BLOCKVECTOR' )		! *** OBSOLETE ***
M   0	    761 	BLOCKVECTOR %,									! *** OBSOLETE ***
    0	    762 
    0	    763 
    0	    764     $UNIT_BLOCK( arg1, arg2 ) =
M   0	    765 	%IF %LENGTH NEQ 0 AND %LENGTH NEQ 1 AND %LENGTH NEQ 2
M   0	    766 	%THEN
M   0	    767 	    %WARN( 'Invalid number of arguments' )
M   0	    768 	    %EXITMACRO
M   0	    769 	%FI
M   0	    770 
M   0	    771 	BLOCK[ arg1
M   0	    772 
M   0	    773 	%IF %LENGTH EQL 2
M   0	    774 	%THEN
M   0	    775 	    , arg2 ;
M   0	    776 	%FI
M   0	    777 
M   0	    778 	%IF NOT %BLISS(BLISS36)
M   0	    779 	%THEN
M   0	    780 	    , BYTE
M   0	    781 	%FI
M   0	    782 	] %,
    0	    783 
    0	    784 
    0	    785     $UNIT_BLOCKVECTOR( arg1, arg2, arg3, arg4 ) =
M   0	    786 	%IF %LENGTH NEQ 1 AND %LENGTH NEQ 2 AND %LENGTH NEQ 4
M   0	    787 	%THEN
M   0	    788 	    %WARN( 'Invalid number of arguments' )
M   0	    789 	    %EXITMACRO
M   0	    790 	%FI
M   0	    791 
M   0	    792 	BLOCKVECTOR[ arg1
M   0	    793 
M   0	    794 	%IF %LENGTH GTR 1

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 16
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    795 	%THEN
M   0	    796 	    , arg2
M   0	    797 	%FI
M   0	    798 
M   0	    799 	%IF %LENGTH EQL 4
M   0	    800 	%THEN
M   0	    801 	    , arg3, arg4
M   0	    802 	%FI
M   0	    803 
M   0	    804 	%IF NOT %BLISS(BLISS36)
M   0	    805 	%THEN
M   0	    806 	    , BYTE
M   0	    807 	%FI
M   0	    808 	] %,
    0	    809 
    0	    810 
    0	    811     $SHOW( keyword ) [] =
M   0	    812 	%IF NOT $xpo$key_test( keyword, (VERSION, FIELDS, LITERALS, INFO, ALL, NOFIELDS, NOLITERALS, NOINFO, NONE) )
M   0	    813 	%THEN
M   0	    814 	    %EXITMACRO
M   0	    815 	%FI
M   0	    816 
M   0	    817 	%IF %IDENTICAL( keyword, VERSION )
M   0	    818 	%THEN
M   0	    819 	    %print ('XPORT ', $xpo_ident,
M   0	    820 		    '    XPO$K_VERSION = ', %NUMBER (xpo$k_version),
M   0	    821 		    '    XPO$K_LEVEL = ', %NUMBER (xpo$k_level) )
M   0	    822 	%ELSE %IF %IDENTICAL( keyword, FIELDS )
M   0	    823 	%THEN
M   0	    824 	    %ASSIGN( $xpo$show_field, 1 )
M   0	    825 	%ELSE %IF %IDENTICAL( keyword, NOFIELDS )
M   0	    826 	%THEN
M   0	    827 	    %ASSIGN( $xpo$show_field, 0 )
M   0	    828 	%ELSE %IF %IDENTICAL( keyword, LITERALS )
M   0	    829 	%THEN
M   0	    830 	    %ASSIGN( $xpo$show_lit, 1 )
M   0	    831 	%ELSE %IF %IDENTICAL( keyword, NOLITERALS )
M   0	    832 	%THEN
M   0	    833 	    %ASSIGN( $xpo$show_lit, 0 )
M   0	    834 	%ELSE %IF %IDENTICAL( keyword, INFO )
M   0	    835 	%THEN
M   0	    836 	    %ASSIGN( $xpo$show_info, 1 )
M   0	    837 	%ELSE %IF %IDENTICAL( keyword, NOINFO )
M   0	    838 	%THEN
M   0	    839 	    %ASSIGN( $xpo$show_info, 0 )
M   0	    840 	%ELSE %IF %IDENTICAL( keyword, ALL )
M   0	    841 	%THEN
M   0	    842 	    %ASSIGN( $xpo$show_field, 1 )
M   0	    843 	    %ASSIGN( $xpo$show_lit, 1 )
M   0	    844 	    %ASSIGN( $xpo$show_info, 1 )
M   0	    845 	%ELSE
M   0	    846 	    %ASSIGN( $xpo$show_field, 0 )
M   0	    847 	    %ASSIGN( $xpo$show_lit, 0 )
M   0	    848 	    %ASSIGN( $xpo$show_info, 0 )
M   0	    849 	%FI %FI %FI %FI %FI %FI %FI %FI
M   0	    850 
M   0	    851 	$SHOW (%REMAINING) %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 17
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	    852 
    0	    853 
    0	    854 	$SHOW( ALL )					! Show everything during XPORT.REQ library pre-compilation
    0	    855 
    0	    856 
    0	    857 $LITERAL						! XPO$DUMP data type codes
    0	    858 	XPO$K_BYTE	= $DISTINCT,
		; %PRINT:				  1
    0	    859 	XPO$K_BYTES	= $DISTINCT,
		; %PRINT:				  2
    0	    860 	XPO$K_INTEGER	= $DISTINCT,
		; %PRINT:				  3
    0	    861 	XPO$K_TINY_INTE	= XPO$K_INTEGER,
    0	    862 	XPO$K_SHORT_INT	= XPO$K_INTEGER,
    0	    863 	XPO$K_LONG_INTE	= XPO$K_INTEGER,
    0	    864 	XPO$K_ADDRESS	= $DISTINCT,
		; %PRINT:				  4
    0	    865 	XPO$K_POINTER	= $DISTINCT,
		; %PRINT:				  5
    0	    866 	XPO$K_BIT	= $DISTINCT,
		; %PRINT:				  6
    0	    867 	XPO$K_BITS	= $DISTINCT,
		; %PRINT:				  7
    0	    868 	XPO$K_SUB_BLOCK	= $DISTINCT,
		; %PRINT:				  8
    0	    869 	XPO$K_DESCRIPTO	= $DISTINCT,
		; %PRINT:				  9
    0	    870 	XPO$K_REF_DESCR	= $DISTINCT,
		; %PRINT:				  10
    0	    871 	XPO$K_STRING	= $DISTINCT;
		; %PRINT:				  11
    0	    872 
    0	    873 
    0	    874 KEYWORDMACRO
    0	    875     $XPO_DUMP_FIELD(
    0	    876 	field_name,					! name of the field to be dumped
    0	    877 	type,						! field data type
    0	    878 	value						! field value or address
    0	    879 	) =
M   0	    880 
M   0	    881 	BEGIN
M   0	    882 	%EXPAND $xpo$force( $xpo$ex_routine( XPO$DUMP_FIELD ) );
M   0	    883 
M   0	    884 	OWN $str$field_name :  %EXPAND $STR_DESCRIPTOR( STRING = %STRING(field_name) );
M   0	    885 
M   0	    886 	XPO$DUMP_FIELD( $str$field_name,  $xpo$name15('XPO$K_',type), value )
M   0	    887 	END %;
    0	    888 
    0	    889 
    0	    890 MACRO
    0	    891     $XPO$MASK_SET( prefix, field_name ) [ bit_name ] =
M   0	    892 	%IF %COUNT EQL 0
M   0	    893 	%THEN
M   0	    894 	    %IF NOT %DECLARED(%NAME(prefix,field_name))
M   0	    895 	    %THEN
M   0	    896 		%WARN( prefix, field_name, ' is not defined' )
M   0	    897 		%EXITMACRO

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 18
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	    898 	    %FI
M   0	    899 	%FI
M   0	    900 
M   0	    901 	%IF NOT %DECLARED(%NAME(prefix,bit_name))
M   0	    902 	%THEN
M   0	    903 	    %WARN( prefix, bit_name, ' is not defined' )
M   0	    904 	%ELSE
M   0	    905 	    %IF %FIELDEXPAND(%NAME(prefix,bit_name),2) NEQ 1
M   0	    906 	    %THEN
M   0	    907 		%WARN( prefix, bit_name, ' is not a 1-bit field' )
M   0	    908 	    %ELSE
M   0	    909 		! The following statements generate a mask declaration similar to the following:
M   0	    910 		!
M   0	    911 		!	mask_name = 1 ^ ( B0 * %BPUNIT + B1 - F0 * %BPUNIT - F1 )
M   0	    912 		!
M   0	    913 		! where the field and bit definition are as follows:
M   0	    914 		!
M   0	    915 		!	field = [ F0, F1, ... ]
M   0	    916 		!	bit   = [ B0, B1, ... ]
M   0	    917 		!
M   0	    918 		%ASSIGN( $xpo$temp,
M   0	    919 			1 ^ ( %FIELDEXPAND(%NAME(prefix,bit_name),0) * %BPUNIT +
M   0	    920 				%FIELDEXPAND(%NAME(prefix,bit_name),1) -
M   0	    921 				%FIELDEXPAND(%NAME(prefix,field_name),0) * %BPUNIT -
M   0	    922 				%FIELDEXPAND(%NAME(prefix,field_name),1) ) )
M   0	    923 
M   0	    924 		%NAME(%EXACTSTRING(%CHARCOUNT(prefix)-2,0,prefix),'M_',bit_name) = %NUMBER( $xpo$temp )
M   0	    925 
M   0	    926 		%IF $xpo$show_lit
M   0	    927 		%THEN
M   0	    928 		    %PRINT( '	',
M   0	    929 			    %EXACTSTRING(%CHARCOUNT(prefix)-2,0,prefix),'M_',bit_name,
M   0	    930 			    '	= ',
M   0	    931 			    %NUMBER( $xpo$temp ) )
M   0	    932 		%FI
M   0	    933 	    %FI
M   0	    934 	%FI %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 19
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	    936 !
    0	    937 ! STRDESC - XPORT String Descriptor
    0	    938 !
    0	    939 ! This transportable string descriptor is modelled closely after the
    0	    940 ! corresponding VAX-11 descriptor.
    0	    941 !
    0	    942 
    0	    943 $FIELD	STR$H_LENGTH	= [$BYTES(2)] ;			! Number of characters in the string
		; %PRINT:				  [0,0,16,0]   (+%X'0')
    0	    944 
    0	    945 FIELD	STR$B_DTYPE	= [$BYTE] ;			! Atomic data type code:
		; %PRINT:				  [0,16,8,0]   (+%X'2')
    0	    946 LITERAL	STR$K_DTYPE_XXX	= 0,				!    Erroreous XPORT temporary string
    0	    947 	STR$K_DTYPE_T	= 14;				!    ASCII text string
    0	    948 
    0	    949 FIELD	STR$B_CLASS	= [$BYTE] ;			! Descriptor class code:
		; %PRINT:				  [0,24,8,0]   (+%X'3')
    0	    950 LITERAL	STR$K_CLASS_Z	= 0,				!    unspecified
    0	    951 	STR$K_CLASS_F	= 1,				!    fixed string
    0	    952 	STR$K_CLASS_D	= 2,				!    dynamic string
    0	    953 	STR$K_CLASS_B	= 3,				!    bounded string
    0	    954 	STR$K_CLASS_DB	= 190,				!    dynamic bounded string
    0	    955 	STR$K_CLASS_XT	= 189;				!    XPORT temporary string (dynamic)
    0	    956 
    0	    957 FIELD	STR$A_POINTER	= [$POINTER] ;			! Pointer to the character string
		; %PRINT:				  [1,0,32,0]   (+%X'4')
    0	    958 
    0	    959 LITERAL	STR$K_F_BLN	= $FIELD_SET_SIZE ,		! Length of a fixed descriptor
		; %PRINT:				  2 fullwords
    0	    960 	STR$K_D_BLN	= $FIELD_SET_SIZE ,		! Length of a dynamic descriptor
		; %PRINT:				  2 fullwords
    0	    961 	STR$K_XT_BLN	= $FIELD_SET_SIZE ;		! Length of an XPORT temporary descriptor
		; %PRINT:				  2 fullwords
    0	    962 
    0	    963 FIELD	STR$H_MAXLEN	= [$BYTES(2)] ;			! Length of the container string
		; %PRINT:				  [2,0,16,0]   (+%X'8')
    0	    964 FIELD	STR$H_PFXLEN	= [$BYTES(2)] ;			! Length of the prefix string
		; %PRINT:				  [2,16,16,0]   (+%X'A')
    0	    965 
    0	    966 LITERAL	STR$K_B_BLN	= $FIELD_SET_SIZE ,		! Length of a bounded descriptor
		; %PRINT:				  3 fullwords
    0	    967 	STR$K_DB_BLN	= $FIELD_SET_SIZE ,		! Length of a dynamic bounded descriptor
		; %PRINT:				  3 fullwords
    0	    968 	STR$K_Z_BLN	= $FIELD_SET_SIZE ;		! Maximum length of an undefined descriptor
		; %PRINT:				  3 fullwords
    0	    969 
    0	    970 ! End of STRDESC
    0	    971 
    0	    972 MACRO
    0	    973     $str$f_fields =
M   0	    974 	STR$H_LENGTH, STR$B_DTYPE, STR$B_CLASS, STR$A_POINTER %,
    0	    975 
    0	    976     $str$b_fields =
M   0	    977 	%EXPAND $str$f_fields, STR$H_MAXLEN, STR$H_PFXLEN %;
    0	    978 
    0	    979 
    0	    980 MACRO												! *** OBSOLETE ***

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 20
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	    981     STR$K_DTYPE_Z =
M   0	    982 	%INFORM( 'STR$K_DTYPE_Z is an obsolete name - use $XPO_DESCRIPTOR and XPO$K_DTYPE_BU' )
M   0	    983 	XPO$K_DTYPE_BU %,
    0	    984 
    0	    985     STR$K_CLASS_S =
M   0	    986 	%INFORM( 'STR$K_CLASS_S is an obsolete name - use STR$K_CLASS_F' )
M   0	    987 	STR$K_CLASS_F %,
    0	    988 
    0	    989     STR$K_CLASS_V =
M   0	    990 	%INFORM( 'STR$K_CLASS_V is an obsolete name - use STR$K_CLASS_B' )
M   0	    991 	STR$K_CLASS_B %,
    0	    992 
    0	    993     STR$K_CLASS_DV =
M   0	    994 	%INFORM( 'STR$K_CLASS_DV is an obsolete name - use STR$K_CLASS_DB' )
M   0	    995 	STR$K_CLASS_DB %,
    0	    996 
    0	    997     STR$A_ADDRESS =
M   0	    998 	%INFORM( 'STR$A_ADDRESS is an obsolete field - use $XPO_DESCRIPTOR and XPO$A_ADDRESS' )
M   0	    999 	STR$A_POINTER %,
    0	   1000 
    0	   1001     STR$K_S_BLN =
M   0	   1002 	%INFORM( 'STR$K_S_BLN is an obsolete name - use STR$K_F_BLN' )
M   0	   1003 	STR$K_F_BLN %,
    0	   1004 
    0	   1005     STR$K_V_BLN =
M   0	   1006 	%INFORM( 'STR$K_V_BLN is an obsolete name - use STR$K_B_BLN' )
M   0	   1007 	STR$K_B_BLN %,
    0	   1008 
    0	   1009     STR$K_DV_BLN =
M   0	   1010 	%INFORM( 'STR$K_DV_BLN is an obsolete name - use STR$K_DB_BLN' )
M   0	   1011 	STR$K_DB_BLN %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 21
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1013 !
    0	   1014 ! String Descriptor Declaration and Initialization Macros
    0	   1015 !
    0	   1016 
    0	   1017 MACRO
    0	   1018     $str$desc_type( type ) =
M   0	   1019 	%IF %IDENTICAL(type,CHARACTERS) %THEN		STR$K_DTYPE_T	%ELSE
M   0	   1020 	%IF %IDENTICAL(type,FULLWORDS) OR
M   0	   1021 	    %IDENTICAL(type,UNITS) %THEN		XPO$K_DTYPE_BU
M   0	   1022 	%FI %FI %,
    0	   1023 
    0	   1024 
    0	   1025     $str$desc_class( class ) =
M   0	   1026 	%IF %IDENTICAL(class,DYNAMIC_BOUNDED) %THEN	STR$K_CLASS_DB	%ELSE
M   0	   1027 	%IF %IDENTICAL(class,DYNAMIC_VARYING) %THEN	STR$K_CLASS_DB	%ELSE				! *** OBSOLE
M   0	   1027 TE ***
M   0	   1028 	%IF %IDENTICAL(class,XPORT_TEMPORARY) %THEN	STR$K_CLASS_XT
M   0	   1029 	%ELSE
M   0	   1030 	    %NAME( %EXACTSTRING( 13, 0, 'STR$K_CLASS_', class ) )
M   0	   1031 	%FI %FI %FI %,
    0	   1032 
    0	   1033 
    0	   1034     $str$literal( literal_text ) =
M   0	   1035 	CH$PTR( UPLIT  %BLISS16( BYTE )  %BLISS32( BYTE )  ( literal_text ) )%;
    0	   1036 
    0	   1037 
    0	   1038 MACRO
    0	   1039     $STR_DESC = $STR_DESCRIPTOR %;
    0	   1040 
    0	   1041 
    0	   1042 KEYWORDMACRO
    0	   1043     $STR_DESCRIPTOR(
    0	   1044 	class=FIXED,					! descriptor class
    0	   1045 	type,						! data type				! *** OBSOLETE ***
    0	   1046 	string,						! string descriptor
    0	   1047 	binary_data					! binary data descriptor		! *** OBSOLETE ***
    0	   1048 	) =
M   0	   1049 
M   0	   1050 	%IF NOT $xpo$key_check( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED,		! *** OBSOLETE ***
M   0	   1051 					STATIC, VARYING, DYNAMIC_VARYING) )			! *** OBSOLETE ***
M   0	   1052 	%THEN											! *** OBSOLETE ***
M   0	   1053 	%IF NOT %IDENTICAL( class, XPORT_TEMPORARY )
M   0	   1054 	%THEN
M   0	   1055 	    %IF NOT $xpo$key_test( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED), 'CLASS=' )
M   0	   1056 	    %THEN
M   0	   1057 		%EXITMACRO
M   0	   1058 	    %FI
M   0	   1059 	%FI
M   0	   1060 	%FI											! *** OBSOLETE ***
M   0	   1061 
M   0	   1062 	%IF $xpo$key_check( class, (STATIC, VARYING, DYNAMIC_VARYING) )				! *** OBSOLETE ***
M   0	   1063 	%THEN											! *** OBSOLETE ***
M   0	   1064 	    %INFORM( 'CLASS=', class, ' is obsolete - see current documentation' )		! *** OBSOLETE ***
M   0	   1065 	%FI											! *** OBSOLETE ***
M   0	   1066 
M   0	   1067 	%IF NOT %NULL( binary_data )								! *** OBSOLETE ***
M   0	   1068 	%THEN											! *** OBSOLETE ***

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 22
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1069 	    %INFORM( 'BINARY_DATA= is obsolete - use the $XPO_DESCRIPTOR macro' )		! *** OBSOLETE ***
M   0	   1070 	%FI											! *** OBSOLETE ***
M   0	   1071 
M   0	   1072 	%IF NOT %NULL(type)
M   0	   1073 	%THEN
M   0	   1074 	    %INFORM( 'TYPE= is obsolete - see current documentation' )				! *** OBSOLETE ***
M   0	   1075 	    %IF NOT $xpo$key_test( type, (CHARACTERS, FULLWORDS, UNITS), 'TYPE=' )
M   0	   1076 	    %THEN
M   0	   1077 		%EXITMACRO
M   0	   1078 	    %FI
M   0	   1079 	%FI
M   0	   1080 
M   0	   1081 	%IF %EXPAND $xpo$conflict( string, binary_data, type )					! *** OBSOLETE ***
M   0	   1082 	%THEN											! *** OBSOLETE ***
M   0	   1083 	    %WARN( 'TYPE=, STRING=, and BINARY_DATA= are mutually exclusive' )			! *** OBSOLETE ***
M   0	   1084 	%FI											! *** OBSOLETE ***
M   0	   1085 
M   0	   1086 	%IF NOT %NULL(string) AND NOT ( $xpo$paren_test(string) OR %ISSTRING(%REMOVE(string)) )
M   0	   1087 	%THEN
M   0	   1088 	    %WARN( 'STRING=descriptor is not permitted' )
M   0	   1089 	    %EXITMACRO
M   0	   1090 	%FI
M   0	   1091 
M   0	   1092 	%IF %ISSTRING( %REMOVE(string) ) AND NOT %IDENTICAL(class,FIXED)
M   0	   1093 	%THEN
M   0	   1094 	    %WARN( 'STRING=literal requires CLASS=FIXED' )
M   0	   1095 	    %EXITMACRO
M   0	   1096 	%FI
M   0	   1097 
M   0	   1098 	%IF $xpo$paren_test(string) AND NOT %IDENTICAL( $xpo$arg1(%REMOVE(string)), 0 )
M   0	   1099 	    AND NOT ( %IDENTICAL(class,FIXED) OR %IDENTICAL(class,BOUNDED) )
M   0	   1100 	%THEN
M   0	   1101 	    %WARN( 'STRING=(len,ptr) requires CLASS=FIXED or CLASS=BOUNDED' )
M   0	   1102 	    %EXITMACRO
M   0	   1103 	%FI
M   0	   1104 
M   0	   1105 	%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1106 		OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)		! *** OBSOLETE ***
M   0	   1107 	%THEN
M   0	   1108 	    BLOCK[STR$K_B_BLN]  FIELD( %EXPAND $str$b_fields )
M   0	   1109 	%ELSE
M   0	   1110 	    BLOCK[STR$K_F_BLN]  FIELD( %EXPAND $str$f_fields )
M   0	   1111 	%FI
M   0	   1112 
M   0	   1113 	%IF %NULL( type, string, binary_data )		! Speedup expansion in most situations.
M   0	   1114 	%THEN
M   0	   1115 	    %EXITMACRO
M   0	   1116 	%FI
M   0	   1117 
M   0	   1118 	%IF NOT %NULL(type)
M   0	   1119 	%THEN
M   0	   1120 	    PRESET( [STR$B_DTYPE] = %EXPAND $str$desc_type( type ),
M   0	   1121 		    [STR$B_CLASS] = %EXPAND $str$desc_class( class ) )
M   0	   1122 	%FI
M   0	   1123 
M   0	   1124 	%IF NOT %NULL(string)
M   0	   1125 	%THEN

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 23
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1126 	    PRESET( [STR$B_DTYPE] = STR$K_DTYPE_T,
M   0	   1127 		    [STR$B_CLASS] = %EXPAND $str$desc_class( class ),
M   0	   1128 	    %IF %ISSTRING( %REMOVE(string) )
M   0	   1129 	    %THEN
M   0	   1130 		    [STR$H_LENGTH] = %CHARCOUNT( %REMOVE(string) ),
M   0	   1131 		    [STR$A_POINTER] = %EXPAND $str$literal( %QUOTE %REMOVE(string) )
M   0	   1132 	    %ELSE
M   0	   1133 		    [STR$A_POINTER] = $xpo$arg2( %REMOVE(string) ),
M   0	   1134 		%IF %IDENTICAL(class,FIXED) OR %IDENTICAL(class,DYNAMIC)
M   0	   1135 		%THEN
M   0	   1136 		    [STR$H_LENGTH] = $xpo$arg1( %REMOVE(string) )
M   0	   1137 		%ELSE
M   0	   1138 		    [STR$H_MAXLEN] = $xpo$arg1( %REMOVE(string) )
M   0	   1139 		%FI
M   0	   1140 	    %FI
M   0	   1141 	    )						! End of STRING PRESET list
M   0	   1142 	%FI
M   0	   1143 
M   0	   1144 	%IF NOT %NULL(binary_data)								! *** OBSOLETE ***
M   0	   1145 	%THEN											! *** OBSOLETE ***
M   0	   1146 	    PRESET( [STR$B_DTYPE] = XPO$K_DTYPE_BU,						! *** OBSOLETE ***
M   0	   1147 		    [STR$B_CLASS] = %EXPAND $str$desc_class(class),				! *** OBSOLETE ***
M   0	   1148 		    [STR$A_POINTER] = $xpo$arg2( %REMOVE(binary_data) ),			! *** OBSOLETE ***
M   0	   1149 	    %IF %IDENTICAL(class,FIXED) OR %IDENTICAL(class,DYNAMIC)				! *** OBSOLETE ***
M   0	   1150 	    %THEN										! *** OBSOLETE ***
M   0	   1151 		    [STR$H_LENGTH] = $xpo$bin_len( %REMOVE(binary_data) )			! *** OBSOLETE ***
M   0	   1152 	    %ELSE										! *** OBSOLETE ***
M   0	   1153 		    [STR$H_MAXLEN] = $xpo$bin_len( %REMOVE(binary_data) )			! *** OBSOLETE ***
M   0	   1154 	    %FI											! *** OBSOLETE ***
M   0	   1155 	    )						! End of BINARY_DATA PRESET list	! *** OBSOLETE ***
M   0	   1156 	%FI %,
    0	   1157 
    0	   1158 
    0	   1159     $STR_DESC_INIT(
    0	   1160 	desc,						! address of descriptor
    0	   1161 	descriptor,					! address of descriptor
    0	   1162 	class=FIXED,					! descriptor class
    0	   1163 	type,						! data type				! *** OBSOLETE ***
    0	   1164 	string,						! string descriptor
    0	   1165 	binary_data					! binary data descriptor		! *** OBSOLETE ***
    0	   1166 	) =
M   0	   1167 
M   0	   1168 	%IF NOT $xpo$key_check( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED,		! *** OBSOLETE ***
M   0	   1169 					STATIC, VARYING, DYNAMIC_VARYING) )			! *** OBSOLETE ***
M   0	   1170 	%THEN											! *** OBSOLETE ***
M   0	   1171 	%IF NOT %IDENTICAL( class, XPORT_TEMPORARY )
M   0	   1172 	%THEN
M   0	   1173 	    %IF NOT $xpo$key_test( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED), 'CLASS=' )
M   0	   1174 	    %THEN
M   0	   1175 		%EXITMACRO
M   0	   1176 	    %FI
M   0	   1177 	%FI
M   0	   1178 	%FI											! *** OBSOLETE ***
M   0	   1179 
M   0	   1180 	%IF $xpo$key_check( class, (STATIC, VARYING, DYNAMIC_VARYING) )				! *** OBSOLETE ***
M   0	   1181 	%THEN											! *** OBSOLETE ***
M   0	   1182 	    %INFORM( 'CLASS=', class, ' is obsolete - see current documentation' )		! *** OBSOLETE ***

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 24
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1183 	%FI											! *** OBSOLETE ***
M   0	   1184 
M   0	   1185 	%IF %EXPAND $xpo$conflict( desc, descriptor )
M   0	   1186 	%THEN
M   0	   1187 	    %WARN( 'DESC= and DESCRIPTOR= are mutually exclusive' )
M   0	   1188 	%FI
M   0	   1189 
M   0	   1190 	%IF NOT %NULL(type)
M   0	   1191 	%THEN
M   0	   1192 	    %INFORM( 'TYPE= is obsolete - see current documentation' )				! *** OBSOLETE ***
M   0	   1193 	    %IF NOT $xpo$key_test( type, (CHARACTERS, FULLWORDS, UNITS), 'TYPE=' )
M   0	   1194 	    %THEN
M   0	   1195 		%EXITMACRO
M   0	   1196 	    %FI
M   0	   1197 	%FI
M   0	   1198 
M   0	   1199 	%IF %EXPAND $xpo$conflict( string, binary_data, type )					! *** OBSOLETE ***
M   0	   1200 	%THEN											! *** OBSOLETE ***
M   0	   1201 	    %WARN( 'TYPE=, STRING=, and BINARY_DATA= are mutually exclusive' )			! *** OBSOLETE ***
M   0	   1202 	%FI											! *** OBSOLETE ***
M   0	   1203 
M   0	   1204 	%IF %ISSTRING( %REMOVE(string) ) AND NOT %IDENTICAL(class,FIXED)
M   0	   1205 	%THEN
M   0	   1206 	    %WARN( 'STRING=literal requires CLASS=FIXED' )
M   0	   1207 	    %EXITMACRO
M   0	   1208 	%FI
M   0	   1209 
M   0	   1210 	%EXPAND $xpo$required( desc descriptor, 'DESC= or DESCRIPTOR=' )
M   0	   1211 
M   0	   1212 	BEGIN
M   0	   1213 	BIND $str$desc = desc descriptor :  %EXPAND $xpo$force( $STR_DESCRIPTOR( %QUOTE CLASS=BOUNDED ) );
M   0	   1214 	BIND $str$bin_desc = desc descriptor :  $XPO_DESCRIPTOR( %QUOTE CLASS=BOUNDED );	! *** OBSOLETE ***
M   0	   1215 
M   0	   1216 	%IF NOT %NULL(type)
M   0	   1217 	%THEN
M   0	   1218 	    $str$desc[STR$H_LENGTH] = 0;
M   0	   1219 	    $str$desc[STR$B_DTYPE] = %EXPAND $str$desc_type( type );
M   0	   1220 	    $str$desc[STR$B_CLASS] = %EXPAND $str$desc_class( class );
M   0	   1221 	    $str$desc[STR$A_POINTER] = 0;
M   0	   1222 	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1223 		OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)		! *** OBSOLETE ***
M   0	   1224 	    %THEN
M   0	   1225 		$str$desc[STR$H_MAXLEN] = 0;
M   0	   1226 		$str$desc[STR$H_PFXLEN] = 0;
M   0	   1227 	    %FI
M   0	   1228 	%ELSE %IF %NULL(string)
M   0	   1229 			AND %NULL(binary_data)							! *** OBSOLETE ***
M   0	   1230 	%THEN
M   0	   1231 	    $str$desc[STR$H_LENGTH] = 0;
M   0	   1232 	    $str$desc[STR$B_DTYPE] = STR$K_DTYPE_T;
M   0	   1233 	    $str$desc[STR$B_CLASS] = %EXPAND $str$desc_class( class );
M   0	   1234 	    $str$desc[STR$A_POINTER] = 0;
M   0	   1235 	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1236 		OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)		! *** OBSOLETE ***
M   0	   1237 	    %THEN
M   0	   1238 		$str$desc[STR$H_MAXLEN] = 0;
M   0	   1239 		$str$desc[STR$H_PFXLEN] = 0;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 25
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1240 	    %FI
M   0	   1241 	%ELSE
M   0	   1242 	    $str$str_desc( $str$desc, class, string )
M   0	   1243 	    $xpo$bin_desc( $str$bin_desc, class, binary_data )					! *** OBSOLETE ***
M   0	   1244 	%FI %FI
M   0	   1245 
M   0	   1246 	XPO$_NORMAL					! normal completion code
M   0	   1247 	END %;
    0	   1248 
    0	   1249 
    0	   1250 MACRO
    0	   1251     $STR$STR_DESC( desc, class, string_desc ) [] =
M   0	   1252 	%IF %ISSTRING( %REMOVE(string_desc) )
M   0	   1253 	%THEN
M   0	   1254 	    desc[STR$H_LENGTH] = %CHARCOUNT( %REMOVE(string_desc) );
M   0	   1255 	    desc[STR$B_DTYPE] = STR$K_DTYPE_T;
M   0	   1256 	    desc[STR$B_CLASS] = %EXPAND $str$desc_class( class );
M   0	   1257 	    desc[STR$A_POINTER] = %EXPAND $str$literal( %QUOTE %REMOVE(string_desc) );
M   0	   1258 	%ELSE
M   0	   1259 	    %IF NOT $xpo$paren_test( string_desc )
M   0	   1260 	    %THEN
M   0	   1261 		BEGIN
M   0	   1262 		BIND $str$$desc = string_desc :  %EXPAND $xpo$force( $STR_DESCRIPTOR() );
M   0	   1263 		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1264 			OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)	! *** OBSOLETE ***
M   0	   1265 		%THEN
M   0	   1266 		    desc[STR$H_LENGTH] = 0;
M   0	   1267 		%ELSE
M   0	   1268 		    desc[STR$H_LENGTH] = .$str$$desc[STR$H_LENGTH];
M   0	   1269 		%FI
M   0	   1270 		desc[STR$B_DTYPE] = .$str$$desc[STR$B_DTYPE];
M   0	   1271 		desc[STR$B_CLASS] = %EXPAND $str$desc_class( class );
M   0	   1272 		desc[STR$A_POINTER] = .$str$$desc[STR$A_POINTER];
M   0	   1273 		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1274 			OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)	! *** OBSOLETE ***
M   0	   1275 		%THEN
M   0	   1276 		    desc[STR$H_MAXLEN] =.$str$$desc[STR$H_LENGTH];
M   0	   1277 		    desc[STR$H_PFXLEN] = 0;
M   0	   1278 		%FI
M   0	   1279 		END;
M   0	   1280 	    %ELSE
M   0	   1281 		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1282 			OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)	! *** OBSOLETE ***
M   0	   1283 		%THEN
M   0	   1284 		    desc[STR$H_LENGTH] = 0;
M   0	   1285 		%ELSE
M   0	   1286 		    desc[STR$H_LENGTH] = $xpo$arg1( %REMOVE(string_desc) );
M   0	   1287 		%FI
M   0	   1288 		desc[STR$B_DTYPE] = STR$K_DTYPE_T;
M   0	   1289 		desc[STR$B_CLASS] = %EXPAND $str$desc_class( class );
M   0	   1290 		desc[STR$A_POINTER] = $xpo$arg2( %REMOVE(string_desc) );
M   0	   1291 		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1292 			OR %IDENTICAL(class,VARYING) OR %IDENTICAL(class,DYNAMIC_VARYING)	! *** OBSOLETE ***
M   0	   1293 		%THEN
M   0	   1294 		    desc[STR$H_MAXLEN] = $xpo$arg1( %REMOVE(string_desc) );
M   0	   1295 		    desc[STR$H_PFXLEN] = 0;
M   0	   1296 		%FI

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 26
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1297 	    %FI
M   0	   1298 	%FI %,
    0	   1299 
    0	   1300 
    0	   1301     $STR$DECLARE( type, name, string_info ) [] =
M   0	   1302 	%IF $xpo$key_test( type, (BIND, LOCAL), 'Type' )
M   0	   1303 	%THEN
M   0	   1304 	    %IF %ISSTRING( %REMOVE(string_info) )	! STRING = 'literal text'
M   0	   1305 	    %THEN
M   0	   1306 		OWN name :  %EXPAND $STR_DESCRIPTOR( STRING = %QUOTE %REMOVE(string_info) );
M   0	   1307 	    %ELSE
M   0	   1308 		%IF $xpo$paren_test( string_info )	! STRING = (length,pointer)
M   0	   1309 		%THEN
M   0	   1310 		    %IF %IDENTICAL(type,BIND)
M   0	   1311 		    %THEN
M   0	   1312 			BIND name = $STR_FORMAT( string_info );
M   0	   1313 		    %ELSE
M   0	   1314 			LOCAL name :  %EXPAND $xpo$force( $STR_DESCRIPTOR() VOLATILE );
M   0	   1315 		    %FI
M   0	   1316 		%ELSE
M   0	   1317 		    BIND name = string_info;		! STRING = address of a descriptor
M   0	   1318 		%FI
M   0	   1319 	    %FI
M   0	   1320 	%FI %,
    0	   1321 
    0	   1322 
    0	   1323     $STR$LOCAL_INIT( name, string_info ) [] =
M   0	   1324 	%IF NOT %ISSTRING( %REMOVE(string_info) ) AND $xpo$paren_test( string_info )
M   0	   1325 	%THEN
M   0	   1326 	    $str$str_desc( name, FIXED, string_info )
M   0	   1327 	%FI %,
    0	   1328 
    0	   1329 
    0	   1330     $STR_FREE_TEMP( string ) =
M   0	   1331 	BEGIN
M   0	   1332 	%EXPAND $xpo$force( $xpo$ex_routine( XST$FREE_TEMP ) )
M   0	   1333 
M   0	   1334 	XST$FREE_TEMP( string )
M   0	   1335 	END %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 27
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1337 !
    0	   1338 ! BINDESC - XPORT Binary Data Descriptor
    0	   1339 !
    0	   1340 ! This transportable data descriptor is modelled closely after the
    0	   1341 ! corresponding VAX-11 descriptor.
    0	   1342 !
    0	   1343 
    0	   1344 $FIELD	XPO$H_LENGTH	= [$BYTES(2)] ;			! Length of the binary data units
		; %PRINT:				  [0,0,16,0]   (+%X'0')
    0	   1345 
    0	   1346 FIELD	XPO$B_DTYPE	= [$BYTE] ;			! Atomic data type code:
		; %PRINT:				  [0,16,8,0]   (+%X'2')
    0	   1347 LITERAL	XPO$K_DTYPE_BU	= 2;				!    XPORT binary data (binary units)
    0	   1348 
    0	   1349 FIELD	XPO$B_CLASS	= [$BYTE] ;			! Descriptor class code:
		; %PRINT:				  [0,24,8,0]   (+%X'3')
    0	   1350 LITERAL	XPO$K_CLASS_Z	= 0,				!    unspecified
    0	   1351 	XPO$K_CLASS_F	= 1,				!    fixed binary data
    0	   1352 	XPO$K_CLASS_D	= 2,				!    dynamic binary data
    0	   1353 	XPO$K_CLASS_B	= 3,				!    bounded binary data
    0	   1354 	XPO$K_CLASS_DB	= 190;				!    dynamic bounded binary data
    0	   1355 
    0	   1356 FIELD	XPO$A_ADDRESS	= [$POINTER] ;			! Address of the binary data
		; %PRINT:				  [1,0,32,0]   (+%X'4')
    0	   1357 
    0	   1358 LITERAL	XPO$K_S_BLN	= $FIELD_SET_SIZE ,		! Length of a static descriptor
		; %PRINT:				  2 fullwords
    0	   1359 	XPO$K_D_BLN	= $FIELD_SET_SIZE ;		! Length of a dynamic descriptor
		; %PRINT:				  2 fullwords
    0	   1360 
    0	   1361 FIELD	XPO$H_MAXLEN	= [$BYTES(2)] ;			! Maximum length of the binary data
		; %PRINT:				  [2,0,16,0]   (+%X'8')
    0	   1362 FIELD	XPO$H_PFXLEN	= [$BYTES(2)] ;			! Length of the binary data prefix
		; %PRINT:				  [2,16,16,0]   (+%X'A')
    0	   1363 
    0	   1364 LITERAL	XPO$K_B_BLN	= $FIELD_SET_SIZE ,		! Length of a bounded descriptor
		; %PRINT:				  3 fullwords
    0	   1365 	XPO$K_DB_BLN	= $FIELD_SET_SIZE ,		! Length of a dynamic bounded descriptor
		; %PRINT:				  3 fullwords
    0	   1366 	XPO$K_Z_BLN	= $FIELD_SET_SIZE ;		! Maximum length of an undefined descriptor
		; %PRINT:				  3 fullwords
    0	   1367 
    0	   1368 ! End of BINDESC
    0	   1369 
    0	   1370 MACRO
    0	   1371     $xpo$f_fields =
M   0	   1372 	XPO$H_LENGTH, XPO$B_DTYPE, XPO$B_CLASS, XPO$A_ADDRESS %,
    0	   1373 
    0	   1374     $xpo$b_fields =
M   0	   1375 	%EXPAND $xpo$f_fields, XPO$H_MAXLEN, XPO$H_PFXLEN %;
    0	   1376 
    0	   1377 MACRO												! *** OBSOLETE ***
    0	   1378     XPO$K_DTYPE_Z =
M   0	   1379 	%INFORM( 'XPO$K_DTYPE_Z is an obsolete name - use XPO$K_DTYPE_BU' ) %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 28
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1381 !
    0	   1382 ! Binary Data Descriptor Declaration and Initialization Macros
    0	   1383 !
    0	   1384 
    0	   1385 MACRO
    0	   1386     $xpo$desc_class( class ) =
M   0	   1387 	%IF %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1388 	%THEN
M   0	   1389 	    XPO$K_CLASS_DB
M   0	   1390 	%ELSE
M   0	   1391 	    %NAME( %EXACTSTRING( 13, 0, 'XPO$K_CLASS_', class ) )
M   0	   1392 	%FI %;
    0	   1393 
    0	   1394 
    0	   1395 MACRO
    0	   1396     $XPO_DESC = $XPO_DESCRIPTOR %;
    0	   1397 
    0	   1398 
    0	   1399 KEYWORDMACRO
    0	   1400     $XPO_DESCRIPTOR(
    0	   1401 	class=FIXED,					! descriptor class
    0	   1402 	binary_data					! binary data descriptor
    0	   1403 	) =
M   0	   1404 
M   0	   1405 	%IF NOT $xpo$key_test( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED), 'CLASS=' )
M   0	   1406 	%THEN
M   0	   1407 	    %EXITMACRO
M   0	   1408 	%FI
M   0	   1409 
M   0	   1410 	%IF NOT %NULL(binary_data) AND NOT $xpo$paren_test(binary_data)
M   0	   1411 	%THEN
M   0	   1412 	    %WARN( 'BINARY_DATA=descriptor is not permitted' )
M   0	   1413 	    %EXITMACRO
M   0	   1414 	%FI
M   0	   1415 
M   0	   1416 	%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1417 	%THEN
M   0	   1418 	    BLOCK[XPO$K_B_BLN]  FIELD( %EXPAND $xpo$b_fields )
M   0	   1419 	%ELSE
M   0	   1420 	    BLOCK[XPO$K_S_BLN]  FIELD( %EXPAND $xpo$f_fields )
M   0	   1421 	%FI
M   0	   1422 
M   0	   1423 	%IF NOT %NULL(binary_data)
M   0	   1424 	%THEN
M   0	   1425 	    PRESET( [XPO$B_DTYPE] = XPO$K_DTYPE_BU,
M   0	   1426 		    [XPO$B_CLASS] = %EXPAND $xpo$desc_class(class),
M   0	   1427 		    [XPO$A_ADDRESS] = $xpo$arg2( %REMOVE(binary_data) ),
M   0	   1428 	    %IF %IDENTICAL(class,FIXED) OR %IDENTICAL(class,DYNAMIC)
M   0	   1429 	    %THEN
M   0	   1430 		    [XPO$H_LENGTH] = $xpo$bin_len( %REMOVE(binary_data) )
M   0	   1431 	    %ELSE
M   0	   1432 		    [XPO$H_MAXLEN] = $xpo$bin_len( %REMOVE(binary_data) )
M   0	   1433 	    %FI
M   0	   1434 	    )						! End of BINARY_DATA PRESET list
M   0	   1435 	%FI %,
    0	   1436 
    0	   1437 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 29
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1438     $XPO_DESC_INIT(
    0	   1439 	desc,						! address of descriptor
    0	   1440 	descriptor,					! address of descriptor
    0	   1441 	class=FIXED,					! descriptor class
    0	   1442 	binary_data					! binary data descriptor
    0	   1443 	) =
M   0	   1444 
M   0	   1445 	%IF NOT $xpo$key_test( class, (FIXED, DYNAMIC, BOUNDED, DYNAMIC_BOUNDED), 'CLASS=' )
M   0	   1446 	%THEN
M   0	   1447 	    %EXITMACRO
M   0	   1448 	%FI
M   0	   1449 
M   0	   1450 	%IF NOT %NULL(binary_data) AND NOT $xpo$paren_test(binary_data)
M   0	   1451 	%THEN
M   0	   1452 	    %WARN( 'BINARY_DATA=descriptor is not permitted' )
M   0	   1453 	    %EXITMACRO
M   0	   1454 	%FI
M   0	   1455 
M   0	   1456 	%IF $xpo$conflict( desc, descriptor )
M   0	   1457 	%THEN
M   0	   1458 	    %WARN( 'DESC= and DESCRIPTOR= are mutually exclusive' )
M   0	   1459 	%FI
M   0	   1460 
M   0	   1461 	%EXPAND $xpo$required( desc descriptor, 'DESC= or DESCRIPTOR=' )
M   0	   1462 
M   0	   1463 	BEGIN
M   0	   1464 	BIND $xpo$desc = descriptor :  %EXPAND $xpo$force( $XPO_DESCRIPTOR( %QUOTE CLASS=BOUNDED ) );
M   0	   1465 
M   0	   1466 	%IF %NULL( binary_data )
M   0	   1467 	%THEN
M   0	   1468 	    $xpo$desc[XPO$H_LENGTH] = 0;
M   0	   1469 	    $xpo$desc[XPO$B_DTYPE] = XPO$K_DTYPE_BU;
M   0	   1470 	    $xpo$desc[XPO$B_CLASS] = $xpo$desc_class( class );
M   0	   1471 	    $xpo$desc[XPO$A_ADDRESS] = 0;
M   0	   1472 	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1473 	    %THEN
M   0	   1474 		$xpo$desc[XPO$H_MAXLEN] = 0;
M   0	   1475 		$xpo$desc[XPO$H_PFXLEN] = 0;
M   0	   1476 	    %FI
M   0	   1477 	%ELSE
M   0	   1478 	    $xpo$bin_desc( $xpo$desc, class, binary_data )
M   0	   1479 	%FI
M   0	   1480 
M   0	   1481 	XPO$_NORMAL					! normal completion code
M   0	   1482 	END %;
    0	   1483 
    0	   1484 MACRO
    0	   1485     $XPO$BIN_DESC( desc, class, data_desc ) [] =
M   0	   1486 
M   0	   1487 	%IF NOT %NULL( $xpo$arg3( %REMOVE(data_desc) ) )
M   0	   1488 	%THEN
M   0	   1489 	    %IF NOT $xpo$key_test( $xpo$arg3( %REMOVE(data_desc) ), (FULLWORDS, UNITS) )
M   0	   1490 	    %THEN
M   0	   1491 		%EXITMACRO
M   0	   1492 	    %FI
M   0	   1493 	%FI
M   0	   1494 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 30
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1495 	%IF NOT $xpo$paren_test( data_desc )
M   0	   1496 	%THEN
M   0	   1497 	    BEGIN
M   0	   1498 	    BIND $bin$$desc = data_desc :  %EXPAND $xpo$force( $XPO_DESCRIPTOR() );
M   0	   1499 		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1500 		%THEN
M   0	   1501 		    desc[XPO$H_LENGTH] = 0;
M   0	   1502 		%ELSE
M   0	   1503 		    desc[XPO$H_LENGTH] = .$bin$$desc[XPO$H_LENGTH];
M   0	   1504 		%FI
M   0	   1505 	    desc[XPO$B_DTYPE] = .$bin$$desc[XPO$B_DTYPE];
M   0	   1506 	    desc[XPO$B_CLASS] = %EXPAND $xpo$desc_class( class );
M   0	   1507 	    desc[XPO$A_ADDRESS] = .$bin$$desc[XPO$A_ADDRESS];
M   0	   1508 		%IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1509 		%THEN
M   0	   1510 		    desc[XPO$H_MAXLEN] =.$bin$$desc[XPO$H_LENGTH];
M   0	   1511 		    desc[XPO$H_PFXLEN] = 0;
M   0	   1512 		%FI
M   0	   1513 	    END;
M   0	   1514 	%ELSE
M   0	   1515 	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1516 	    %THEN
M   0	   1517 		desc[XPO$H_LENGTH] = 0;
M   0	   1518 	    %ELSE
M   0	   1519 		desc[XPO$H_LENGTH] = $xpo$bin_len( %REMOVE(data_desc) );
M   0	   1520 	    %FI
M   0	   1521 	    desc[XPO$B_DTYPE] = XPO$K_DTYPE_BU;
M   0	   1522 	    desc[XPO$B_CLASS] = %EXPAND $xpo$desc_class( class );
M   0	   1523 	    desc[XPO$A_ADDRESS] = $xpo$arg2( %REMOVE(data_desc) );
M   0	   1524 	    %IF %IDENTICAL(class,BOUNDED) OR %IDENTICAL(class,DYNAMIC_BOUNDED)
M   0	   1525 	    %THEN
M   0	   1526 		desc[XPO$H_MAXLEN] = $xpo$bin_len( %REMOVE(data_desc) );
M   0	   1527 		desc[XPO$H_PFXLEN] = 0;
M   0	   1528 	    %FI
M   0	   1529 	%FI %,
    0	   1530 
    0	   1531 
    0	   1532     $xpo$bin_len( length, address, keyword ) =
M   0	   1533 	%IF %IDENTICAL( keyword, UNITS )
M   0	   1534 	%THEN
M   0	   1535 	    length
M   0	   1536 	%ELSE
M   0	   1537 	    %UPVAL * (length)
M   0	   1538 	%FI %,
    0	   1539 
    0	   1540 
    0	   1541     $BIN$DECLARE( name, binary_info ) [] =
M   0	   1542 	%IF $xpo$paren_test( binary_info )		! BINARY_DATA = (length,pointer)
M   0	   1543 	%THEN
M   0	   1544 	    LOCAL name :  %EXPAND $xpo$force( $XPO_DESCRIPTOR() VOLATILE );
M   0	   1545 	%ELSE
M   0	   1546 	    BIND name = binary_info;			! BINARY_DATA = address of a descriptor
M   0	   1547 	%FI %,
    0	   1548 
    0	   1549 
    0	   1550     $BIN$LOCAL_INIT( name, binary_info ) [] =
M   0	   1551 	%IF $xpo$paren_test( binary_info )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 31
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1552 	%THEN
M   0	   1553 	    $xpo$bin_desc( name, FIXED, binary_info )
M   0	   1554 	%FI %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 32
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1556 !
    0	   1557 ! TIME_BLOCK - XPORT Date and Time Block
    0	   1558 !
    0	   1559 
    0	   1560 	    $SHOW( NOINFO )				! Turn off BLISS-16 %INFORM messages
    0	   1561 
    0	   1562 $FIELD	$xpo$dt_fields = SET
    0	   1563 	XPO$G_DATE	= [$LONG_INTEGER] ,		! Day number (0 = ??????)
		; %PRINT:				  [0,0,32,1]   (+%X'0')
    0	   1564 	XPO$B_MONTH	= [$BYTE] ,			! Month number (1 = January, ...)
		; %PRINT:				  [1,0,8,0]   (+%X'4')
    0	   1565 	XPO$B_DAY	= [$BYTE] ,			! Day of month
		; %PRINT:				  [1,8,8,0]   (+%X'5')
    0	   1566 	XPO$B_YEAR	= [$BYTES(2)] ,			! Year (e.g., 1979)
		; %PRINT:				  [1,16,16,0]   (+%X'6')
    0	   1567 
    0	   1568 	XPO$G_TIME	= [$LONG_INTEGER] ,		! Time of day (100ths of second since midnight)
		; %PRINT:				  [2,0,32,1]   (+%X'8')
    0	   1569 	XPO$B_HOUR	= [$BYTE] ,			! Hours since midnight
		; %PRINT:				  [3,0,8,0]   (+%X'C')
    0	   1570 	XPO$B_MINUTE	= [$BYTE] ,			! Minutes since last hour
		; %PRINT:				  [3,8,8,0]   (+%X'D')
    0	   1571 	XPO$B_100THS	= [$BYTES(2)]			! 100ths of second since last minute
		; %PRINT:				  [3,16,16,0]   (+%X'E')
    0	   1572 	TES;
    0	   1573 LITERAL	XPO$K_TIME_LEN	= $FIELD_SET_SIZE;		! Length of date/time block
		; %PRINT:				  4 fullwords
    0	   1574 
    0	   1575 	    $SHOW( INFO )				! Turn %INFORM messages back on
    0	   1576 
    0	   1577 
    0	   1578 MACRO
    0	   1579     $XPO_TIME_BLOCK =
M   0	   1580 	BLOCK[XPO$K_TIME_LEN]  FIELD( $xpo$dt_fields ) %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 33
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1582 !
    0	   1583 ! XIOB - XPORT File I/O Block
    0	   1584 !
    0	   1585 !	CBDOC: FUNCTION codes in comments
    0	   1586 !
    0	   1587 
    0	   1588 $FIELD	$iob$fields_1 = SET
    0	   1589 	IOB$H_LENGTH	= [$SHORT_INTEGER] ,		! Length of IOB (number of elements) >all <init
		; %PRINT:				  [0,0,16,1]   (+%X'0')
    0	   1590 	IOB$B_VERSION	= [$TINY_INTEGER] ,		! XPORT version number <init
		; %PRINT:				  [0,16,8,1]   (+%X'2')
    0	   1591 	IOB$B_LEVEL	= [$TINY_INTEGER] ,		! XPORT base level number <init
		; %PRINT:				  [0,24,8,1]   (+%X'3')
    0	   1592 	IOB$A_FILE_SPEC	= [$REF_DESCRIPTOR] ,		! Address of primary file specification descriptor >open, de
    0	   1592 lete, rename
		; %PRINT:				  [1,0,32,0]   (+%X'4')
    0	   1593 	IOB$A_DEFAULT	= [$REF_DESCRIPTOR] ,		! Address of default file specification descriptor >open, de
    0	   1593 lete, rename
		; %PRINT:				  [2,0,32,0]   (+%X'8')
    0	   1594 	IOB$A_RELATED	= [$REF_DESCRIPTOR] ,		! Address of related file specification descriptor >open, de
    0	   1594 lete, rename
		; %PRINT:				  [3,0,32,0]   (+%X'C')
    0	   1595 	IOB$T_CONCAT	= [$DESCRIPTOR(DYNAMIC_BOUNDED)],	! Concatenated input file specificationdescriptor >o
    0	   1595 pen <open
		; %PRINT:				  [4,0,0,0]   (+%X'10')
    0	   1596 	IOB$T_RESULTANT	= [$DESCRIPTOR(DYNAMIC)] ,	! Resultant file specification descriptor >close, backup <op
    0	   1596 en, delete,
		; %PRINT:				  [7,0,0,0]   (+%X'1C')
    0	   1597 	IOB$A_PROMPT	= [$REF_DESCRIPTOR] ,		! Address of read prompt descriptor >get-char
		; %PRINT:				  [9,0,32,0]   (+%X'24')
    0	   1598 
    0	   1599 	IOB$A_ASSOC_IOB	= [$ADDRESS] ,			! Address of associated IOB >backup, rename
		; %PRINT:				  [10,0,32,0]   (+%X'28')
    0	   1600 
    0	   1601 	IOB$B_FUNCTION	= [$BYTE]			! I/O function code: >all
		; %PRINT:				  [11,0,8,0]   (+%X'2C')
    0	   1602 	TES;						!
    0	   1603 $LITERAL
    0	   1604 	IOB$K_OPEN	= $DISTINCT ,			!    open file
		; %PRINT:				  1
    0	   1605 	IOB$K_CLOSE	= $DISTINCT ,			!    close file
		; %PRINT:				  2
    0	   1606 	IOB$K_DELETE	= $DISTINCT ,			!    delete file
		; %PRINT:				  3
    0	   1607 	IOB$K_RENAME	= $DISTINCT ,			!    rename file
		; %PRINT:				  4
    0	   1608 	IOB$K_BACKUP	= $DISTINCT ,			!    create backup copy of input file
		; %PRINT:				  5
    0	   1609 	IOB$K_GET	= $DISTINCT ,			!    get record (locate mode)
		; %PRINT:				  6
    0	   1610 	IOB$K_PUT	= $DISTINCT ;			!    put record (move mode)
		; %PRINT:				  7
    0	   1611 
    0	   1612 	    $ALIGN( WORD )
    0	   1613 FIELD	$iob$fields_2 = SET
    0	   1614 	IOB$V_OPTIONS	= [$BITS(16)] ,			! I/O option flags:
		; %PRINT:				  [11,16,16,0]   (+%X'2E')

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 34
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1615 	    $OVERLAY( IOB$V_OPTIONS )			!
    0	   1616 	IOB$V_INPUT	= [$BIT] ,			!    open for input >open, get
		; %PRINT:				  [11,16,1,0]   (+%X'2E')
    0	   1617 	IOB$V_OUTPUT	= [$BIT] ,			!    open for output >open, put
		; %PRINT:				  [11,17,1,0]   (+%X'2E')
    0	   1618 	IOB$V_OVERWRITE	= [$BIT] ,			!    overwrite existing output file >open-out
		; %PRINT:				  [11,18,1,0]   (+%X'2E')
    0	   1619 	IOB$V_APPEND	= [$BIT] ,			!    append to existing output file >open-out
		; %PRINT:				  [11,19,1,0]   (+%X'2E')
    0	   1620 	IOB$V_REMEMBER	= [$BIT] ,			!    file will be reprocessed after close >close
		; %PRINT:				  [11,20,1,0]   (+%X'2E')
    0	   1621 	IOB$V_MAX_VERSI	= [$BIT] ,			!    maximize file version number (internal) >open, rename
		; %PRINT:				  [11,21,1,0]   (+%X'2E')
    0	   1622 	    $CONTINUE
    0	   1623 
    0	   1624 	    $ALIGN( WORD )
    0	   1625 	IOB$V_ATTRIBUTE	= [$BITS(16)] ,			! File attributes:
		; %PRINT:				  [12,0,16,0]   (+%X'30')
    0	   1626 	    $OVERLAY( IOB$V_ATTRIBUTE )			!
    0	   1627 	IOB$V_BINARY	= [$BIT] ,			!    binary data >open, get, put
		; %PRINT:				  [12,0,1,0]   (+%X'30')
    0	   1628         IOB$V_RANDOM    = [$BIT] ,                      !    random access data >open, get, put
		; %PRINT:				  [12,1,1,0]   (+%X'30')
    0	   1629 	IOB$V_STREAM	= [$BIT] ,			!    stream-oriented character data >open, get, put
		; %PRINT:				  [12,2,1,0]   (+%X'30')
    0	   1630 	IOB$V_RECORD	= [$BIT] ,			!    record-oriented character data >open, get, put
		; %PRINT:				  [12,3,1,0]   (+%X'30')
    0	   1631 	IOB$V_SEQUENCED	= [$BIT] ,			!    sequence-numbered records >open-out, put <open-in
		; %PRINT:				  [12,4,1,0]   (+%X'30')
    0	   1632 	    $CONTINUE
    0	   1633 
    0	   1634 	    $ALIGN( WORD )
    0	   1635 	IOB$V_STATUS	= [$BITS(16)] ,			! Current file status:
		; %PRINT:				  [12,16,16,0]   (+%X'32')
    0	   1636 	    $OVERLAY( IOB$V_STATUS )			!
    0	   1637 	IOB$V_OPEN	= [$BIT] ,			!    file is open >all <open
		; %PRINT:				  [12,16,1,0]   (+%X'32')
    0	   1638 	IOB$V_EOF	= [$BIT] ,			!    end-of-file detected >get, put <get, put
		; %PRINT:				  [12,17,1,0]   (+%X'32')
    0	   1639 	IOB$V_CLOSED	= [$BIT] ,			!    file is closed >open <close
		; %PRINT:				  [12,18,1,0]   (+%X'32')
    0	   1640 	IOB$V_AUTO_CONC	= [$BIT] ,			!    input file switching in progress >open <get-conc
		; %PRINT:				  [12,19,1,0]   (+%X'32')
    0	   1641 	IOB$V_TERMINAL	= [$BIT] ,			!    I/O device is a terminal >get, put <open
		; %PRINT:				  [12,20,1,0]   (+%X'32')
    0	   1642 	IOB$V_TEMPORARY	= [$BIT] ,			!    XPORT temporary file >open, close <open
		; %PRINT:				  [12,21,1,0]   (+%X'32')
    0	   1643 	IOB$V_CONC_SPEC	= [$BIT] ,			!    primary file-spec is a concatenated file-spec >close <o
    0	   1643 pen
		; %PRINT:				  [12,22,1,0]   (+%X'32')
    0	   1644     	IOB$V_CH_ASSIGN = [$BIT] ,			!    channel has been assigned >open, delete, rename <open, 
    0	   1644 delete, rename
		; %PRINT:				  [12,23,1,0]   (+%X'32')
    0	   1645 	    $CONTINUE
    0	   1646 
    0	   1647 	IOB$T_STRING	= [$DESCRIPTOR(DYNAMIC_BOUNDED)] ,	! Character input string descriptor:
		; %PRINT:				  [13,0,0,0]   (+%X'34')

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 35
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1648 	    $OVERLAY( $SUB_FIELD(IOB$T_STRING,STR$H_LENGTH) )
    0	   1649 	IOB$H_STRING	= [$BYTES(2)] ,			!    length of the character string >get-stream <get-char
		; %PRINT:				  [13,0,16,0]   (+%X'34')
    0	   1650 	    $OVERLAY( $SUB_FIELD(IOB$T_STRING,STR$A_POINTER) )
    0	   1651 	IOB$A_STRING	= [$POINTER] ,			!    pointer to the character string <get-char
		; %PRINT:				  [14,0,32,0]   (+%X'38')
    0	   1652 	    $CONTINUE
    0	   1653 
    0	   1654 	    $OVERLAY( IOB$T_STRING )
    0	   1655 	IOB$T_DATA	= [$DESCRIPTOR(DYNAMIC_BOUNDED)] ,	! Binary input data descriptor (overlays IOB$T_STRIN
    0	   1655 G):
		; %PRINT:				  [13,0,0,0]   (+%X'34')
    0	   1656 	    $OVERLAY( $SUB_FIELD(IOB$T_DATA,STR$H_LENGTH) )
    0	   1657 	IOB$H_UNITS	= [$BYTES(2)] ,			!    length of the data in addressable units >get-bin <get-b
    0	   1657 in
		; %PRINT:				  [13,0,16,0]   (+%X'34')
    0	   1658 	    $OVERLAY( $SUB_FIELD(IOB$T_DATA,XPO$A_ADDRESS) )
    0	   1659 	IOB$A_DATA	= [$ADDRESS] ,			!    address of the data <get-bin
		; %PRINT:				  [14,0,32,0]   (+%X'38')
    0	   1660 	    $CONTINUE
    0	   1661 
    0	   1662 	IOB$H_FULLWORDS	= [$BYTES(2)] ,			!    length of the data in BLISS fullwords <get-full
		; %PRINT:				  [16,0,16,0]   (+%X'40')
    0	   1663 
    0	   1664 	    $ALIGN( FULLWORD )
    0	   1665 	IOB$A_OUTPUT	= [$REF_DESCRIPTOR] ,		! Address of character/binary output descriptor >put
		; %PRINT:				  [17,0,32,0]   (+%X'44')
    0	   1666 
    0	   1667 	    $OVERLAY( IOB$A_OUTPUT )
    0	   1668 	IOB$A_BACK_TYPE	= [$REF_DESCRIPTOR] ,		! Address of backup file type descriptor (overlays IOB$A_OUT
    0	   1668 PUT) >backup
		; %PRINT:				  [17,0,32,0]   (+%X'44')
    0	   1669 
    0	   1670 	$IOB$FILLER0	= [$SHORT_INTEGER] ,		! Reserved for future use
		; %PRINT:				  [18,0,16,1]   (+%X'48')
    0	   1671 	IOB$H_PAGE_NUMB	= [$SHORT_INTEGER] ,		! Current page number <get-seq
		; %PRINT:				  [18,16,16,1]   (+%X'4A')
    0	   1672 	    $ALIGN( FULLWORD )
    0	   1673 	IOB$G_SEQ_NUMB	= [$INTEGER] ,			! Sequence number of current record >put-seq <get
		; %PRINT:				  [19,0,32,1]   (+%X'4C')
    0	   1674 	IOB$G_CURR_POS	= [$INTEGER] ,			! Position in file of data most recently read or written <ge
    0	   1674 t, put
		; %PRINT:				  [20,0,32,1]   (+%X'50')
    0	   1675 	IOB$G_NEXT_POS	= [$INTEGER] ,			! Position in file of next data to read or write >get, put <
    0	   1675 get, put
		; %PRINT:				  [21,0,32,1]   (+%X'54')
    0	   1676 	IOB$G_REC_SIZE	= [$INTEGER] ,			! Fixed record size (0 = variable length records) >open-out 
    0	   1676 <open
		; %PRINT:				  [22,0,32,1]   (+%X'58')
    0	   1677 	IOB$G_BLK_SIZE	= [$INTEGER] ,			! Block size >open-out <open
		; %PRINT:				  [23,0,32,1]   (+%X'5C')
    0	   1678 
    0	   1679 	IOB$Z_CREATED	= [$SUB_BLOCK(XPO$K_TIME_LEN)],	! File creation date and time (future)
		; %PRINT:				  [24,0,0,0]   (+%X'60')
    0	   1680 	IOB$Z_REVISED	= [$SUB_BLOCK(XPO$K_TIME_LEN)],	! File revision date and time (future)
		; %PRINT:				  [28,0,0,0]   (+%X'70')
    0	   1681 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 36
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1682 	$IOB$FILLER1	= [$SUB_BLOCK(16)] ,		! Reserved for future use
		; %PRINT:				  [32,0,0,0]   (+%X'80')
    0	   1683 	$IOB$FILLER2	= [$SHORT_INTEGER] ,		! Reserved for future use
		; %PRINT:				  [48,0,16,1]   (+%X'C0')
    0	   1684 	$IOB$FILLER3	= [$SHORT_INTEGER] ,		! Reserved for future use
		; %PRINT:				  [48,16,16,1]   (+%X'C2')
    0	   1685 	$IOB$FILLER4	= [$SHORT_INTEGER] ,		! Reserved for future use
		; %PRINT:				  [49,0,16,1]   (+%X'C4')
    0	   1686 	$IOB$FILLER5	= [$SHORT_INTEGER] ,		! Reserved for future use
		; %PRINT:				  [49,16,16,1]   (+%X'C6')
    0	   1687 	$IOB$FILLER6	= [$INTEGER] ,			! Reserved for future use
		; %PRINT:				  [50,0,32,1]   (+%X'C8')
    0	   1688 	$IOB$FILLER7	= [$INTEGER] ,			! Reserved for future use
		; %PRINT:				  [51,0,32,1]   (+%X'CC')
    0	   1689 	$IOB$FILLER8	= [$INTEGER] ,			! Reserved for future use
		; %PRINT:				  [52,0,32,1]   (+%X'D0')
    0	   1690 	$IOB$FILLER9	= [$INTEGER] ,			! Reserved for future use
		; %PRINT:				  [53,0,32,1]   (+%X'D4')
    0	   1691 
    0	   1692 	IOB$G_COMP_CODE	= [$INTEGER] ,			! Completion code of current operation <all
		; %PRINT:				  [54,0,32,1]   (+%X'D8')
    0	   1693 	IOB$G_2ND_CODE	= [$INTEGER] ,			! Secondary completion code <all
		; %PRINT:				  [55,0,32,1]   (+%X'DC')
    0	   1694 
    0	   1695 	IOB$Z_USER	= [$INTEGER] ,			! User-defined value
		; %PRINT:				  [56,0,32,1]   (+%X'E0')
    0	   1696 	IOB$G_USER_CODE	= [$INTEGER] ,			! User-defined completion code
		; %PRINT:				  [57,0,32,1]   (+%X'E4')
    0	   1697 
    0	   1698 	IOB$A_BUFFER_CB	= [$ADDRESS] ,			! Address of TOPS-10 buffer control block >get, put <open
		; %PRINT:				  [58,0,32,0]   (+%X'E8')
    0	   1699 	    $OVERLAY( IOB$A_BUFFER_CB )
    0	   1700 	IOB$A_RMS_FAB	= [$ADDRESS] ,			! Address of RMS FAB (system-specific) >close <open
		; %PRINT:				  [58,0,32,0]   (+%X'E8')
    0	   1701 	IOB$A_RMS_RAB	= [$ADDRESS] ,			! Address of RMS RAB (system-specific) >get, put <open
		; %PRINT:				  [59,0,32,0]   (+%X'EC')
    0	   1702 	    $OVERLAY( IOB$A_BUFFER_CB )
    0	   1703 	IOB$A_FCS_FDB	= [$ADDRESS] ,			! Address of FCS FDB (system-specific) >get put close <open
		; %PRINT:				  [58,0,32,0]   (+%X'E8')
    0	   1704 	    $CONTINUE
    0	   1705 	    $OVERLAY( IOB$A_BUFFER_CB )
    0	   1706 	IOB$A_RSTS_CB	= [$ADDRESS] ,			! Address of RSTS control block >get put close <open
		; %PRINT:				  [58,0,32,0]   (+%X'E8')
    0	   1707 	    $CONTINUE
    0	   1708 	IOB$H_CHANNEL	= [$SHORT_INTEGER]		! I/O channel number (system-specific) >get put close <open
		; %PRINT:				  [60,0,16,1]   (+%X'F0')
    0	   1709 	TES;
    0	   1710 LITERAL	IOB$K_LENGTH	= $FIELD_SET_SIZE ;		! Length of standard IOB >init
		; %PRINT:				  61 fullwords
    0	   1711 
    0	   1712 ! End of XIOB
    0	   1713 
    0	   1714 MACRO	$iob$fields =					! Define entire IOB field set
M   0	   1715 		$iob$fields_1, $iob$fields_2 %;
    0	   1716 
    0	   1717 MACRO
    0	   1718     IOB$T_FILE_SPEC =

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 37
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1719 	%WARN( 'IOB$T_FILE_SPEC (descriptor) has been replaced by IOB$A_FILE_SPEC (address of descriptor)' )
M   0	   1720 	IOB$T_RESULTANT %,
    0	   1721 
    0	   1722     IOB$T_DEFAULT =
M   0	   1723 	%WARN( 'IOB$T_DEFAULT (descriptor) has been replaced by IOB$A_DEFAULT (address of descriptor)' )
M   0	   1724 	IOB$T_RESULTANT %,
    0	   1725 
    0	   1726     IOB$T_RELATED =
M   0	   1727 	%WARN( 'IOB$T_RELATED (descriptor) has been replaced by IOB$A_RELATED (address of descriptor)' )
M   0	   1728 	IOB$T_RESULTANT %,
    0	   1729 
    0	   1730     IOB$T_PROMPT =
M   0	   1731 	%WARN( 'IOB$T_PROMPT (descriptor) has been replaced by IOB$A_PROMPT (address of descriptor)' )
M   0	   1732 	IOB$T_RESULTANT %,
    0	   1733 
    0	   1734     IOB$T_OUTPUT =
M   0	   1735 	%WARN( 'IOB$T_OUTPUT (descriptor) has been replaced by IOB$A_OUTPUT (address of descriptor)' )
M   0	   1736 	IOB$T_RESULTANT %,
    0	   1737 
    0	   1738     IOB$T_BACK_TYPE =
M   0	   1739 	%WARN( 'IOB$T_BACK_TYPE (descriptor) has been replaced by IOB$A_BACK_TYPE (address of descriptor)' )
M   0	   1740 	IOB$T_RESULTANT %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 38
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1742 !
    0	   1743 ! XPORT I/O Control Block and Interface Macros
    0	   1744 !
    0	   1745 
    0	   1746 MACRO
    0	   1747     $IOB$NOT_ALLOWED( keyword, value, function ) =
M   0	   1748 	%IF NOT %NULL( value )
M   0	   1749 	%THEN
M   0	   1750 	    %WARN( keyword, ' may not be specified during IOB ', function )
M   0	   1751 	%FI %,
    0	   1752 
    0	   1753     $IOB$STRING( field_name, string_name, string_info ) [] =
M   0	   1754 	iob$[ field_name ] = string_name; %,
    0	   1755 
    0	   1756 
    0	   1757     $IOB$GET_LENGTH( data_code, value ) [] =
M   0	   1758 	iob$[IOB$H_STRING] = value;
M   0	   1759 	iob$[ %EXPAND $xpo$force( $SUB_FIELD(IOB$T_STRING,STR$B_DTYPE) ) ] = data_code; %,
    0	   1760 
    0	   1761 
    0	   1762     $XPO$IO_CALL( function, success, failure ) =
M   0	   1763 
M   0	   1764 	%IF %IDENTICAL( failure, XPO$IO_FAIL_MSG )
M   0	   1765 	%THEN
M   0	   1766 	    %WARN( 'FAILURE=XPO$IO_FAIL_MSG is obsolete - FAILURE=XPO$FAILURE is now the default' )
M   0	   1767 	%FI
M   0	   1768 
M   0	   1769 	iob$[IOB$B_FUNCTION] = %QUOTE %EXPAND %NAME( 'IOB$K_', function );
M   0	   1770 
M   0	   1771 	BEGIN
M   0	   1772 
M   0	   1773 	%QUOTE %EXPAND $xpo$force( $xpo$ex_routine( %QUOTE %EXPAND %NAME('XPO$',function) ) )
M   0	   1774 
M   0	   1775 	%EXPAND $xpo$ex_failure( failure )
M   0	   1776 
M   0	   1777 	%QUOTE %EXPAND %NAME('XPO$',function)( iob$,
M   0	   1778 						%EXPAND $XPO$DEFAULT(success,0),
M   0	   1779 						%EXPAND $XPO$DEFAULT(failure,0) )
M   0	   1780 
M   0	   1781 	END %;
    0	   1782 
    0	   1783 
    0	   1784 KEYWORDMACRO
    0	   1785     $XPO_IOB(
    0	   1786 	file_spec,					! primary file specification information
    0	   1787 	default,					! default file specification information
    0	   1788 	related,					! related file specification information
    0	   1789 	option,						! option keyword
    0	   1790 	options,					! option keywords
    0	   1791 	attribute,					! file attribute keywords
    0	   1792 	attributes,					! file attribute keywords
    0	   1793 	prompt,						! read prompt string information
    0	   1794 	binary_data,					! binary data information
    0	   1795 	string,						! character string information
    0	   1796 	characters,					! length of I/O request
    0	   1797 	fullwords,					! length of I/O request
    0	   1798 	units,						! length of I/O request

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 39
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   1799 	position,					! position in file of I/O request
    0	   1800 	page_number,					! page number			! *** OBSOLETE ***
    0	   1801 	sequence_number,				! record sequence number
    0	   1802 	record_size,					! maximum record size
    0	   1803 	block_size,					! physical block size
    0	   1804 	user						! user-specified value
    0	   1805 	) =
M   0	   1806 
M   0	   1807 	%IF NOT %NULL( page_number )							! *** OBSOLETE ***
M   0	   1808 	%THEN										! *** OBSOLETE ***
M   0	   1809 	    %INFORM( 'PAGE_NUMBER= parameter is no longer supported' )			! *** OBSOLETE ***
M   0	   1810 	%FI										! *** OBSOLETE ***
M   0	   1811 
M   0	   1812 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   1813 	%THEN
M   0	   1814 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   1815 	%FI
M   0	   1816 
M   0	   1817 	%IF %EXPAND $xpo$conflict( attribute, attributes )
M   0	   1818 	%THEN
M   0	   1819 	    %WARN( 'ATTRIBUTE= and ATTRIBUTES= are mutually exclusive' )
M   0	   1820 	%FI
M   0	   1821 
M   0	   1822 	%IF %EXPAND $xpo$conflict( (characters,sequence_number), (fullwords,units,position) )
M   0	   1823 	%THEN
M   0	   1824 	    %WARN( 'Character and binary or random parameters are mutually exclusive' )
M   0	   1825 	%FI
M   0	   1826 
M   0	   1827 	%IF %EXPAND $xpo$conflict( (units), (fullwords) )
M   0	   1828 	%THEN
M   0	   1829 	    %WARN( 'FULLWORDS= and UNITS= are mutually exclusive' )
M   0	   1830 	%FI
M   0	   1831 
M   0	   1832 	%EXPAND $iob$not_allowed( 'STRING=', string, 'declaration' )
M   0	   1833 	%EXPAND $iob$not_allowed( 'BINARY_DATA=', binary_data, 'declaration' )
M   0	   1834 
M   0	   1835 	BLOCK[IOB$K_LENGTH]  FIELD( %EXPAND $iob$fields )
M   0	   1836 
M   0	   1837 	%IF %EXPAND $xpo$conflict( 1, (file_spec,default,related,option,options,attribute,attributes,prompt,
P   0	   1838 			characters,fullwords,units,position,sequence_number,
P   0	   1839 			record_size,block_size,user) )
M   0	   1840 	%THEN
M   0	   1841 	    %WARN( 'Static IOB initialization not yet supported' )
M   0	   1842 	%FI %,
    0	   1843 
    0	   1844 
    0	   1845     $XPO_BACKUP(
    0	   1846 	old_iob,					! address of the input file IOB
    0	   1847 	new_iob,					! address of the output file IOB
    0	   1848 	file_type='.BAK',				! file_type information
    0	   1849 	success,					! address of success action routine
    0	   1850 	failure=XPO$FAILURE				! address of failure action routine
D   0	   1851 	) =
M   0	   1852 
M   0	   1853 	%EXPAND $xpo$required( old_iob, 'OLD_IOB=' )
M   0	   1854 	%EXPAND $xpo$required( new_iob, 'NEW_IOB=' )
M   0	   1855 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 40
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1856 	BEGIN
M   0	   1857 	BIND iob$ = old_iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   1858 
M   0	   1859 	$str$declare( LOCAL, $iob$back_type, file_type )
M   0	   1860 	$str$local_init( $iob$back_type, file_type )
M   0	   1861 
M   0	   1862 	$iob$string( IOB$A_BACK_TYPE, $iob$back_type, file_type )	! FILE_TYPE=
M   0	   1863 	$xpo$value( iob$, A_ASSOC_IOB, new_iob )			! NEW_IOB=
M   0	   1864 
M   0	   1865 	%EXPAND $xpo$io_call( %QUOTE BACKUP, success, failure )
M   0	   1866 	END %,
    0	   1867 
    0	   1868 
    0	   1869     $XPO_CLOSE(
    0	   1870 	iob,						! address of IOB
    0	   1871 	option,						! option keywords
    0	   1872 	options,					! option keywords
    0	   1873 	user,						! user-specified value
    0	   1874 	success,					! address of success action routine
    0	   1875 	failure=XPO$FAILURE				! address of failure action routine
D   0	   1876 	) =
M   0	   1877 
M   0	   1878 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   1879 	%THEN
M   0	   1880 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   1881 	%FI
M   0	   1882 
M   0	   1883 	%EXPAND $xpo$required( iob, 'IOB=' )
M   0	   1884 
M   0	   1885 	BEGIN
M   0	   1886 	BIND iob$ = iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   1887 
M   0	   1888 	$xpo$keyword( iob$, %REMOVE(option) %REMOVE(options) )		! OPTION= or OPTIONS=
M   0	   1889 	$xpo$value( iob$, Z_USER, user )				! USER=
M   0	   1890 
M   0	   1891 	%EXPAND $xpo$io_call( %QUOTE CLOSE, success, failure )
M   0	   1892 	END %,
    0	   1893 
    0	   1894 
    0	   1895     $XPO_DELETE(
    0	   1896 	iob,						! address of IOB
    0	   1897 	file_spec,					! primary file specification information
    0	   1898 	default,					! default file specification information
    0	   1899 	related,					! related file specification information
    0	   1900 	user,						! user-specified value
    0	   1901 	success,					! address of success action routine
    0	   1902 	failure=XPO$FAILURE				! address of failure action routine
D   0	   1903 	) =
M   0	   1904 
M   0	   1905 	%EXPAND $xpo$required( iob, 'IOB=' )
M   0	   1906 
M   0	   1907 	BEGIN
M   0	   1908 	BIND iob$ = iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   1909 
M   0	   1910 	$str$declare( LOCAL, $iob$file_spec, file_spec )
M   0	   1911 	$str$declare( LOCAL, $iob$default, default )
M   0	   1912 	$str$declare( LOCAL, $iob$related, related )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 41
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1913 
M   0	   1914 	$str$local_init( $iob$file_spec, file_spec )
M   0	   1915 	$str$local_init( $iob$default, default )
M   0	   1916 	$str$local_init( $iob$related, related )
M   0	   1917 
M   0	   1918 	$iob$string( IOB$A_FILE_SPEC, $iob$file_spec, file_spec )	! FILE_SPEC=
M   0	   1919 	$iob$string( IOB$A_DEFAULT, $iob$default, default )		! DEFAULT=
M   0	   1920 	$iob$string( IOB$A_RELATED, $iob$related, related )		! RELATED=
M   0	   1921 	$xpo$value( iob$, Z_USER, user )				! USER=
M   0	   1922 
M   0	   1923 	%EXPAND $xpo$io_call( %QUOTE DELETE, success, failure )
M   0	   1924 	END %,
    0	   1925 
    0	   1926 
    0	   1927     $XPO_GET(
    0	   1928 	iob,						! address of IOB
    0	   1929 	prompt,						! pointer to read prompt string
    0	   1930 	characters,					! length of I/O request
    0	   1931 	fullwords,					! length of I/O request
    0	   1932 	units,						! length of I/O request
    0	   1933 	position,					! position in file of I/O request
    0	   1934 	user,						! user-specified value
    0	   1935 	success,					! address of success action routine
    0	   1936 	failure=XPO$FAILURE				! address of failure action routine
D   0	   1937 	) =
M   0	   1938 
M   0	   1939 	%IF %EXPAND $xpo$conflict( characters, fullwords, units )
M   0	   1940 	%THEN
M   0	   1941 	    %WARN( 'CHARACTERS=, FULLWORDS= and UNITS= are mutually exclusive' )
M   0	   1942 	%FI
M   0	   1943 
M   0	   1944 	%IF %EXPAND $xpo$conflict( (characters), (fullwords,units,position) )
M   0	   1945 	%THEN
M   0	   1946 	    %WARN( 'Character and binary or random parameters are mutually exclusive' )
M   0	   1947 	%FI
M   0	   1948 
M   0	   1949 	%EXPAND $xpo$required( iob, 'IOB=' )
M   0	   1950 
M   0	   1951 	BEGIN
M   0	   1952 	BIND iob$ = iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   1953 
M   0	   1954 	$str$declare( BIND, $iob$prompt, prompt )
M   0	   1955 
M   0	   1956 	%IF NOT %NULL( prompt )
M   0	   1957 	%THEN
M   0	   1958 	    IF .iob$[IOB$A_PROMPT] NEQ 0
M   0	   1959 	    THEN
M   0	   1960 		$STR_FREE_TEMP( .iob$[IOB$A_PROMPT] );
M   0	   1961 	%FI
M   0	   1962 
M   0	   1963 	$iob$string( IOB$A_PROMPT, $iob$prompt, prompt )		! PROMPT=
M   0	   1964 	$iob$get_length( STR$K_DTYPE_T, characters )			! CHARACTERS=
M   0	   1965 	%IF NOT %NULL(fullwords)
M   0	   1966 	%THEN
M   0	   1967 	    $iob$get_length( XPO$K_DTYPE_BU,				! FULLWORDS=
M   0	   1968 				%UPVAL * (fullwords) )
M   0	   1969 	%FI

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 42
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   1970 	$iob$get_length( XPO$K_DTYPE_BU, units )			! UNITS=
M   0	   1971 	$xpo$value( iob$, G_NEXT_POS, $XPO$POSITION (position) )	! POSITION=
M   0	   1972 	$xpo$value( iob$, Z_USER, user )				! USER=
M   0	   1973 
M   0	   1974 	%EXPAND $xpo$io_call( %QUOTE GET, success, failure )
M   0	   1975 	END %,
    0	   1976 
    0	   1977 
    0	   1978     $XPO_IOB_INIT(
    0	   1979 	iob,						! address of IOB to be initialized
    0	   1980 	file_spec,					! primary file specification information
    0	   1981 	default,					! default file specification information
    0	   1982 	related,					! related file specification information
    0	   1983 	option,						! option keyword
    0	   1984 	options,					! option keywords
    0	   1985 	attribute,					! file attribute keywords
    0	   1986 	attributes,					! file attribute keywords
    0	   1987 	prompt,						! read prompt string information
    0	   1988 	binary_data,					! binary data information
    0	   1989 	string,						! character string information
    0	   1990 	characters,					! length of I/O request
    0	   1991 	fullwords,					! length of I/O request
    0	   1992 	units,						! length of I/O request
    0	   1993 	position,					! position in file of I/O request
    0	   1994 	page_number,					! page number			! *** OBSOLETE ***
    0	   1995 	sequence_number,				! record sequence number
    0	   1996 	record_size,					! maximum record size
    0	   1997 	block_size,					! physical block size
    0	   1998 	user						! user-specified value
    0	   1999 	) =
M   0	   2000 
M   0	   2001 	%IF NOT %NULL( page_number )							! *** OBSOLETE ***
M   0	   2002 	%THEN										! *** OBSOLETE ***
M   0	   2003 	    %INFORM( 'PAGE_NUMBER= parameter is no longer supported' )			! *** OBSOLETE ***
M   0	   2004 	%FI										! *** OBSOLETE ***
M   0	   2005 
M   0	   2006 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   2007 	%THEN
M   0	   2008 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   2009 	%FI
M   0	   2010 
M   0	   2011 	%IF %EXPAND $xpo$conflict( attribute, attributes )
M   0	   2012 	%THEN
M   0	   2013 	    %WARN( 'ATTRIBUTE= and ATTRIBUTES= are mutually exclusive' )
M   0	   2014 	%FI
M   0	   2015 
M   0	   2016 	%IF %EXPAND $xpo$conflict( (string,characters,sequence_number), (binary_data,fullwords,units,position) )
M   0	   2017 	%THEN
M   0	   2018 	    %WARN( 'Character and binary or random parameters are mutually exclusive' )
M   0	   2019 	%FI
M   0	   2020 
M   0	   2021 	%IF %EXPAND $xpo$conflict( (units), (fullwords) )
M   0	   2022 	%THEN
M   0	   2023 	    %WARN( 'FULLWORDS= and UNITS= are mutually exclusive' )
M   0	   2024 	%FI
M   0	   2025 
M   0	   2026 	%EXPAND $xpo$required( iob, 'IOB=' )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 43
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2027 
M   0	   2028 	%EXPAND $iob$not_allowed( 'STRING=', string, 'initialization' )
M   0	   2029 	%EXPAND $iob$not_allowed( 'BINARY_DATA=', binary_data, 'initialization' )
M   0	   2030 
M   0	   2031 	BEGIN
M   0	   2032 	BIND iob$ = iob :  %EXPAND $xpo$force( $XPO_IOB() ),
M   0	   2033 	    iob$resultant = iob$[IOB$T_RESULTANT] :  %EXPAND $xpo$force( $STR_DESCRIPTOR() );
M   0	   2034 
M   0	   2035 	$str$declare( BIND, $iob$file_spec, file_spec )
M   0	   2036 	$str$declare( BIND, $iob$default, default )
M   0	   2037 	$str$declare( BIND, $iob$related, related )
M   0	   2038 	$str$declare( BIND, $iob$prompt, prompt )
M   0	   2039 
M   0	   2040 	CH$FILL( 0, IOB$K_LENGTH * %UPVAL, CH$PTR(iob$,0,%BPUNIT) );	! Zero the entire IOB.
M   0	   2041 
M   0	   2042 	iob$[IOB$H_LENGTH] = IOB$K_LENGTH;				! IOB length
M   0	   2043 	iob$[IOB$B_VERSION] = XPO$K_VERSION;				! XPORT version
M   0	   2044 	iob$[IOB$B_LEVEL] = XPO$K_LEVEL;				! XPORT level
M   0	   2045 	$iob$string( IOB$A_FILE_SPEC, $iob$file_spec, file_spec )	! FILE_SPEC=
M   0	   2046 	$iob$string( IOB$A_DEFAULT, $iob$default, default )		! DEFAULT=
M   0	   2047 	$iob$string( IOB$A_RELATED, $iob$related, related )		! RELATED=
M   0	   2048 									! Resultant file-spec descriptor:
M   0	   2049 	iob$resultant[STR$B_DTYPE] = STR$K_DTYPE_T;			!    ASCII data type
M   0	   2050 	iob$resultant[STR$B_CLASS] = STR$K_CLASS_D;			!    DYNAMIC descriptor class
M   0	   2051 	$iob$string( IOB$A_PROMPT, $iob$prompt, prompt )		! PROMPT=
M   0	   2052 	$xpo$keyword( iob$, %REMOVE(option) %REMOVE(options) )		! OPTION= or OPTIONS=
M   0	   2053 	$xpo$keyword( iob$, %REMOVE(attribute) %REMOVE(attributes) )	! ATTRIBUTE= or ATTRIBUTES=
M   0	   2054 	$iob$get_length( STR$K_DTYPE_T, characters )			! CHARACTERS=
M   0	   2055 	%IF NOT %NULL(fullwords)
M   0	   2056 	%THEN
M   0	   2057 	    $iob$get_length( XPO$K_DTYPE_BU,				! FULLWORDS=
M   0	   2058 				%UPVAL * (fullwords) )
M   0	   2059 	%FI
M   0	   2060 	$iob$get_length( XPO$K_DTYPE_BU, units )			! UNITS=
M   0	   2061 	$xpo$value( iob$, G_NEXT_POS, $XPO$POSITION (position) )	! POSITION=
M   0	   2062 	$xpo$value( iob$, G_SEQ_NUMB, sequence_number )			! SEQUENCE_NUMBER=
M   0	   2063 	%IF NOT %IDENTICAL( record_size, VARIABLE )
M   0	   2064 	%THEN
M   0	   2065 	    $xpo$value( iob$, G_REC_SIZE, record_size )			! RECORD_SIZE=
M   0	   2066 	%FI
M   0	   2067 	$xpo$value( iob$, G_BLK_SIZE, block_size )			! BLOCK_SIZE=
M   0	   2068 	$xpo$value( iob$, Z_USER, user )				! USER=
M   0	   2069 
M   0	   2070 	XPO$_NORMAL					! normal completion code
M   0	   2071 	END %,
    0	   2072 
    0	   2073 
    0	   2074     $XPO_OPEN(
    0	   2075 	iob,						! address of IOB
    0	   2076 	file_spec,					! primary file specification information
    0	   2077 	default,					! default file specification information
    0	   2078 	related,					! related file specification information
    0	   2079 	option,						! option keyword
    0	   2080 	options,					! option keywords
    0	   2081 	attribute,					! file attribute keywords
    0	   2082 	attributes,					! file attribute keywords
    0	   2083 	prompt,						! read prompt string information

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 44
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2084 	binary_data,					! binary data information
    0	   2085 	string,						! character string information
    0	   2086 	characters,					! length of I/O request
    0	   2087 	fullwords,					! length of I/O request
    0	   2088 	units,						! length of I/O request
    0	   2089 	position,					! position in file of I/O request
    0	   2090 	page_number,					! page number			! *** OBSOLETE ***
    0	   2091 	sequence_number,				! record sequence number
    0	   2092 	record_size,					! maximum record size
    0	   2093 	block_size,					! physical block size
    0	   2094 	user,						! user-specified value
    0	   2095 	success,					! address of success action routine
    0	   2096 	failure=XPO$FAILURE				! address of failure action routine
D   0	   2097 	) =
M   0	   2098 
M   0	   2099 	%IF NOT %NULL( page_number )							! *** OBSOLETE ***
M   0	   2100 	%THEN										! *** OBSOLETE ***
M   0	   2101 	    %INFORM( 'PAGE_NUMBER= parameter is no longer supported' )			! *** OBSOLETE ***
M   0	   2102 	%FI										! *** OBSOLETE ***
M   0	   2103 
M   0	   2104 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   2105 	%THEN
M   0	   2106 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   2107 	%FI
M   0	   2108 
M   0	   2109 	%IF %EXPAND $xpo$conflict( attribute, attributes )
M   0	   2110 	%THEN
M   0	   2111 	    %WARN( 'ATTRIBUTE= and ATTRIBUTES= are mutually exclusive' )
M   0	   2112 	%FI
M   0	   2113 
M   0	   2114 	%IF %EXPAND $xpo$conflict( (string,characters,sequence_number), (binary_data,fullwords,units,position) )
M   0	   2115 	%THEN
M   0	   2116 	    %WARN( 'Character and binary or random parameters are mutually exclusive' )
M   0	   2117 	%FI
M   0	   2118 
M   0	   2119 	%IF %EXPAND $xpo$conflict( (units), (fullwords) )
M   0	   2120 	%THEN
M   0	   2121 	    %WARN( 'FULLWORDS= and UNITS= are mutually exclusive' )
M   0	   2122 	%FI
M   0	   2123 
M   0	   2124 	%EXPAND $xpo$required( iob, 'IOB=' )
M   0	   2125 
M   0	   2126 	%EXPAND $iob$not_allowed( 'STRING=', string, 'open' )
M   0	   2127 	%EXPAND $iob$not_allowed( 'BINARY_DATA=', binary_data, 'open' )
M   0	   2128 
M   0	   2129 !+
M   0	   2130 !   Random access i/o has been implemented for VMS only for V1.2.  
M   0	   2131 !   See also:
M   0	   2132 !   		XPORT.REQ  -  $XPO_OPEN definition.
M   0	   2133 !   		XOPEN.BLI  -  $IOB initialization.
M   0	   2134 !   		XGET.BLI  -  comments in 'TOPS-10/TOPS-20 Stream-mode and Binary-mode GET'
M   0	   2135 !   		XPUT.BLI  -  comments in 'TOPS-10/TOPS-20/RT-11 File PUT'
M   0	   2136 !-
M   0	   2137 %IF NOT %BLISS(BLISS32)
M   0	   2138 %THEN
M   0	   2139 	%IF $xpo$key_check( RANDOM, attribute attributes )
M   0	   2140 	%THEN

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 45
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2141 	    %WARN    ( '"ATTRIBUTE= RANDOM"  is not implemented for this architecture' )
M   0	   2142 	%FI
M   0	   2143 %FI
M   0	   2144 
M   0	   2145 	BEGIN
M   0	   2146 	BIND iob$ = iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   2147 
M   0	   2148 	$str$declare( BIND, $iob$file_spec, file_spec )
M   0	   2149 	$str$declare( BIND, $iob$default, default )
M   0	   2150 	$str$declare( BIND, $iob$related, related )
M   0	   2151 	$str$declare( BIND, $iob$prompt, prompt )
M   0	   2152 
M   0	   2153 	$iob$string( IOB$A_FILE_SPEC, $iob$file_spec, file_spec )	! FILE_SPEC=
M   0	   2154 	$iob$string( IOB$A_DEFAULT, $iob$default, default )		! DEFAULT=
M   0	   2155 	$iob$string( IOB$A_RELATED, $iob$related, related )		! RELATED=
M   0	   2156 	$iob$string( IOB$A_PROMPT, $iob$prompt, prompt )		! PROMPT=
M   0	   2157 	$xpo$keyword( iob$, %REMOVE(option) %REMOVE(options) )		! OPTION= or OPTIONS=
M   0	   2158 	$xpo$keyword( iob$, %REMOVE(attribute) %REMOVE(attributes) )	! ATTRIBUTE= or ATTRIBUTES=
M   0	   2159 	$iob$get_length( STR$K_DTYPE_T, characters )			! CHARACTERS=
M   0	   2160 	$xpo$value( iob$, G_SEQ_NUMB, sequence_number )			! SEQUENCE_NUMBER=
M   0	   2161 	%IF NOT %NULL(fullwords)
M   0	   2162 	%THEN
M   0	   2163 	    $iob$get_length( XPO$K_DTYPE_BU,				! FULLWORDS=
M   0	   2164 				%UPVAL * (fullwords) )
M   0	   2165 	%FI
M   0	   2166 	$iob$get_length( XPO$K_DTYPE_BU, units )			! UNITS=
M   0	   2167 	$xpo$value( iob$, G_NEXT_POS, $XPO$POSITION (position) )	! POSITION=
M   0	   2168 	%IF %IDENTICAL( record_size, VARIABLE )
M   0	   2169 	%THEN
M   0	   2170 	    iob$[IOB$G_REC_SIZE] = 0;					! RECORD_SIZE=VARIABLE
M   0	   2171 	%ELSE
M   0	   2172 	    $xpo$value( iob$, G_REC_SIZE, record_size )			! RECORD_SIZE=value
M   0	   2173 	%FI
M   0	   2174 	$xpo$value( iob$, G_BLK_SIZE, block_size )			! BLOCK_SIZE=
M   0	   2175 	$xpo$value( iob$, Z_USER, user )				! USER=
M   0	   2176 
M   0	   2177 	%EXPAND $xpo$io_call( %QUOTE OPEN, success, failure )
M   0	   2178 	END %,
    0	   2179 
    0	   2180 
    0	   2181     $XPO_PUT(
    0	   2182 	iob,						! address of IOB
    0	   2183 	string,						! character string information
    0	   2184 	page_number,					! page number			! *** OBSOLETE ***
    0	   2185 	sequence_number,				! record sequence number
    0	   2186 	binary_data,					! binary data information
    0	   2187 	position,					! position in file of I/O request
    0	   2188 	user,						! user-specified value
    0	   2189 	success,					! address of success action routine
    0	   2190 	failure=XPO$FAILURE				! address of failure action routine
D   0	   2191 	) =
M   0	   2192 
M   0	   2193 	%IF NOT %NULL( page_number )							! *** OBSOLETE ***
M   0	   2194 	%THEN										! *** OBSOLETE ***
M   0	   2195 	    %INFORM( 'PAGE_NUMBER= parameter is no longer supported' )			! *** OBSOLETE ***
M   0	   2196 	%FI										! *** OBSOLETE ***
M   0	   2197 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 46
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2198 	%IF %EXPAND $xpo$conflict( (string,sequence_number), (binary_data,position) )
M   0	   2199 	%THEN
M   0	   2200 	    %WARN( 'Character and binary or random parameters are mutually exclusive' )
M   0	   2201 	%FI
M   0	   2202 
M   0	   2203 	%EXPAND $xpo$required( iob, 'IOB=' )
M   0	   2204 
M   0	   2205 	BEGIN
M   0	   2206 	BIND iob$ = iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   2207 
M   0	   2208 	$str$declare( LOCAL, $iob$output, string )
M   0	   2209 	$bin$declare( $iob$output, binary_data )
M   0	   2210 
M   0	   2211 	$str$local_init( $iob$output, string )
M   0	   2212 	$bin$local_init( $iob$output, binary_data )
M   0	   2213 
M   0	   2214 	$iob$string( IOB$A_OUTPUT, $iob$output, string binary_data )	! STRING= or BINARY_DATA=
M   0	   2215 	$xpo$value( iob$, G_SEQ_NUMB, sequence_number )			! SEQUENCE_NUMBER=
M   0	   2216 	$xpo$value( iob$, G_NEXT_POS, $XPO$POSITION (position) )	! POSITION=
M   0	   2217 	$xpo$value( iob$, Z_USER, user )				! USER=
M   0	   2218 
M   0	   2219 	%EXPAND $xpo$io_call( %QUOTE PUT, success, failure )
M   0	   2220 	END %,
    0	   2221 
    0	   2222 
    0	   2223     $XPO_RENAME(
    0	   2224 	iob,						! address of IOB
    0	   2225 	file_spec,					! primary file specification information
    0	   2226 	default,					! default file specification information
    0	   2227 	related,					! related file specification information
    0	   2228 	new_spec,					! new primary file specification information
    0	   2229 	new_default,					! new default file specification information
    0	   2230 	new_related,					! new related file specification information
    0	   2231 	option,						! option keywords
    0	   2232 	options,					! option keywords
    0	   2233 	user,						! user-specified value
    0	   2234 	success,					! address of success action routine
    0	   2235 	failure=XPO$FAILURE				! address of failure action routine
D   0	   2236 	) =
M   0	   2237 
M   0	   2238 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   2239 	%THEN
M   0	   2240 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   2241 	%FI
M   0	   2242 
M   0	   2243 	%EXPAND $xpo$required( iob, 'IOB=' )
M   0	   2244 	%EXPAND $xpo$required( new_spec new_default new_related, 'NEW_SPEC=, NEW_DEFAULT=, or NEW_RELATED=' )
M   0	   2245 
M   0	   2246 	BEGIN
M   0	   2247 	BIND iob$ = iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   2248 
M   0	   2249 	LOCAL
M   0	   2250 	    $xpo$new_iob :  %EXPAND $xpo$force( $XPO_IOB() );
M   0	   2251 
M   0	   2252 	$str$declare( LOCAL, $iob$file_spec, file_spec )
M   0	   2253 	$str$declare( LOCAL, $iob$default, default )
M   0	   2254 	$str$declare( LOCAL, $iob$related, related )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 47
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2255 	$str$declare( LOCAL, $iob$new_spec, new_spec )
M   0	   2256 	$str$declare( LOCAL, $iob$new_default, new_default )
M   0	   2257 	$str$declare( LOCAL, $iob$new_related, new_related )
M   0	   2258 
M   0	   2259 	$str$local_init( $iob$file_spec, file_spec )
M   0	   2260 	$str$local_init( $iob$default, default )
M   0	   2261 	$str$local_init( $iob$related, related )
M   0	   2262 	$str$local_init( $iob$new_spec, new_spec )
M   0	   2263 	$str$local_init( $iob$new_default, new_default )
M   0	   2264 	$str$local_init( $iob$new_related, new_related )
M   0	   2265 
M   0	   2266 	$XPO_IOB_INIT( %QUOTE IOB = $xpo$new_iob
M   0	   2267 			, %QUOTE OPTION = OUTPUT			! force "output" file-spec resolution
M   0	   2268 		%IF NOT %NULL(new_spec) %THEN
M   0	   2269 			, %QUOTE FILE_SPEC = $iob$new_spec
M   0	   2270 		%FI
M   0	   2271 		%IF NOT %NULL(new_default) %THEN
M   0	   2272 			, %QUOTE DEFAULT = $iob$new_default
M   0	   2273 		%FI
M   0	   2274 		%IF NOT %NULL(new_related) %THEN
M   0	   2275 			, %QUOTE RELATED = $iob$new_related
M   0	   2276 		%FI );
M   0	   2277 
M   0	   2278 	$iob$string( IOB$A_FILE_SPEC, $iob$file_spec, file_spec )	! FILE_SPEC=
M   0	   2279 	$iob$string( IOB$A_DEFAULT, $iob$default, default )		! DEFAULT=
M   0	   2280 	$iob$string( IOB$A_RELATED, $iob$related, related )		! RELATED=
M   0	   2281 	$xpo$value( iob$, A_ASSOC_IOB, $xpo$new_iob )			! NEW_SPEC=, NEW_DEFAULT=, NEW_RELATED=
M   0	   2282 	$xpo$keyword( iob$, %REMOVE(option) %REMOVE(options) )		! OPTION= or OPTIONS=
M   0	   2283 	$xpo$value( iob$, Z_USER, user )				! USER=
M   0	   2284 
M   0	   2285 	%EXPAND $xpo$io_call( %QUOTE RENAME, success, failure )
M   0	   2286 	END %;
    0	   2287 
    0	   2288 
    0	   2289 MACRO
    0	   2290     $XPO_INPUT =
M   0	   2291 	%IF %BLISS(BLISS36)
M   0	   2292 	%THEN
M   0	   2293 	    'TTY:'
M   0	   2294 	%ELSE %IF %BLISS(BLISS32)
M   0	   2295 	%THEN
M   0	   2296 	    'SYS$INPUT'
M   0	   2297 	%ELSE
M   0	   2298 	    'TI:'
M   0	   2299 	%FI %FI %,
    0	   2300 
    0	   2301 
    0	   2302     $XPO_OUTPUT =
M   0	   2303 	%IF %BLISS(BLISS32)
M   0	   2304 	%THEN
M   0	   2305 	    'SYS$OUTPUT'
M   0	   2306 	%ELSE
M   0	   2307 	    %EXPAND $XPO_INPUT
M   0	   2308 	%FI %,
    0	   2309 
    0	   2310 
    0	   2311     $XPO_ERROR =

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 48
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2312 	%IF %BLISS(BLISS32)
M   0	   2313 	%THEN
M   0	   2314 	    'SYS$ERROR'
M   0	   2315 	%ELSE
M   0	   2316 	    %EXPAND $XPO_INPUT
M   0	   2317 	%FI %,
    0	   2318 
    0	   2319 
    0	   2320     $XPO_TEMPORARY =
M   0	   2321 	'[XPORT Temporary File]' %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 49
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2323 !
    0	   2324 ! XSPEC - XPORT File Specification Parse Block
    0	   2325 !
    0	   2326 
    0	   2327 $FIELD	$XPO$SPEC_FIELD	= SET
    0	   2328 	XPO$V_SPEC_STAT	= [$BITS(16)] ,			! File specification indicators:
		; %PRINT:				  [0,0,16,0]   (+%X'0')
    0	   2329 	    $OVERLAY( XPO$V_SPEC_STAT )
    0	   2330 	XPO$V_DIR_NAME	= [$BIT] ,			!    <directory-name> specified
		; %PRINT:				  [0,0,1,0]   (+%X'0')
    0	   2331 	XPO$V_PPN	= [$BIT] ,			!    [project,programmer] specified
		; %PRINT:				  [0,1,1,0]   (+%X'0')
    0	   2332 	XPO$V_SFD	= [$BIT] ,			!    [,,SFD] specified (TOPS-10 only)
		; %PRINT:				  [0,2,1,0]   (+%X'0')
    0	   2333 	XPO$V_WILD_CARD	= [$BIT] ,			!    wild-card somewhere in file-spec
		; %PRINT:				  [0,3,1,0]   (+%X'0')
    0	   2334 	XPO$V_WILD_NODE	= [$BIT] ,			!    wild-card node name
		; %PRINT:				  [0,4,1,0]   (+%X'0')
    0	   2335 	XPO$V_WILD_DEV	= [$BIT] ,			!    wild-card device name
		; %PRINT:				  [0,5,1,0]   (+%X'0')
    0	   2336 	XPO$V_WILD_DIR	= [$BIT] ,			!    wild-card in directory name
		; %PRINT:				  [0,6,1,0]   (+%X'0')
    0	   2337 	XPO$V_WILD_NAME	= [$BIT] ,			!    wild-card file name
		; %PRINT:				  [0,7,1,0]   (+%X'0')
    0	   2338 	XPO$V_WILD_TYPE	= [$BIT] ,			!    wild-card file type (extension)
		; %PRINT:				  [0,8,1,0]   (+%X'1')
    0	   2339 	XPO$V_WILD_VER	= [$BIT] ,			!    wild-card file version number
		; %PRINT:				  [0,9,1,0]   (+%X'1')
    0	   2340 	XPO$V_WILD_ATTR	= [$BIT] ,			!    wild-card file attributes
		; %PRINT:				  [0,10,1,0]   (+%X'1')
    0	   2341 	    $CONTINUE
    0	   2342 
    0	   2343 	XPO$T_NODE	= [$DESCRIPTOR(FIXED)] ,	! Network node name descriptor:
		; %PRINT:				  [1,0,0,0]   (+%X'4')
    0	   2344 	    $OVERLAY( $SUB_FIELD(XPO$T_NODE,STR$H_LENGTH) )
    0	   2345 	XPO$H_NODE	= [$BYTES(2)] ,			!    length of the node name
		; %PRINT:				  [1,0,16,0]   (+%X'4')
    0	   2346 	    $OVERLAY( $SUB_FIELD(XPO$T_NODE,STR$A_POINTER) )
    0	   2347 	XPO$A_NODE	= [$POINTER] ,			!    pointer to the node name
		; %PRINT:				  [2,0,32,0]   (+%X'8')
    0	   2348 	    $CONTINUE
    0	   2349 
    0	   2350 	XPO$T_DEVICE	= [$DESCRIPTOR(FIXED)] ,	! Device name descriptor:
		; %PRINT:				  [3,0,0,0]   (+%X'C')
    0	   2351 	    $OVERLAY( $SUB_FIELD(XPO$T_DEVICE,STR$H_LENGTH) )
    0	   2352 	XPO$H_DEVICE	= [$BYTES(2)] ,			!    length of the device name
		; %PRINT:				  [3,0,16,0]   (+%X'C')
    0	   2353 	    $OVERLAY( $SUB_FIELD(XPO$T_DEVICE,STR$A_POINTER) )
    0	   2354 	XPO$A_DEVICE	= [$POINTER] ,			!    pointer to the device name
		; %PRINT:				  [4,0,32,0]   (+%X'10')
    0	   2355 	    $CONTINUE
    0	   2356 
    0	   2357 	XPO$T_DIRECT	= [$DESCRIPTOR(FIXED)] ,	! Directory specification descriptor:
		; %PRINT:				  [5,0,0,0]   (+%X'14')
    0	   2358 	    $OVERLAY( $SUB_FIELD(XPO$T_DIRECT,STR$H_LENGTH) )
    0	   2359 	XPO$H_DIRECT	= [$BYTES(2)] ,			!    length of the directory spec
		; %PRINT:				  [5,0,16,0]   (+%X'14')

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 50
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2360 	    $OVERLAY( $SUB_FIELD(XPO$T_DIRECT,STR$A_POINTER) )
    0	   2361 	XPO$A_DIRECT	= [$POINTER] ,			!    pointer to the directory spec
		; %PRINT:				  [6,0,32,0]   (+%X'18')
    0	   2362 	    $CONTINUE
    0	   2363 
    0	   2364 	XPO$H_PROJ_NUMB	= [$BYTES(2)] ,			! Project number (binary)
		; %PRINT:				  [7,0,16,0]   (+%X'1C')
    0	   2365 	XPO$H_PGMR_NUMB	= [$BYTES(2)] ,			! Programmer number (binary)
		; %PRINT:				  [7,16,16,0]   (+%X'1E')
    0	   2366 
    0	   2367 	XPO$T_FILE_NAME	= [$DESCRIPTOR(FIXED)] ,	! File name descriptor:
		; %PRINT:				  [8,0,0,0]   (+%X'20')
    0	   2368 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_NAME,STR$H_LENGTH) )
    0	   2369 	XPO$H_FILE_NAME	= [$BYTES(2)] ,			!    length of the file name
		; %PRINT:				  [8,0,16,0]   (+%X'20')
    0	   2370 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_NAME,STR$A_POINTER) )
    0	   2371 	XPO$A_FILE_NAME	= [$POINTER] ,			!    pointer to the file name
		; %PRINT:				  [9,0,32,0]   (+%X'24')
    0	   2372 	    $CONTINUE
    0	   2373 
    0	   2374 	XPO$T_FILE_TYPE	= [$DESCRIPTOR(FIXED)] ,	! File type (extension) descriptor:
		; %PRINT:				  [10,0,0,0]   (+%X'28')
    0	   2375 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_TYPE,STR$H_LENGTH) )
    0	   2376 	XPO$H_FILE_TYPE	= [$BYTES(2)] ,			!    length of the file type
		; %PRINT:				  [10,0,16,0]   (+%X'28')
    0	   2377 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_TYPE,STR$A_POINTER) )
    0	   2378 	XPO$A_FILE_TYPE	= [$POINTER] ,			!    pointer to the file type
		; %PRINT:				  [11,0,32,0]   (+%X'2C')
    0	   2379 	    $CONTINUE
    0	   2380 
    0	   2381 	XPO$T_FILE_VER	= [$DESCRIPTOR(FIXED)] ,	! File version number descriptor:
		; %PRINT:				  [12,0,0,0]   (+%X'30')
    0	   2382 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_VER,STR$H_LENGTH) )
    0	   2383 	XPO$H_FILE_VER	= [$BYTES(2)] ,			!    length of the file version
		; %PRINT:				  [12,0,16,0]   (+%X'30')
    0	   2384 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_VER,STR$A_POINTER) )
    0	   2385 	XPO$A_FILE_VER	= [$POINTER] ,			!    pointer to the file version
		; %PRINT:				  [13,0,32,0]   (+%X'34')
    0	   2386 	    $CONTINUE
    0	   2387 
    0	   2388 	XPO$T_FILE_PROT	= [$DESCRIPTOR(FIXED)] ,	! File protection descriptor (RSTS only):
		; %PRINT:				  [14,0,0,0]   (+%X'38')
    0	   2389 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_PROT,STR$H_LENGTH) )
    0	   2390 	XPO$H_FILE_PROT	= [$BYTES(2)] ,			!    length of the protection
		; %PRINT:				  [14,0,16,0]   (+%X'38')
    0	   2391 	    $OVERLAY( $SUB_FIELD(XPO$T_FILE_PROT,STR$A_POINTER) )
    0	   2392 	XPO$A_FILE_PROT	= [$POINTER] ,			!    pointer to the protection
		; %PRINT:				  [15,0,32,0]   (+%X'3C')
    0	   2393 	    $CONTINUE
    0	   2394 
    0	   2395 	XPO$T_EXTRA	= [$DESCRIPTOR(FIXED)] ,	! File 'EXTRA' information descriptor:
		; %PRINT:				  [16,0,0,0]   (+%X'40')
    0	   2396 	    $OVERLAY( $SUB_FIELD(XPO$T_EXTRA,STR$H_LENGTH) )
    0	   2397 	XPO$H_EXTRA	= [$BYTES(2)] ,			!    length
		; %PRINT:				  [16,0,16,0]   (+%X'40')
    0	   2398 	    $OVERLAY( $SUB_FIELD(XPO$T_EXTRA,STR$A_POINTER) )
    0	   2399 	XPO$A_EXTRA	= [$POINTER]  			!    pointer

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 51
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

		; %PRINT:				  [17,0,32,0]   (+%X'44')
    0	   2400 	    $CONTINUE
    0	   2401 
    0	   2402 	TES;
    0	   2403 LITERAL	XPO$K_SPEC_LEN	= $FIELD_SET_SIZE ;		! Length of file-spec block
		; %PRINT:				  18 fullwords
    0	   2404 
    0	   2405 ! End of XSPEC
    0	   2406 
    0	   2407 
    0	   2408 MACRO
    0	   2409     $XPO_SPEC_BLOCK =
M   0	   2410 	BLOCK[XPO$K_SPEC_LEN]  FIELD( $XPO$SPEC_FIELD ) %;
    0	   2411 
    0	   2412 
    0	   2413 MACRO											! *** OBSOLETE ***
    0	   2414     XPO$V_WILD_PROJ =									! *** OBSOLETE ***
M   0	   2415 	%WARN( 'XPO$V_WILD_PROJ is no longer defined' )					! *** OBSOLETE ***
M   0	   2416 	XPO$V_WILD_DIR %,								! *** OBSOLETE ***
    0	   2417 
    0	   2418     XPO$V_WILD_PGMR =									! *** OBSOLETE ***
M   0	   2419 	%WARN( 'XPO$V_WILD_PGMR is no longer defined' )					! *** OBSOLETE ***
M   0	   2420 	XPO$V_WILD_DIR %;								! *** OBSOLETE ***
    0	   2421 
    0	   2422 
    0	   2423 KEYWORDMACRO
    0	   2424     $XPO_PARSE_SPEC(
    0	   2425 	file_spec,					! file specification information
    0	   2426 	spec_block,					! address of file-spec parse block
    0	   2427 	success,					! address of success action routine
    0	   2428 	failure=XPO$FAILURE				! address of failure action routine
D   0	   2429 	) =
M   0	   2430 
M   0	   2431 	%EXPAND $xpo$required( file_spec, 'FILE_SPEC=' )
M   0	   2432 	%EXPAND $xpo$required( spec_block, 'SPEC_BLOCK=' )
M   0	   2433 
M   0	   2434 	BEGIN
M   0	   2435 	%EXPAND $xpo$force( $xpo$ex_routine( XPO$PARSE_SPEC ) )
M   0	   2436 	%EXPAND $xpo$ex_failure( failure )
M   0	   2437 
M   0	   2438 	$str$declare( LOCAL, $str$file_spec, file_spec )
M   0	   2439 	$str$local_init( $str$file_spec, file_spec )
M   0	   2440 
M   0	   2441 	XPO$PARSE_SPEC( $str$file_spec,
M   0	   2442 			spec_block,
M   0	   2443 			NOT %DECLARED($xpo$internal),
M   0	   2444 			$xpo$default(success,0),
M   0	   2445 			$xpo$default(failure,0) )
M   0	   2446 	END %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 52
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2448 !
    0	   2449 ! XPORT MEMORY Macros
    0	   2450 !
    0	   2451 
    0	   2452 LITERAL							! $XPO_GET_MEM fill indicators:
    0	   2453     XPO$K_DONT_FILL = -1,				!    don't fill element
    0	   2454     XPO$K_FILL_FULL = 0,				!    fill fullwords if binary data element
    0	   2455     XPO$K_FILL_UNIT = 1;				!    fill addressable units if binary data element
    0	   2456 
    0	   2457 KEYWORDMACRO
    0	   2458     $XPO_GET_MEM(
    0	   2459 	desc,						! address of a DYNAMIC or DYNAMIC BOUNDED descriptor
    0	   2460 	descriptor,					! address of a DYNAMIC or DYNAMIC BOUNDED descriptor
    0	   2461 	characters,					! size of element in characters
    0	   2462 	fullwords,					! size of element in fullwords
    0	   2463 	units,						! size of element in units
    0	   2464 	result,						! address of resulting pointer/address
    0	   2465 	fill,						! storage fill value
    0	   2466 	success,					! address of success action routine
    0	   2467 	failure=XPO$FAILURE				! address of failure action routine
D   0	   2468 	) =
M   0	   2469 
M   0	   2470 	%IF %EXPAND $xpo$conflict( characters, fullwords, units )
M   0	   2471 	%THEN
M   0	   2472 	    %WARN( 'CHARACTERS=, FULLWORDS= and UNITS= are mutually exclusive' )
M   0	   2473 	    %EXITMACRO
M   0	   2474 	%FI
M   0	   2475 
M   0	   2476 	%IF %EXPAND $xpo$conflict( desc, descriptor )
M   0	   2477 	%THEN
M   0	   2478 	    %WARN( 'DESC= and DESCRIPTOR= are mutually exclusive' )
M   0	   2479 	    %EXITMACRO
M   0	   2480 	%FI
M   0	   2481 
M   0	   2482 	%IF %EXPAND $xpo$conflict( (desc,descriptor), (result) )
M   0	   2483 	%THEN
M   0	   2484 	    %WARN( 'DESC=/DESCRIPTOR= and /RESULT= parameters are mutually exclusive' )
M   0	   2485 	    %EXITMACRO
M   0	   2486 	%FI
M   0	   2487 
M   0	   2488 	%IF %NULL( characters, fullwords, units )						! *** OBSOLETE ***
M   0	   2489 	%THEN											! *** OBSOLETE ***
M   0	   2490 	    %INFORM( 'Semantic meaning of DESCRIPTOR= has been changed - see documentation')	! *** OBSOLETE ***
M   0	   2491 	%FI											! *** OBSOLETE ***
M   0	   2492 
M   0	   2493 !	%EXPAND $xpo$required( characters fullwords units,'CHARACTERS=, FULLWORDS= or UNITS=' )	! *** REMOVE "!" ***
M   0	   2494 	%EXPAND $xpo$required( desc descriptor result, 'DESC=, DESCRIPTOR= or RESULT=' )
M   0	   2495 
M   0	   2496 	BEGIN
M   0	   2497 	%EXPAND $xpo$force( $xpo$ex_routine( XPO$ALLOC_MEM ) )
M   0	   2498 
M   0	   2499 	%EXPAND $xpo$ex_failure( failure )
M   0	   2500 
M   0	   2501 	%IF NOT %NULL( desc, descriptor )
M   0	   2502 	%THEN
M   0	   2503 	    BIND $xpo$desc = desc descriptor :  %EXPAND $xpo$force( $STR_DESCRIPTOR(CLASS=DYNAMIC_BOUNDED) );
M   0	   2504 	%ELSE

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 53
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2505 	    LOCAL
M   0	   2506 		$xpo$status,
M   0	   2507 		$xpo$desc :
M   0	   2508 		    %IF NOT %NULL( characters )
M   0	   2509 		    %THEN
M   0	   2510 			%EXPAND $xpo$force( $STR_DESCRIPTOR(CLASS=DYNAMIC) );
M   0	   2511 			$str$str_desc( $xpo$desc, DYNAMIC, (0,0) )
M   0	   2512 		    %ELSE
M   0	   2513 			%EXPAND $xpo$force( $XPO_DESCRIPTOR(CLASS=DYNAMIC) );
M   0	   2514 			$xpo$bin_desc( $xpo$desc, DYNAMIC, (0,0) )
M   0	   2515 		    %FI
M   0	   2516 	    $xpo$status =
M   0	   2517 	%FI
M   0	   2518 
M   0	   2519 	XPO$ALLOC_MEM(					! XPO$ALLOC_MEM argument list:
M   0	   2520 	    %IF NOT %NULL(characters, fullwords, units)						! *** OBSOLETE ***
M   0	   2521 	    %THEN										! *** OBSOLETE ***
M   0	   2522 		characters units			!    explicit length
M   0	   2523 		    %IF NOT %NULL(fullwords)
M   0	   2524 		    %THEN %BLISS32(4 *) %BLISS16(2 *)
M   0	   2525 			( fullwords ) %FI,
M   0	   2526 	    %ELSE					!    implicit length			! *** OBSOLETE ***
M   0	   2527 		IF .$xpo$desc[STR$B_CLASS] EQL STR$K_CLASS_DB					! *** OBSOLETE ***
M   0	   2528 		THEN										! *** OBSOLETE ***
M   0	   2529 		    .$xpo$desc[STR$H_MAXLEN]							! *** OBSOLETE ***
M   0	   2530 		ELSE										! *** OBSOLETE ***
M   0	   2531 		    .$xpo$desc[STR$H_LENGTH],							! *** OBSOLETE ***
M   0	   2532 	    %FI											! *** OBSOLETE ***
M   0	   2533 		$xpo$desc,				!    address of local descriptor or caller's descriptor
M   0	   2534 	    %IF %NULL(fill)				!    fill element indicator:
M   0	   2535 	    %THEN					!
M   0	   2536 		XPO$K_DONT_FILL,			!	don't fill element
M   0	   2537 	    %ELSE					!
M   0	   2538 		%NULL(fullwords),			!	fill fullwords (no or yes)
M   0	   2539 	    %FI						!
M   0	   2540 		$XPO$DEFAULT(fill,0),			!    fill value
M   0	   2541 		$XPO$DEFAULT(success,0),		!    address of success action routine
M   0	   2542 		$XPO$DEFAULT(failure,0) )		!    address of failure action routine
M   0	   2543 
M   0	   2544 	%IF %NULL( desc, descriptor )
M   0	   2545 	%THEN
M   0	   2546 	    ;
M   0	   2547 	    IF .$xpo$status
M   0	   2548 	    THEN
M   0	   2549 		%IF NOT %NULL( characters )
M   0	   2550 		%THEN
M   0	   2551 		    result = .$xpo$desc[STR$A_POINTER];
M   0	   2552 		%ELSE
M   0	   2553 		    result = .$xpo$desc[XPO$A_ADDRESS];
M   0	   2554 		%FI
M   0	   2555 	    .$xpo$status
M   0	   2556 	%FI
M   0	   2557 	
M   0	   2558 	END %,
    0	   2559 
    0	   2560 
    0	   2561     $XPO_FREE_MEM(

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 54
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2562 	string,						! character string descriptor
    0	   2563 	binary_data,					! binary data descriptor
    0	   2564 	descriptor,									! *** OBSOLETE ***
    0	   2565 	fill,						! storage fill value
    0	   2566 	success,					! address of success action routine
    0	   2567 	failure=XPO$FAILURE				! address of failure action routine
D   0	   2568 	) =
M   0	   2569 
M   0	   2570 	%IF %EXPAND $xpo$conflict( string, binary_data, descriptor )
M   0	   2571 	%THEN
M   0	   2572 	    %WARN( 'STRING=, BINARY_DATA= and DESCRIPTOR= are mutually exclusive' )
M   0	   2573 	    %EXITMACRO
M   0	   2574 	%FI
M   0	   2575 
M   0	   2576 	%EXPAND $xpo$required( string binary_data descriptor, 'STRING= or BINARY_DATA=' )
M   0	   2577 
M   0	   2578 	%IF NOT %NULL(descriptor)
M   0	   2579 	%THEN
M   0	   2580 	    %INFORM( 'DESCRIPTOR= is obsolete - use STRING= or BINARY=' )
M   0	   2581 	%FI
M   0	   2582 
M   0	   2583 	%IF %ISSTRING( %REMOVE(string) )
M   0	   2584 	%THEN
M   0	   2585 	    %WARN( 'Literal STRING= parameter is not permitted' )
M   0	   2586 	    %EXITMACRO
M   0	   2587 	%FI
M   0	   2588 
M   0	   2589 	BEGIN
M   0	   2590 	%EXPAND $xpo$force( $xpo$ex_routine( XPO$FREE_MEM ) )
M   0	   2591 
M   0	   2592 	%EXPAND $xpo$ex_failure( failure )
M   0	   2593 
M   0	   2594 	%IF $xpo$paren_test(string) OR $xpo$paren_test(binary_data)
M   0	   2595 	%THEN
M   0	   2596 	    LOCAL $xpo$desc :
M   0	   2597 		%IF NOT %NULL( string )
M   0	   2598 		%THEN
M   0	   2599 		    %EXPAND $xpo$force( $STR_DESCRIPTOR(CLASS=DYNAMIC) VOLATILE );
M   0	   2600 		%ELSE
M   0	   2601 		    %EXPAND $xpo$force( $XPO_DESCRIPTOR(CLASS=DYNAMIC) VOLATILE );
M   0	   2602 		%FI
M   0	   2603 
M   0	   2604 	    $str$str_desc( $xpo$desc, DYNAMIC, string )
M   0	   2605 	    $xpo$bin_desc( $xpo$desc, DYNAMIC, binary_data )
M   0	   2606 
M   0	   2607 	    XPO$FREE_MEM(				! XPO$FREE_MEM arguments:
M   0	   2608 		$xpo$desc,				!    address of local string/data descriptor
M   0	   2609 	%ELSE
M   0	   2610 	    XPO$FREE_MEM(				! XPO$FREE_MEM arguments:
M   0	   2611 		string binary_data descriptor,		!    address of caller's string/data descriptor
M   0	   2612 	%FI
M   0	   2613 		NOT %NULL(fill),			!    fill element indicator
M   0	   2614 		$XPO$DEFAULT(fill,0),			!    fill value
M   0	   2615 		$XPO$DEFAULT(success,0),		!    address of success action routine
M   0	   2616 		$XPO$DEFAULT(failure,0) )		!    address of failure action routine
M   0	   2617 	END %;
    0	   2618 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 55
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2619 
    0	   2620 %IF NOT %BLISS(BLISS32) %THEN
U   0	   2621 $FIELD	$xpo$free_element =				! Free storage element descriptor:
U   0	   2622 	SET						!
U   0	   2623 	XPO$H_FREE_SIZE	= [$BYTES(2)],			!    size of the element (addressable units)
U   0	   2624 	XPO$A_FREE_LINK = [$ADDRESS]			!    address of the next free element
U   0	   2625 	TES;
U   0	   2626 
U   0	   2627 LITERAL $xpo$free_elem_len = $FIELD_SET_SIZE;
U   0	   2628 
U   0	   2629 MACRO
U   0	   2630     $XPO_FREE_ELEMENT =
U   0	   2631 	BLOCK[ $xpo$free_elem_len ]  FIELD( $xpo$free_element ) %;
U   0	   2632 %FI

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 56
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2634 !
    0	   2635 ! XPORT Host System Services Macros
    0	   2636 !
    0	   2637 
    0	   2638 KEYWORDMACRO
    0	   2639     $XPO_TERMINATE(
    0	   2640 	code=XPO$_TERMINATE				! termination completion code
D   0	   2641 	) =
M   0	   2642 
M   0	   2643 	BEGIN
M   0	   2644 	%EXPAND $xpo$force( $xpo$ex_routine( XPO$TERMINATE ) )
M   0	   2645 
M   0	   2646 	XPO$TERMINATE( code );				! This routine will not return.
M   0	   2647 
M   0	   2648 	RETURN 0;					! This statement keeps the compiler happy.
M   0	   2649 	END %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 57
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2651 !
    0	   2652 ! XPORT Put-Message Macros and Assorted Definitions
    0	   2653 !
    0	   2654 
    0	   2655 LITERAL							! XPO$MESSAGE severity codes:
    0	   2656     XPO$_SUCCESS = 1,					!    success
    0	   2657     XPO$_WARNING = 0,					!    warning
    0	   2658     XPO$_ERROR = 2,					!    error
    0	   2659     XPO$_FATAL = 4,					!    fatal error
    0	   2660     XPO$_NO_SEV = -1;					!    no severity code specified
    0	   2661 
    0	   2662 $LITERAL						! XPO$MESSAGE message type codes:
    0	   2663     XPO$K_PUT_COD = $DISTINCT ,				!    CODE=
		; %PRINT:				  1
    0	   2664     XPO$K_PUT_STR = $DISTINCT ;				!    STRING=
		; %PRINT:				  2
    0	   2665 
    0	   2666 
    0	   2667 MACRO
    0	   2668     $XPO_PUT_MSG( key_parameter ) =
M   0	   2669 	BEGIN
M   0	   2670 	COMPILETIME
M   0	   2671 	    $xpo$desc_count = 0,			! number of local descriptors needed
M   0	   2672 	    $xpo$desc_index = 0,			! local descriptor index
M   0	   2673 	    $xpo$sev_flag = 0,				! SEVERITY= parameter indicator
M   0	   2674 	    $xpo$succ_flag = 0,				! SUCCESS= parameter indicator
M   0	   2675 	    $xpo$fail_flag = 0;				! FAILURE= parameter indicator
M   0	   2676 
M   0	   2677 	$xpo$pmsg_init( key_parameter, %REMAINING )	! Count the number of local descriptors needed.
M   0	   2678 
M   0	   2679 	%IF $xpo$desc_count NEQ 0
M   0	   2680 	%THEN
M   0	   2681 	LOCAL
M   0	   2682 	    $xpo$local_desc :  BLOCKVECTOR[ $xpo$desc_count, STR$K_F_BLN ] VOLATILE ;
M   0	   2683 	%FI
M   0	   2684 
M   0	   2685 	%EXPAND $xpo$force( $xpo$ex_routine( XPO$MESSAGE, FORTRAN_FUNC ) )	! FORTRAN_FUNC linkage permits
M   0	   2686 										! variable length argument list
M   0	   2687 
M   0	   2688 	%IF $xpo$fail_flag				! See if user specified FAILURE= parameter.
M   0	   2689 	%THEN
M   0	   2690 	    %ASSIGN( $xpo$fail_flag, 0 )
M   0	   2691 	%ELSE
M   0	   2692 	    %EXPAND $xpo$force( $xpo$ex_routine( XPO$FAILURE ) )
M   0	   2693 	%FI
M   0	   2694 
M   0	   2695 	XPO$MESSAGE(					! Call XPORT message output routine.
M   0	   2696 
M   0	   2697 							! Generate the following fixed arguments:
M   0	   2698 	$xpo$pmsg_fixed( 1, key_parameter, %REMAINING )	!    severity code
M   0	   2699 	$xpo$pmsg_fixed( 2, key_parameter, %REMAINING )	!    address of success action routine
M   0	   2700 	$xpo$pmsg_fixed( 3, key_parameter, %REMAINING )	!    address of failure action routine
M   0	   2701 
M   0	   2702 	$xpo$pmsg_parm( key_parameter, %REMAINING )	! Generate "n" keyword argument pairs
M   0	   2703 
M   0	   2704 	)						! Trailing right parenthesis
M   0	   2705 	END %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 58
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2706 
    0	   2707 
    0	   2708 MACRO
    0	   2709     $xpo$pmsg_init( parameter ) [] =			! Count number of local descriptors needed
M   0	   2710 	$xpo$$pmsg_init( parameter )
M   0	   2711 	$xpo$pmsg_init( %REMAINING ) %;
    0	   2712 
    0	   2713 KEYWORDMACRO
    0	   2714     $xpo$$pmsg_init(					! Count number of local descriptors needed
    0	   2715 	severity,					! message severity code
    0	   2716 	success,					! address of success action routine
    0	   2717 	failure,					! address of failure action routine
    0	   2718 	code,						! message code
    0	   2719 	string						! string descriptor
    0	   2720 	) =
M   0	   2721 
M   0	   2722 	%IF NOT %NULL( failure )
M   0	   2723 	%THEN
M   0	   2724 	    %EXPAND $xpo$ex_failure( failure )
M   0	   2725 	    %ASSIGN( $xpo$fail_flag, 1 )
M   0	   2726 	%FI
M   0	   2727 
M   0	   2728 	%IF %ISSTRING( %REMOVE(string) ) OR $xpo$paren_test(string)
M   0	   2729 	%THEN
M   0	   2730 	    %ASSIGN( $xpo$desc_count, $xpo$desc_count + 1 )
M   0	   2731 	%FI %;
    0	   2732 
    0	   2733 
    0	   2734 MACRO
    0	   2735     $xpo$pmsg_fixed( number, parameter ) [] =		! Generated required arguments
M   0	   2736 	$xpo$$pmsg_parm( ARGUMENT=number, parameter )
M   0	   2737 
M   0	   2738 	%IF NOT %NULL(%REMAINING)
M   0	   2739 	%THEN
M   0	   2740 	    $xpo$pmsg_fixed( number, %REMAINING )
M   0	   2741 	%ELSE
M   0	   2742 	    %IF number EQL 1 AND NOT $xpo$sev_flag
M   0	   2743 	    %THEN
M   0	   2744 		XPO$_NO_SEV,
M   0	   2745 	    %ELSE %IF number EQL 2 AND NOT $xpo$succ_flag
M   0	   2746 	    %THEN
M   0	   2747 		0,
M   0	   2748 	    %ELSE %IF number EQL 3 AND NOT $xpo$fail_flag
M   0	   2749 	    %THEN
M   0	   2750 		XPO$FAILURE
M   0	   2751 	    %FI %FI %FI
M   0	   2752 	%FI %,
    0	   2753 
    0	   2754 
    0	   2755     $xpo$pmsg_parm( parameter ) [] =			! Generate an argument pair
M   0	   2756 	$xpo$$pmsg_parm( ARGUMENT=0, parameter )
M   0	   2757 
M   0	   2758 	$xpo$pmsg_parm( %REMAINING ) %;
    0	   2759 
    0	   2760 KEYWORDMACRO
    0	   2761     $xpo$$pmsg_parm(					! Keyword argument decoder
    0	   2762 	argument,					! positional argument indicator

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 59
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2763 	severity,					! message severity code
    0	   2764 	success,					! address of success action routine
    0	   2765 	failure,					! address of failure action routine
    0	   2766 	code,						! message code
    0	   2767 	string						! string descriptor
    0	   2768 	) =
M   0	   2769 
M   0	   2770 	%IF argument EQL 1
M   0	   2771 	%THEN
M   0	   2772 	    %IF %NULL(severity)
M   0	   2773 	    %THEN
M   0	   2774 		%EXITMACRO
M   0	   2775 	    %FI
M   0	   2776 	    %IF NOT $xpo$sev_flag
M   0	   2777 	    %THEN
M   0	   2778 		%IF $xpo$key_test( severity, (%QUOTE SUCCESS,WARNING,ERROR,FATAL), 'SEVERITY=' )
M   0	   2779 		%THEN
M   0	   2780 		    %NAME( 'XPO$_', severity ),
M   0	   2781 		%FI
M   0	   2782 		%ASSIGN( $xpo$sev_flag, 1 )
M   0	   2783 	    %ELSE
M   0	   2784 		%WARN( 'Extraneous SEVERITY= parameter ignored' )
M   0	   2785 	    %FI
M   0	   2786 	    %EXITMACRO
M   0	   2787 	%FI
M   0	   2788 
M   0	   2789 	%IF argument EQL 2
M   0	   2790 	%THEN
M   0	   2791 	    %IF %NULL(success)
M   0	   2792 	    %THEN
M   0	   2793 		%EXITMACRO
M   0	   2794 	    %FI
M   0	   2795 	    %IF NOT $xpo$succ_flag
M   0	   2796 	    %THEN
M   0	   2797 		success,
M   0	   2798 		%ASSIGN( $xpo$succ_flag, 1 )
M   0	   2799 	    %ELSE
M   0	   2800 		%WARN( 'Extraneous SUCCESS= parameter ignored' )
M   0	   2801 	    %FI
M   0	   2802 	    %EXITMACRO
M   0	   2803 	%FI
M   0	   2804 
M   0	   2805 	%IF argument EQL 3
M   0	   2806 	%THEN
M   0	   2807 	    %IF %NULL(failure)
M   0	   2808 	    %THEN
M   0	   2809 		%EXITMACRO
M   0	   2810 	    %FI
M   0	   2811 	    %IF NOT $xpo$fail_flag
M   0	   2812 	    %THEN
M   0	   2813 		failure
M   0	   2814 		%ASSIGN( $xpo$fail_flag, 1 )
M   0	   2815 	    %ELSE
M   0	   2816 		%WARN( 'Extraneous FAILURE= parameter ignored' )
M   0	   2817 	    %FI
M   0	   2818 	    %EXITMACRO
M   0	   2819 	%FI

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 60
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2820 
M   0	   2821 	%IF NOT %NULL(code)
M   0	   2822 	%THEN
M   0	   2823 	    , XPO$K_PUT_COD, code
M   0	   2824 	    %EXITMACRO
M   0	   2825 	%FI
M   0	   2826 
M   0	   2827 	%IF NOT %NULL(string)
M   0	   2828 	%THEN
M   0	   2829 	    , XPO$K_PUT_STR,				! generate string element code
M   0	   2830 	    BEGIN
M   0	   2831 	    $str$declare( LOCAL, $pmsg$string, string )
M   0	   2832 	    $str$local_init( $pmsg$string, string )
M   0	   2833 	    $pmsg$string
M   0	   2834 	    END
M   0	   2835 	%FI %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 61
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2837 !
    0	   2838 ! String Handling Option Block
    0	   2839 !
    0	   2840 ! NOTE:  Do not change the overall format of this option block without carefully checking
    0	   2841 !	 the compiletime creation of this block in all string handling macros.  For example,
    0	   2842 !	 these macros all assume that the option block fits in a single BLISS value
    0	   2843 !	 (even for BLISS-16) and that the function code field is at the beginning of the block.
    0	   2844 
    0	   2845 $FIELD	$str$opt_fields	= SET
    0	   2846 	STR$V_OPTIONS	= [$BITS(16)] ,
		; %PRINT:				  [0,0,16,0]   (+%X'0')
    0	   2847 	    $OVERLAY( STR$V_OPTIONS )
    0	   2848 	$str$v_option1	= [$BITS(8)] ,
		; %PRINT:				  [0,0,8,0]   (+%X'0')
    0	   2849 	$str$v_option2	= [$BITS(8)] ,
		; %PRINT:				  [0,8,8,0]   (+%X'1')
    0	   2850 
    0	   2851 	    $OVERLAY( $str$v_option1 )
    0	   2852 	STR$V_FUNCTION	= [$BITS(8)] ,			! $STR_ASCII, $STR_BINARY, $STR_SCAN function code
		; %PRINT:				  [0,0,8,0]   (+%X'0')
    0	   2853 
    0	   2854 	    $OVERLAY( $str$v_option1 )			! $STR_FORMAT options:
    0	   2855 	STR$V_LEFT_JUST	= [$BIT] ,			!    LEFT_JUSTIFY
		; %PRINT:				  [0,0,1,0]   (+%X'0')
    0	   2856 	STR$V_RIGHT_JUS	= [$BIT] ,			!    RIGHT_JUSTIFY
		; %PRINT:				  [0,1,1,0]   (+%X'0')
    0	   2857 	STR$V_CENTER	= [$BIT] ,			!    CENTER
		; %PRINT:				  [0,2,1,0]   (+%X'0')
    0	   2858 
    0	   2859 	    $OVERLAY( $str$v_option2 )			! Common string function options:
    0	   2860 	STR$V_SIGNED	= [$BIT] ,			!    SIGNED
		; %PRINT:				  [0,8,1,0]   (+%X'1')
    0	   2861 	STR$V_UNSIGNED	= [$BIT] ,			!    UNSIGNED
		; %PRINT:				  [0,9,1,0]   (+%X'1')
    0	   2862 	STR$V_LEADING_Z	= [$BIT] ,			!    LEADING_ZERO
		; %PRINT:				  [0,10,1,0]   (+%X'1')
    0	   2863 	STR$V_LEADING_B	= [$BIT] ,			!    LEADING_BLANK
		; %PRINT:				  [0,11,1,0]   (+%X'1')
    0	   2864 	STR$V_UP_CASE	= [$BIT] ,			!    UP_CASE
		; %PRINT:				  [0,12,1,0]   (+%X'1')
    0	   2865 	STR$V_TRUNCATE	= [$BIT] ,			!    TRUNCATE
		; %PRINT:				  [0,13,1,0]   (+%X'1')
    0	   2866 	STR$V_NO_FREE_T	= [$BIT] ,			!    don't free temporary string - internal XPORT use only
		; %PRINT:				  [0,14,1,0]   (+%X'1')
    0	   2867 
    0	   2868 	    $OVERLAY( $str$v_option2 )			! $STR_SCAN options:
    0	   2869 	STR$V_REMAINDER	= [$BIT] ,			!    REMAINDER=
		; %PRINT:				  [0,8,1,0]   (+%X'1')
    0	   2870 	STR$V_TARGET	= [$BIT]			!    TARGET=
		; %PRINT:				  [0,9,1,0]   (+%X'1')
    0	   2871 	TES;
    0	   2872 
    0	   2873 LITERAL
    0	   2874     $xpo$mask_set( STR$V_, OPTIONS,			! Define masks for option bits
P   0	   2875 		LEFT_JUST, RIGHT_JUS, CENTER,
P   0	   2876 		SIGNED, UNSIGNED, LEADING_Z, LEADING_B, UP_CASE, TRUNCATE, NO_FREE_T,
P   0	   2877 		REMAINDER, TARGET );

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 62
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

		; %PRINT:		STR$M_LEFT_JUST	= 1
		; %PRINT:		STR$M_RIGHT_JUS	= 2
		; %PRINT:		STR$M_CENTER	= 4
		; %PRINT:		STR$M_SIGNED	= 256
		; %PRINT:		STR$M_UNSIGNED	= 512
		; %PRINT:		STR$M_LEADING_Z	= 1024
		; %PRINT:		STR$M_LEADING_B	= 2048
		; %PRINT:		STR$M_UP_CASE	= 4096
		; %PRINT:		STR$M_TRUNCATE	= 8192
		; %PRINT:		STR$M_NO_FREE_T	= 16384
		; %PRINT:		STR$M_REMAINDER	= 256
		; %PRINT:		STR$M_TARGET	= 512
    0	   2878 
    0	   2879 MACRO
    0	   2880     $STR_OPTIONS =
M   0	   2881 	BLOCK[]  FIELD( $str$opt_fields ) %,
    0	   2882 
    0	   2883 
    0	   2884     $str$opt_init =
M   0	   2885 	%IF %DECLARED( $XPO$INTERNAL )
M   0	   2886 	%THEN
M   0	   2887 	    STR$M_NO_FREE_T
M   0	   2888 	%ELSE
M   0	   2889 	    0
M   0	   2890 	%FI %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 63
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2892 !
    0	   2893 ! String Comparison Functions
    0	   2894 !
    0	   2895 !	$STR_EQL, $STR_NEQ, $STR_LSS, $STR_LEQ, $STR_GEQ, $STR_GTR, $STR_COMPARE
    0	   2896 !
    0	   2897 
    0	   2898 KEYWORDMACRO
    0	   2899     $STR_EQL( string1, string2, fill, success, failure = STR$FAILURE ) =
M   0	   2900 	%EXPAND $xpo$required( string1, 'STRING1=' )
M   0	   2901 	%EXPAND $xpo$required( string2, 'STRING2=' )
M   0	   2902 	$str$compare( XST$EQL, string1, string2, fill, success, failure ) %,
    0	   2903 
    0	   2904     $STR_NEQ( string1, string2, fill, success, failure = STR$FAILURE ) =
M   0	   2905 	%EXPAND $xpo$required( string1, 'STRING1=' )
M   0	   2906 	%EXPAND $xpo$required( string2, 'STRING2=' )
M   0	   2907 	$str$compare( XST$NEQ, string1, string2, fill, success, failure ) %,
    0	   2908 
    0	   2909     $STR_LSS( string1, string2, fill, success, failure = STR$FAILURE ) =
M   0	   2910 	%EXPAND $xpo$required( string1, 'STRING1=' )
M   0	   2911 	%EXPAND $xpo$required( string2, 'STRING2=' )
M   0	   2912 	$str$compare( XST$LSS, string1, string2, fill, success, failure ) %,
    0	   2913 
    0	   2914     $STR_LEQ( string1, string2, fill, success, failure = STR$FAILURE ) =
M   0	   2915 	%EXPAND $xpo$required( string1, 'STRING1=' )
M   0	   2916 	%EXPAND $xpo$required( string2, 'STRING2=' )
M   0	   2917 	$str$compare( XST$LEQ, string1, string2, fill, success, failure ) %,
    0	   2918 
    0	   2919     $STR_GEQ( string1, string2, fill, success, failure = STR$FAILURE ) =
M   0	   2920 	%EXPAND $xpo$required( string1, 'STRING1=' )
M   0	   2921 	%EXPAND $xpo$required( string2, 'STRING2=' )
M   0	   2922 	$str$compare( XST$GEQ, string1, string2, fill, success, failure ) %,
    0	   2923 
    0	   2924     $STR_GTR( string1, string2, fill, success, failure = STR$FAILURE ) =
M   0	   2925 	%EXPAND $xpo$required( string1, 'STRING1=' )
M   0	   2926 	%EXPAND $xpo$required( string2, 'STRING2=' )
M   0	   2927 	$str$compare( XST$GTR, string1, string2, fill, success, failure ) %,
    0	   2928 
    0	   2929     $STR_COMPARE( string1, string2, fill, success, failure = STR$FAILURE ) =
M   0	   2930 	%EXPAND $xpo$required( string1, 'STRING1=' )
M   0	   2931 	%EXPAND $xpo$required( string2, 'STRING2=' )
M   0	   2932 	$str$compare( XST$CMP, string1, string2, fill, success, failure ) %;
    0	   2933 
    0	   2934 MACRO
    0	   2935     $str$compare( routine_name, string1, string2, fill, success, failure ) =
M   0	   2936 	BEGIN
M   0	   2937 	%EXPAND $xpo$ex_routine( routine_name )
M   0	   2938 	%EXPAND $xpo$ex_failure( failure )
M   0	   2939 
M   0	   2940 	%EXPAND $str$declare( LOCAL, $str$string1, string1 )
M   0	   2941 	%EXPAND $str$declare( LOCAL, $str$string2, string2 )
M   0	   2942 
M   0	   2943 	%EXPAND $str$local_init( $str$string1, string1 )
M   0	   2944 	%EXPAND $str$local_init( $str$string2, string2 )
M   0	   2945 
M   0	   2946 	routine_name( %EXPAND $str$opt_init,
M   0	   2947 			$str$string1,
M   0	   2948 			$str$string2,

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 64
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   2949 			$xpo$default( fill, -1 ),
M   0	   2950 			$xpo$default( success, 0 ),
M   0	   2951 			$xpo$default( failure, 0 ) )
M   0	   2952 	END %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 65
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   2954 !
    0	   2955 ! String Modification Functions
    0	   2956 !
    0	   2957 !	$STR_COPY, $STR_APPEND
    0	   2958 !
    0	   2959 
    0	   2960 KEYWORDMACRO
    0	   2961     $STR_COPY(
    0	   2962 	string,						! string descriptor
    0	   2963 	target,						! target buffer descriptor
    0	   2964 	option,						! option keyword
    0	   2965 	options,					! options keyword list
    0	   2966 	success,					! address of success action routine
    0	   2967 	failure = STR$FAILURE				! address of failure action routine
D   0	   2968 	) =
M   0	   2969 
M   0	   2970 	%EXPAND $xpo$required( string, 'STRING=' )
M   0	   2971 	%EXPAND $xpo$required( target, 'TARGET=' )
M   0	   2972 
M   0	   2973 	%IF %ISSTRING( %REMOVE(target) )
M   0	   2974 	%THEN
M   0	   2975 	    %WARN( 'TARGET=literal-string is not permitted' )
M   0	   2976 	%FI
M   0	   2977 
M   0	   2978 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   2979 	%THEN
M   0	   2980 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   2981 	%FI
M   0	   2982 
M   0	   2983 	%ASSIGN( $str$options, %EXPAND $str$opt_init )
M   0	   2984 	$str$copy_opt( option %REMOVE(options) )
M   0	   2985 
M   0	   2986 	BEGIN
M   0	   2987 	%EXPAND $xpo$force( $xpo$ex_routine( XST$COPY ) )
M   0	   2988 	%EXPAND $xpo$ex_failure( failure )
M   0	   2989 
M   0	   2990 	%EXPAND $str$declare( LOCAL, $str$string, string )
M   0	   2991 	%EXPAND $str$declare( LOCAL, $str$target, target )
M   0	   2992 
M   0	   2993 	%EXPAND $str$local_init( $str$string, string )
M   0	   2994 	%EXPAND $str$local_init( $str$target, target )
M   0	   2995 
M   0	   2996 	XST$COPY( %NUMBER( $str$options ),
M   0	   2997 		$str$string,
M   0	   2998 		$str$target,
M   0	   2999 		$xpo$default( success, 0 ),
M   0	   3000 		$xpo$default( failure, 0 ) )
M   0	   3001 	END %,
    0	   3002 
    0	   3003 
    0	   3004     $STR_APPEND(
    0	   3005 	string,						! string descriptor
    0	   3006 	target,						! target buffer descriptor
    0	   3007 	option,						! option keyword
    0	   3008 	options,					! options keyword list
    0	   3009 	success,					! address of success action routine
    0	   3010 	failure = STR$FAILURE				! address of failure action routine

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 66
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

D   0	   3011 	) =
M   0	   3012 
M   0	   3013 	%EXPAND $xpo$required( string, 'STRING=' )
M   0	   3014 	%EXPAND $xpo$required( target, 'TARGET=' )
M   0	   3015 
M   0	   3016 	%IF %ISSTRING( %REMOVE(target) )
M   0	   3017 	%THEN
M   0	   3018 	    %WARN( 'TARGET=literal-string is not permitted' )
M   0	   3019 	%FI
M   0	   3020 
M   0	   3021 	%IF $xpo$paren_test( target ) AND NOT %ISSTRING( %REMOVE(target) )
M   0	   3022 	%THEN
M   0	   3023 	    %WARN( 'TARGET=(length,pointer) is not permitted' )
M   0	   3024 	%FI
M   0	   3025 
M   0	   3026 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   3027 	%THEN
M   0	   3028 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   3029 	%FI
M   0	   3030 
M   0	   3031 	%ASSIGN( $str$options, %EXPAND $str$opt_init )
M   0	   3032 	$str$copy_opt( option %REMOVE(options) )
M   0	   3033 
M   0	   3034 	BEGIN
M   0	   3035 	%EXPAND $xpo$force( $xpo$ex_routine( XST$APPEND ) )
M   0	   3036 	%EXPAND $xpo$ex_failure( failure )
M   0	   3037 
M   0	   3038 	%EXPAND $str$declare( LOCAL, $str$string, string )
M   0	   3039 	%EXPAND $str$local_init( $str$string, string )
M   0	   3040 
M   0	   3041 	XST$APPEND( %NUMBER( $str$options ),
M   0	   3042 		$str$string,
M   0	   3043 		target,
M   0	   3044 		$xpo$default( success, 0 ),
M   0	   3045 		$xpo$default( failure, 0 ) )
M   0	   3046 	END %;
    0	   3047 
    0	   3048 
    0	   3049 MACRO
    0	   3050     $str$copy_opt( option ) [] =
M   0	   3051 	%IF NOT $xpo$key_test( option, (UP_CASE, TRUNCATE), 'OPTIONS=' )
M   0	   3052 	%THEN
M   0	   3053 	    %EXITMACRO
M   0	   3054 	%FI
M   0	   3055 
M   0	   3056 	%ASSIGN( $str$options, $str$options + $xpo$name15( 'STR$M_', option ) )
M   0	   3057 
M   0	   3058 	$str$copy_opt( %REMAINING ) %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 67
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   3060 !
    0	   3061 ! ASCII-to-ASCII String Conversion Functions
    0	   3062 !
    0	   3063 !	$STR_CONCAT, $STR_FORMAT
    0	   3064 !
    0	   3065 ! Binary-to-ASCII String Conversion Function
    0	   3066 !
    0	   3067 !	$STR_ASCII
    0	   3068 !
    0	   3069 
    0	   3070 $LITERAL						! $STR_ASCII and $STR_BINARY function codes:
    0	   3071 	STR$K_DFLT_FUNC	= 0,				!    default function
    0	   3072 	STR$K_BASE2	= $DISTINCT,			!    $STR_ASCII( value, BASE2 )
		; %PRINT:				  1
    0	   3073 	STR$K_BASE8	= $DISTINCT,			!    $STR_ASCII( value, BASE8 )
		; %PRINT:				  2
    0	   3074 	STR$K_BASE10	= $DISTINCT,			!    $STR_ASCII( value, BASE10 )
		; %PRINT:				  3
    0	   3075 	STR$K_BASE16	= $DISTINCT,			!    $STR_ASCII( value, BASE16 )
		; %PRINT:				  4
    0	   3076 	STR$K_DATE	= $DISTINCT,			!    $STR_ASCII( value, DATE )
		; %PRINT:				  5
    0	   3077 	STR$K_TIME	= $DISTINCT,			!    $STR_ASCII( value, TIME )
		; %PRINT:				  6
    0	   3078 	STR$K_DAY	= $DISTINCT;			!    $STR_ASCII( value, DAY )
		; %PRINT:				  7
    0	   3079 
    0	   3080 COMPILETIME
    0	   3081     $str$function = 0,					! string function code
    0	   3082     $str$options = 0,					! string processing options
    0	   3083     $str$length = 0;					! string field length indicator
    0	   3084 
    0	   3085 MACRO
    0	   3086     $CONCAT =							! ***** OBSOLETE *****
M   0	   3087 	%INFORM( '$CONCAT has been renamed to $STR_CONCAT' )	! ***** OBSOLETE *****
M   0	   3088 	%QUOTE $STR_CONCAT %,					! ***** OBSOLETE *****
    0	   3089 
    0	   3090     $STR_CONCAT [] =
M   0	   3091 	BEGIN
M   0	   3092 	%EXPAND $xpo$force( $xpo$ex_routine( XST$JOIN, FORTRAN_FUNC ) )
M   0	   3093 
M   0	   3094 	$str$con_decl( %REMAINING )
M   0	   3095 
M   0	   3096 	$str$con_init( %REMAINING )
M   0	   3097 
M   0	   3098 	XST$JOIN( $str$con_args( %REMAINING ) )
M   0	   3099 	END %,
    0	   3100 
    0	   3101 
    0	   3102     $str$con_decl( string_info ) [] =
M   0	   3103 	$str$declare( LOCAL, %NAME(%STRING('$str$string',%COUNT)), string_info )
M   0	   3104 
M   0	   3105 	$str$con_decl( %REMAINING ) %,
    0	   3106 
    0	   3107 
    0	   3108     $str$con_init( string_info ) [] =
M   0	   3109 	$str$local_init( %NAME(%STRING('$str$string',%COUNT)), string_info )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 68
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   3110 
M   0	   3111 	$str$con_init( %REMAINING ) %,
    0	   3112 
    0	   3113 
    0	   3114     $str$con_args( string_info ) [] =
M   0	   3115 	%IF %COUNT NEQ 0 %THEN , %FI
M   0	   3116 
M   0	   3117 	%NAME(%STRING('$str$string',%COUNT))
M   0	   3118 
M   0	   3119 	$str$con_args( %REMAINING ) %,
    0	   3120 
    0	   3121 
    0	   3122     $FORMAT =							! ***** OBSOLETE *****
M   0	   3123 	%INFORM( '$FORMAT has been renamed to $STR_FORMAT' )	! ***** OBSOLETE *****
M   0	   3124 	%QUOTE $STR_FORMAT %,					! ***** OBSOLETE *****
    0	   3125 
    0	   3126     $STR_FORMAT( string ) =
M   0	   3127 	%ASSIGN( $str$options, %EXPAND $str$opt_init )
M   0	   3128 	%ASSIGN( $str$length, 0 )
M   0	   3129 
M   0	   3130 	$str$format_opt( %REMAINING )			! Scan the $STR_FORMAT option parameters
M   0	   3131 
M   0	   3132 	BEGIN
M   0	   3133 	%EXPAND $xpo$force( $xpo$ex_routine( XST$FORMAT ) )
M   0	   3134 
M   0	   3135 	%EXPAND $str$declare( LOCAL, $str$string, string )
M   0	   3136 	%EXPAND $str$local_init( $str$string, string )
M   0	   3137 
M   0	   3138 	XST$FORMAT( %NUMBER( $str$options ),
M   0	   3139 		$str$string,
M   0	   3140 		$str$len_val(%REMAINING)
M   0	   3141 		%IF NOT $str$length
M   0	   3142 		%THEN
M   0	   3143 		    0
M   0	   3144 		%FI )
M   0	   3145 	END %,
    0	   3146 
    0	   3147 
    0	   3148     $str$format_opt( option ) [] =
M   0	   3149 	%IF $xpo$key_check( option, (UP_CASE, LEFT_JUSTIFY, RIGHT_JUSTIFY, CENTER), 'Option' )
M   0	   3150 	%THEN
M   0	   3151 	    %ASSIGN( $str$options, $str$options OR $xpo$name15( 'STR$M_', option ) )
M   0	   3152 	%ELSE
M   0	   3153 	    $str$format_key( option )
M   0	   3154 	%FI
M   0	   3155 
M   0	   3156 	$str$format_opt( %REMAINING ) %;
    0	   3157 
    0	   3158 
    0	   3159 KEYWORDMACRO
    0	   3160     $str$format_key( length ) = %;
    0	   3161 
    0	   3162 
    0	   3163 MACRO
    0	   3164     $ASCII =							! ***** OBSOLETE *****
M   0	   3165 	%INFORM( '$ASCII has been renamed to $STR_ASCII' )	! ***** OBSOLETE *****
M   0	   3166 	%QUOTE $STR_ASCII %,					! ***** OBSOLETE *****

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 69
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   3167 
    0	   3168     $STR_ASCII( value ) =
M   0	   3169 	%ASSIGN( $str$function, STR$K_BASE10 )
M   0	   3170 	%ASSIGN( $str$options, %EXPAND $str$opt_init )
M   0	   3171 	%ASSIGN( $str$length, 0 )
M   0	   3172 
M   0	   3173 	$str$ascii_opt( %REMAINING )			! Scan the $STR_ASCII option parameters
M   0	   3174 
M   0	   3175 	%IF ( $str$options AND ( STR$M_LEADING_B OR STR$M_LEADING_Z ) ) EQL 0
M   0	   3176 	%THEN
M   0	   3177 	    %IF $str$function EQL STR$K_BASE10
M   0	   3178 	    %THEN
M   0	   3179 		%ASSIGN( $str$options, $str$options OR STR$M_LEADING_B )
M   0	   3180 	    %ELSE
M   0	   3181 		%ASSIGN( $str$options, $str$options OR STR$M_LEADING_Z )
M   0	   3182 	    %FI
M   0	   3183 	%FI
M   0	   3184 
M   0	   3185 	%IF ( $str$options AND ( STR$M_SIGNED OR STR$M_UNSIGNED ) ) EQL 0
M   0	   3186 	%THEN
M   0	   3187 	    %IF $str$function EQL STR$K_BASE10
M   0	   3188 	    %THEN
M   0	   3189 		%ASSIGN( $str$options, $str$options OR STR$M_SIGNED )
M   0	   3190 	    %ELSE
M   0	   3191 		%ASSIGN( $str$options, $str$options OR STR$M_UNSIGNED )
M   0	   3192 	    %FI
M   0	   3193 	%FI
M   0	   3194 
M   0	   3195 	BEGIN
M   0	   3196 	%EXPAND $xpo$force( $xpo$ex_routine( XST$ASCII ) )
M   0	   3197 
M   0	   3198 	XST$ASCII( %NUMBER( $str$options ) + %NUMBER( $str$function ),
M   0	   3199 		value,
M   0	   3200 		$str$len_val(%REMAINING)
M   0	   3201 		%IF NOT $str$length
M   0	   3202 		%THEN
M   0	   3203 		    0
M   0	   3204 		%FI )
M   0	   3205 	END %,
    0	   3206 
    0	   3207 
    0	   3208     $str$ascii_opt( option ) [] =
M   0	   3209 	%IF $xpo$key_check( option, ( BASE2, BASE8, BASE10, BASE16,
M   0	   3210 					SIGNED, UNSIGNED,
M   0	   3211 					LEADING_BLANK, LEADING_ZERO,
M   0	   3212 					DATE, TIME, DAY ) )
M   0	   3213 	%THEN
M   0	   3214 	    %IF $xpo$key_check( option, ( BASE2, BASE8, BASE10, BASE16, DATE, TIME, DAY ) )
M   0	   3215 	    %THEN
M   0	   3216 		%ASSIGN( $str$function, $xpo$name15( 'STR$K_', option ) )
M   0	   3217 	    %ELSE
M   0	   3218 		%ASSIGN( $str$options, $str$options OR $xpo$name15( 'STR$M_', option ) )
M   0	   3219 	    %FI
M   0	   3220 	%ELSE
M   0	   3221 	    $str$ascii_key( option )
M   0	   3222 	%FI
M   0	   3223 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 70
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   3224 	$str$ascii_opt( %REMAINING ) %;
    0	   3225 
    0	   3226 
    0	   3227 KEYWORDMACRO
    0	   3228     $str$ascii_key( length ) = %;
    0	   3229 
    0	   3230 
    0	   3231 MACRO
    0	   3232     $str$len_val( parameter ) [] =
M   0	   3233 	%IF NOT $xpo$key_check( parameter, ( BASE2, BASE8, BASE10, BASE16, DATE, TIME, DAY,
M   0	   3234 						SIGNED, UNSIGNED, LEADING_ZERO, LEADING_BLANK, UP_CASE,
M   0	   3235 						LEFT_JUSTIFY, RIGHT_JUSTIFY, CENTER ) )
M   0	   3236 	%THEN
M   0	   3237 	    $str$$len_val( parameter )
M   0	   3238 	%FI
M   0	   3239 
M   0	   3240 	$str$len_val( %REMAINING ) %;
    0	   3241 
    0	   3242 KEYWORDMACRO
    0	   3243     $str$$len_val( length ) =
M   0	   3244 	%IF NOT %NULL( length )
M   0	   3245 	%THEN
M   0	   3246 	    %IF $str$length
M   0	   3247 	    %THEN
M   0	   3248 		%WARN( 'Only one LENGTH= parameter permitted' )
M   0	   3249 	    %ELSE
M   0	   3250 		length
M   0	   3251 		%ASSIGN( $str$length, 1 )
M   0	   3252 	    %FI
M   0	   3253 	%FI %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 71
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   3255 !
    0	   3256 ! ASCII-to-binary String Conversion Function
    0	   3257 !
    0	   3258 !	$STR_BINARY
    0	   3259 !
    0	   3260 
    0	   3261 COMPILETIME
    0	   3262     $str$int_result = 0;				! Integer result indicator
    0	   3263 
    0	   3264 							! $STR_BINARY function codes:
    0	   3265 							!     see $STR_ASCII functions codes
    0	   3266 
    0	   3267 KEYWORDMACRO
    0	   3268     $STR_BINARY( string, result, option, options, range, success, failure = STR$FAILURE ) =
M   0	   3269 
M   0	   3270 	%EXPAND $xpo$required( string, 'STRING=' )
M   0	   3271 
M   0	   3272 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   3273 	%THEN
M   0	   3274 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   3275 	    %EXITMACRO
M   0	   3276 	%FI
M   0	   3277 
M   0	   3278 	%ASSIGN( $str$function, STR$K_DFLT_FUNC )
M   0	   3279 
M   0	   3280 	$str$binary_opt( option %REMOVE(options) )
M   0	   3281 
M   0	   3282 	%IF NOT %NULL(result) AND $str$function LEQ STR$K_BASE16
M   0	   3283 	%THEN
M   0	   3284 	    %ASSIGN( $str$int_result, 1 )
M   0	   3285 	%ELSE
M   0	   3286 	    %ASSIGN( $str$int_result, 0 )
M   0	   3287 	%FI
M   0	   3288 
M   0	   3289 	BEGIN
M   0	   3290 	%EXPAND $xpo$force( $xpo$ex_routine( XST$BINARY ) )
M   0	   3291 	%EXPAND $xpo$ex_failure( failure )
M   0	   3292 
M   0	   3293 	%IF $str$int_result
M   0	   3294 	%THEN
M   0	   3295 	    LOCAL
M   0	   3296 		$str$result,
M   0	   3297 		$str$status;
M   0	   3298 	%FI
M   0	   3299 
M   0	   3300 	%EXPAND $str$declare( LOCAL, $str$string, string )
M   0	   3301 	%EXPAND $str$local_init( $str$string, string )
M   0	   3302 
M   0	   3303 	%IF $str$int_result
M   0	   3304 	%THEN
M   0	   3305 	    $str$status =
M   0	   3306 	%FI
M   0	   3307 
M   0	   3308 	XST$BINARY( %EXPAND $str$opt_init + %NUMBER( $str$function ),
M   0	   3309 		$str$string,
M   0	   3310 		%IF $str$int_result
M   0	   3311 		%THEN

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 72
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   3312 		    $str$result,
M   0	   3313 		%ELSE
M   0	   3314 		    $xpo$default( result, 0 ),
M   0	   3315 		%FI
M   0	   3316 		%IF %NULL( range )
M   0	   3317 		%THEN
M   0	   3318 		    0, 0,
M   0	   3319 		%ELSE
M   0	   3320 		    $xpo$arg1( %REMOVE( range ) ),
M   0	   3321 		    $xpo$arg2( %REMOVE( range ) ),
M   0	   3322 		%FI
M   0	   3323 		$xpo$default( success, 0 ),
M   0	   3324 		$xpo$default( failure, 0 ) )
M   0	   3325 
M   0	   3326 	%IF $str$int_result
M   0	   3327 	%THEN
M   0	   3328 	    ;
M   0	   3329 	    IF .$str$status
M   0	   3330 	    THEN
M   0	   3331 		result = .$str$result;
M   0	   3332 	    .$str$status
M   0	   3333 	%FI
M   0	   3334 	END %;
    0	   3335 
    0	   3336 
    0	   3337 MACRO
    0	   3338     $str$binary_opt( option ) [] =
M   0	   3339 	%IF NOT $xpo$key_test( option, (BASE2, BASE8, BASE10, BASE16, DATE, TIME), 'OPTIONS=' )
M   0	   3340 	%THEN
M   0	   3341 	    %EXITMACRO
M   0	   3342 	%FI
M   0	   3343 
M   0	   3344 	%IF $str$function NEQ STR$K_DFLT_FUNC
M   0	   3345 	%THEN
M   0	   3346 	    %WARN( 'Conflicting conversion options' )
M   0	   3347 	    %EXITMACRO
M   0	   3348 	%FI
M   0	   3349 
M   0	   3350 	%ASSIGN( $str$function,  $xpo$name15( 'STR$K_', option ) )
M   0	   3351 
M   0	   3352 	$str$binary_opt( %REMAINING ) %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 73
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   3354 !
    0	   3355 ! String Scanning Functions
    0	   3356 !
    0	   3357 !	$STR_SCAN( FIND = sub-string, ... )
    0	   3358 !	$STR_SCAN( SPAN = characters, ... )
    0	   3359 !	$STR_SCAN( STOP = characters, ... )
    0	   3360 !
    0	   3361 
    0	   3362 $LITERAL						! String scanning function codes:
    0	   3363 	STR$K_FIND	= $DISTINCT,			!    find sub-string
		; %PRINT:				  1
    0	   3364 	STR$K_SPAN	= $DISTINCT,			!    match specified characters
		; %PRINT:				  2
    0	   3365 	STR$K_STOP	= $DISTINCT;			!    search for specified characters
		; %PRINT:				  3
    0	   3366 
    0	   3367 KEYWORDMACRO
    0	   3368     $STR_SCAN( string, remainder, find, span, stop, option, options,
    0	   3369 		substring, target, delimiter, success, failure = STR$FAILURE ) =
M   0	   3370 
M   0	   3371 	%EXPAND $xpo$required( string remainder, 'STRING= or REMAINDER=' )
M   0	   3372 	%EXPAND $xpo$required( find span stop, 'FIND=, SPAN= or STOP=' )
M   0	   3373 
M   0	   3374 	%IF %EXPAND $xpo$conflict( string, remainder )
M   0	   3375 	%THEN
M   0	   3376 	    %WARN( 'STRING= and REMAINDER= are mutually exclusive' )
M   0	   3377 	    %EXITMACRO
M   0	   3378 	%FI
M   0	   3379 
M   0	   3380 	%IF %EXPAND $xpo$conflict( find, span, stop )
M   0	   3381 	%THEN
M   0	   3382 	    %WARN( 'FIND=, SPAN= and STOP= are mutually exclusive' )
M   0	   3383 	    %EXITMACRO
M   0	   3384 	%FI
M   0	   3385 
M   0	   3386 	%IF %EXPAND $xpo$conflict( option, options )
M   0	   3387 	%THEN
M   0	   3388 	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
M   0	   3389 	    %EXITMACRO
M   0	   3390 	%FI
M   0	   3391 
M   0	   3392 	%IF %EXPAND $xpo$conflict( substring, target )
M   0	   3393 	%THEN
M   0	   3394 	    %WARN( 'SUBSTRING= and TARGET= are mutually exclusive' )
M   0	   3395 	    %EXITMACRO
M   0	   3396 	%FI
M   0	   3397 
M   0	   3398 	%ASSIGN( $str$options, %EXPAND $str$opt_init )
M   0	   3399 
M   0	   3400 	%IF NOT %NULL( remainder )
M   0	   3401 	%THEN
M   0	   3402 	    %ASSIGN( $str$options, $str$options OR STR$M_REMAINDER )
M   0	   3403 	%FI
M   0	   3404 
M   0	   3405 	%IF NOT %NULL( find )
M   0	   3406 	%THEN
M   0	   3407 	    %ASSIGN( $str$function, STR$K_FIND )

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 74
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   3408 	%ELSE %IF NOT %NULL( span )
M   0	   3409 	%THEN
M   0	   3410 	    %ASSIGN( $str$function, STR$K_SPAN )
M   0	   3411 	%ELSE
M   0	   3412 	    %ASSIGN( $str$function, STR$K_STOP )
M   0	   3413 	%FI %FI
M   0	   3414 
M   0	   3415 	%IF NOT %NULL( target )
M   0	   3416 	%THEN
M   0	   3417 	    %ASSIGN( $str$options, $str$options OR STR$M_TARGET )
M   0	   3418 	%FI
M   0	   3419 
M   0	   3420 	BEGIN
M   0	   3421 	%EXPAND $xpo$force( $xpo$ex_routine( XST$SCAN ) )
M   0	   3422 	%EXPAND $xpo$ex_failure( failure )
M   0	   3423 
M   0	   3424 	%IF NOT %NULL( delimiter )
M   0	   3425 	%THEN
M   0	   3426 	    LOCAL $str$status,
M   0	   3427 		$str$delimiter;
M   0	   3428 	%ELSE
M   0	   3429 	    LITERAL $str$delimiter = 0;
M   0	   3430 	%FI
M   0	   3431 
M   0	   3432 	$str$declare( LOCAL, $str$string, string remainder )
M   0	   3433 	$str$declare( LOCAL, $str$pattern, find span stop )
M   0	   3434 
M   0	   3435 	$str$local_init( $str$string, string remainder )
M   0	   3436 	$str$local_init( $str$pattern, find span stop )
M   0	   3437 
M   0	   3438 	%IF NOT %NULL( delimiter )
M   0	   3439 	%THEN
M   0	   3440 	    $str$status =
M   0	   3441 	%FI
M   0	   3442 
M   0	   3443 	XST$SCAN( %NUMBER( $str$options ) + %NUMBER( $str$function ),
M   0	   3444 		$str$string,
M   0	   3445 		$str$pattern,
M   0	   3446 		$xpo$default( substring target, 0 ),
M   0	   3447 		$str$delimiter,
M   0	   3448 		$xpo$default( success, 0 ),
M   0	   3449 		$xpo$default( failure, 0 ) )
M   0	   3450 
M   0	   3451 	%IF NOT %NULL( delimiter )
M   0	   3452 	%THEN
M   0	   3453 	    ;
M   0	   3454 	    IF .$str$status
M   0	   3455 	    THEN
M   0	   3456 		delimiter = .$str$delimiter;
M   0	   3457 	    .$str$status
M   0	   3458 	%FI
M   0	   3459 	END %;

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 75
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   3461 !
    0	   3462 ! XPORT Completion Code Definitions
    0	   3463 !
    0	   3464 
    0	   3465 %IF %BLISS(BLISS32) %THEN
    0	   3466 LITERAL
    0	   3467     XPO$K_VMS_CODE = 32,				! VAX/VMS facility code for XPORT
    0	   3468     $xpo$k_msg_code = 32^16 + 1^15,			! VAX/VMS message code for XPORT
    0	   3469     STR$K_VMS_CODE = 36,				! VAX/VMS facility code for XPORT String Package
    0	   3470     $str$k_msg_code = 36^16 + 1^15;			! VAX/VMS message code for XPORT String Package
    0	   3471 %FI
    0	   3472 
    0	   3473 COMPILETIME						! Initialize completion code variables
    0	   3474     $xpo$ok_val = XPO$_SUCCESS %BLISS32( + $xpo$k_msg_code ),
    0	   3475     $xpo$warn_val = XPO$_WARNING + %X'1000' %BLISS32( + $xpo$k_msg_code ),
    0	   3476     $xpo$error_val = XPO$_ERROR + %X'2000' %BLISS32( + $xpo$k_msg_code ),
    0	   3477     $xpo$fatal_val = XPO$_FATAL + %X'4000' %BLISS32( + $xpo$k_msg_code ),
    0	   3478     $str$ok_val = XPO$_SUCCESS + %X'0800' %BLISS32( + $str$k_msg_code ),
    0	   3479     $str$warn_val = XPO$_WARNING + %X'1800' %BLISS32( + $str$k_msg_code ),
    0	   3480     $str$error_val = XPO$_ERROR + %X'2800' %BLISS32( + $str$k_msg_code ),
    0	   3481     $str$fatal_val = XPO$_FATAL + %X'4800' %BLISS32( + $str$k_msg_code );
    0	   3482 
    0	   3483 KEYWORDMACRO
    0	   3484     $XPO_COMP_CODES( success, warning, error, fatal ) =
M   0	   3485 	LITERAL $xpo$comp_def( $xpo$ok_val, %REMOVE(success) );
M   0	   3486 	LITERAL $xpo$comp_def( $xpo$warn_val, %REMOVE(warning) );
M   0	   3487 	LITERAL $xpo$comp_def( $xpo$error_val, %REMOVE(error) );
M   0	   3488 	LITERAL $xpo$comp_def( $xpo$fatal_val, %REMOVE(fatal) ); %,
    0	   3489 
    0	   3490     $STR_COMP_CODES( success, warning, error, fatal ) =
M   0	   3491 	LITERAL $str$comp_def( $str$ok_val, %REMOVE(success) );
M   0	   3492 !	LITERAL $str$comp_def( $str$warn_val, %REMOVE(warning) );
M   0	   3493 	LITERAL $str$comp_def( $str$error_val, %REMOVE(error) );
M   0	   3494 	LITERAL $str$comp_def( $str$fatal_val, %REMOVE(fatal) ); %;
    0	   3495 
    0	   3496 MACRO
    0	   3497     $xpo$comp_def( code_value ) [ code_name ] =
M   0	   3498 	%NAME( 'XPO$_', $xpo$arg1(%REMOVE(code_name)) ) = code_value
M   0	   3499 
M   0	   3500 	%IF $xpo$show_lit
M   0	   3501 	%THEN
M   0	   3502 	    %PRINT( '	XPO$_', $xpo$arg1(%REMOVE(code_name)), '	= ',
M   0	   3503 		%NUMBER(code_value), '   (',
M   0	   3504 		%IF %BLISS(BLISS32)
M   0	   3505 		%THEN
M   0	   3506 		    '%X'''  $XPO$SHOW_NUMB(code_value,16)
M   0	   3507 		%ELSE
M   0	   3508 		    '%O'''  $XPO$SHOW_NUMB(code_value,8)
M   0	   3509 		%FI
M   0	   3510 		, ''')' )
M   0	   3511 	%FI
M   0	   3512 
M   0	   3513 	%ASSIGN( code_value, code_value + 8 ) %,
    0	   3514 
    0	   3515 
    0	   3516     $str$comp_def( code_value ) [ code_name ] =
M   0	   3517 	%NAME( 'STR$_', $xpo$arg1(%REMOVE(code_name)) ) = code_value

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 76
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   3518 
M   0	   3519 	%IF $xpo$show_lit
M   0	   3520 	%THEN
M   0	   3521 	    %PRINT( '	STR$_', $xpo$arg1(%REMOVE(code_name)), '	= ',
M   0	   3522 		%NUMBER(code_value), '   (',
M   0	   3523 		%IF %BLISS(BLISS32)
M   0	   3524 		%THEN
M   0	   3525 		    '%X'''  $XPO$SHOW_NUMB(code_value,16)
M   0	   3526 		%ELSE
M   0	   3527 		    '%O'''  $XPO$SHOW_NUMB(code_value,8)
M   0	   3528 		%FI
M   0	   3529 		, ''')' )
M   0	   3530 	%FI
M   0	   3531 
M   0	   3532 	%ASSIGN( code_value, code_value + 8 ) %,
    0	   3533 
    0	   3534 
    0	   3535     $XPO_OK_CODE =
M   0	   3536 	( NORMAL, 'normal completion' ),
M   0	   3537 	( CREATED, 'file was successfully created and opened' ),
M   0	   3538 	( INCOMPLETE, 'incomplete amount of data read' ),
M   0	   3539 	( NEW_FILE, 'first read on concatenated file was successful' ),
M   0	   3540 	( NEW_PAGE, 'first read on a new page was successful' ) %,
    0	   3541 
    0	   3542     $STR_OK_CODE =
M   0	   3543 	( END_STRING, 'end of string reached' ),
M   0	   3544 	( TRUNCATED, 'string was truncated' ),
M   0	   3545 	( NOT_TEMP, 'not a temporary string' ) %,
    0	   3546 
    0	   3547 
    0	   3548     $XPO_WARN_CODE =
M   0	   3549 	( END_FILE, 'end-of-file has been reached' ) %,
    0	   3550 
    0	   3551 
    0	   3552     $STR_WARN_CODE = %,
    0	   3553 
    0	   3554 
    0	   3555     $XPO_ERROR_CODE =
M   0	   3556 	( BAD_ADDR, 'invalid memory address' ),
M   0	   3557 	( BAD_ALIGN, 'memory element not on a fullword boundary' ),
M   0	   3558 	( BAD_ARGS, 'invalid argument list' ),
M   0	   3559 	( BAD_CONCAT, 'invalid concatenated file specification' ),
M   0	   3560 	( BAD_DELIM, 'invalid punctuation' ),
M   0	   3561 	( BAD_DESC, 'invalid descriptor' ),
M   0	   3562 	( BAD_DEVICE, 'invalid device' ),
M   0	   3563 	( BAD_DFLT, 'invalid default file specification' ),
M   0	   3564 	( BAD_DIRECT, 'invalid directory' ),
M   0	   3565 	( BAD_DTYPE, 'invalid data type' ),
M   0	   3566 	( BAD_FORMAT, 'invalid record format' ),
M   0	   3567 	( BAD_IO_OPT, 'invalid I/O option' ),
M   0	   3568 	( BAD_LENGTH, 'invalid length' ),
M   0	   3569 	( BAD_NAME, 'invalid file name' ),
M   0	   3570 	( BAD_NEW, 'invalid new file' ),
M   0	   3571 	( BAD_NODE, 'invalid node' ),
M   0	   3572 	( BAD_ORG, 'invalid file organization' ),
M   0	   3573 	( BAD_PROMPT, 'invalid prompt' ),
M   0	   3574 	( BAD_RECORD, 'invalid record' ),

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 77
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   3575 	( BAD_REQ, 'invalid request' ),
M   0	   3576 	( BAD_RLTD, 'invalid related file specification' ),
M   0	   3577 	( BAD_RSLT, 'invalid resultant file specification' ),
M   0	   3578 	( BAD_SPEC, 'invalid file specification' ),
M   0	   3579 	( BAD_TYPE, 'invalid file type' ),
M   0	   3580 	( BAD_VER, 'invalid file version' ),
M   0	   3581 	( CHANNEL, 'I/O channel assignment error' ),
M   0	   3582 	( CLOSED, 'file is already closed' ),
M   0	   3583 	( CONFLICT, 'conflicting options or attributes' ),
M   0	   3584 	( CORRUPTED, 'file is corrupted' ),
M   0	   3585 	( EXISTS, 'file already exists' ),
M   0	   3586 	( FILE_LOCK, 'file is locked' ),
M   0	   3587 	( FREE_MEM, 'dynamic memory deallocation error' ),
M   0	   3588 	( GET_MEM, 'dynamic memory allocation error' ),
M   0	   3589 	( IN_USE, 'file is currently in use' ),
M   0	   3590 	( IO_BUFFER, 'I/O buffering error' ),
M   0	   3591 	( IO_ERROR, 'I/O error' ),
M   0	   3592 	( MISSING, 'required parameter, option or attribute missing' ),
M   0	   3593 	( NETWORK, 'network error' ),
M   0	   3594 	( NO_ACCESS, 'file cannot be accessed' ),
M   0	   3595 	( NO_BACKUP, 'file cannot be backed up' ),
M   0	   3596 	( NO_CHANNEL, 'all I/O channels are in use' ),
M   0	   3597 	( NO_CLOSE, 'file cannot be closed' ),
M   0	   3598 	( NO_CONCAT, 'concatenated file specification not allowed' ),
M   0	   3599 	( NO_CREATE, 'file cannot be created' ),
M   0	   3600 	( NO_DELETE, 'file cannot be deleted' ),
M   0	   3601 	( NO_DIRECT, 'directory does not exist' ),
M   0	   3602 	( NO_FILE, 'file does not exist' ),
M   0	   3603 	( NO_MEMORY, 'insufficient dynamic memory' ),
M   0	   3604 	( NO_OPEN, 'file cannot be opened' ),
M   0	   3605 	( NO_READ, 'file cannot be read' ),
M   0	   3606 	( NO_RENAME, 'file cannot be renamed' ),
M   0	   3607 	( NO_SPACE, 'insufficient space' ),
M   0	   3608 	( NO_SUBDIR, 'sub-directory does not exist' ),
M   0	   3609 	( NO_SUPPORT, 'requested function not supported' ),
M   0	   3610 	( NO_WRITE, 'file cannot be written' ),
M   0	   3611 	( NOT_CLOSED, 'file has not been closed' ),
M   0	   3612 	( NOT_EXPIRE, 'expiration date has not been reached' ),
M   0	   3613 	( NOT_INPUT, 'file is not open for input' ),
M   0	   3614 	( NOT_ONLINE, 'device is not online' ),
M   0	   3615 	( NOT_OPEN, 'file has not been opened' ),
M   0	   3616 	( NOT_OUTPUT, 'file is not open for output' ),
M   0	   3617 	( OPEN, 'file is currently open' ),
M   0	   3618 	( PREV_ERROR, 'program terminated due to previous error' ),
M   0	   3619 	( PRIVILEGED, 'privileged operation' ),
M   0	   3620 	( PROTECTED, 'file protection denies access' ),
M   0	   3621 	( PUT_MSG, 'message output error' ),
M   0	   3622 	( REC_LOCK, 'record is locked' ),
M   0	   3623 	( RENAME_NEW, 'new file cannot be renamed' ),
M   0	   3624 	( RENAME_OLD, 'old file cannot be renamed' ),
M   0	   3625 	( TRUNCATED, 'record was truncated' ),
M   0	   3626 	( WILDCARD, 'wildcard error' ),
M   0	   3627 	( BAD_ACCT, 'invalid account attribute' ),
M   0	   3628 	( BAD_ATTR, 'invalid attribute' ),
M   0	   3629 	( BAD_DATA, 'invalid data' ),
M   0	   3630 	( BAD_MEDIA, 'disk/tape cannot be read/written' ),
M   0	   3631 	( BAD_MEMORY, 'free storage chain is invalid' ),

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 78
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

M   0	   3632 	( BAD_PROT, 'invalid protection attribute' ),
M   0	   3633 	( BAD_PTR, 'invalid character pointer' ),
M   0	   3634 	( BAD_RECNUM, 'invalid record number' ),
M   0	   3635 	( BAD_SIZE, 'invalid size' ),
M   0	   3636 	( BAD_TEMP, 'invalid temporary file attribute' ),
M   0	   3637 	( CHAN_USED, 'I/O channel is currently in use' ),
M   0	   3638 	( HOST_ERROR, 'host operating system error' ),
M   0	   3639 	( NO_NODE, 'network node does not exist' ),
M   0	   3640 	( NO_STACK, 'insufficient stack space' ),
M   0	   3641 	( SYS_ERROR, 'unexpected operating system error' ),
M   0	   3642 	( BAD_CLASS, 'invalid descriptor class' ),
M   0	   3643 	( NO_TEMP, 'temporary file not permitted' ),
M   0	   3644     	( FOREGROUND, 'foreground jobs not permitted' ),
M   0	   3645     	( NO_APPEND, 'append function not permitted' ),
M   0	   3646     	( NO_SEQ, 'sequenced files not permitted' ),
M   0	   3647 	( BAD_ORDER, 'field is misplaced or duplicated' ),
M   0	   3648 	( BAD_SYNTAX, 'invalid syntax' ) %,
    0	   3649 
    0	   3650 
    0	   3651     $STR_ERROR_CODE =
M   0	   3652 	( BAD_CHAR, 'invalid character' ),
M   0	   3653 	( BAD_CLASS, 'invalid descriptor class' ),
M   0	   3654 	( BAD_DESC, 'invalid string descriptor' ),
M   0	   3655 	( BAD_DTYPE, 'invalid descriptor data type' ),
M   0	   3656 	( BAD_LENGTH, 'invalid string length' ),
M   0	   3657 	( BAD_MAXLEN, 'invalid maximum string length' ),
M   0	   3658 	( BAD_PATTRN, 'invalid pattern string' ),
M   0	   3659 	( BAD_PTR, 'invalid string pointer' ),
M   0	   3660 	( BAD_REQ, 'invalid string request' ),
M   0	   3661 	( BAD_SOURCE, 'invalid source string' ),
M   0	   3662 	( BAD_STRNG1, 'invalid primary string' ),
M   0	   3663 	( BAD_STRNG2, 'invalid secondary string' ),
M   0	   3664 	( BAD_TARGET, 'invalid target string' ),
M   0	   3665 	( CONFLICT, 'conflicting string function arguments' ),
M   0	   3666 	( NO_SPACE, 'insufficient space' ),
M   0	   3667 	( NO_STRING, 'no string specified' ),
M   0	   3668 	( NO_SUPPORT, 'requested function not supported' ),
M   0	   3669 	( NO_TEMP, 'temporary string not permitted' ),
M   0	   3670 	( NULL_STRNG, 'null string not permitted' ),
M   0	   3671 	( OUT_RANGE, 'integer value out of range' ),
M   0	   3672 	( TOO_LONG, 'string is too long' ) %,
    0	   3673 
    0	   3674 
    0	   3675     $XPO_FATAL_CODE =
M   0	   3676 	( BAD_IOB, 'invalid IOB' ),
M   0	   3677 	( BAD_LOGIC, 'XPORT logic error detected' ),
M   0	   3678 	( TERMINATE, 'program terminated due to program request' ) %,
    0	   3679 
    0	   3680 
    0	   3681     $STR_FATAL_CODE =
M   0	   3682 	( BAD_LOGIC, 'XPORT string logic error detected' ) %;
    0	   3683 
    0	   3684 
    0	   3685 LITERAL							! Define special XPORT string completion codes
    0	   3686     STR$_NORMAL = 1,
    0	   3687     STR$_FAILURE = 0;
    0	   3688 

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 79
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   3689     $XPO_COMP_CODES(					! Define all XPORT completion codes
P   0	   3690 	SUCCESS = ( $XPO_OK_CODE ),
P   0	   3691 	WARNING = ( $XPO_WARN_CODE ),
P   0	   3692 	ERROR = ( $XPO_ERROR_CODE ),
P   0	   3693 	FATAL = ( $XPO_FATAL_CODE ) )
		; %PRINT:		XPO$_NORMAL	= 2129921   (%X'208001')
		; %PRINT:		XPO$_CREATED	= 2129929   (%X'208009')
		; %PRINT:		XPO$_INCOMPLETE	= 2129937   (%X'208011')
		; %PRINT:		XPO$_NEW_FILE	= 2129945   (%X'208019')
		; %PRINT:		XPO$_NEW_PAGE	= 2129953   (%X'208021')
		; %PRINT:		XPO$_END_FILE	= 2134016   (%X'209000')
		; %PRINT:		XPO$_BAD_ADDR	= 2138114   (%X'20A002')
		; %PRINT:		XPO$_BAD_ALIGN	= 2138122   (%X'20A00A')
		; %PRINT:		XPO$_BAD_ARGS	= 2138130   (%X'20A012')
		; %PRINT:		XPO$_BAD_CONCAT	= 2138138   (%X'20A01A')
		; %PRINT:		XPO$_BAD_DELIM	= 2138146   (%X'20A022')
		; %PRINT:		XPO$_BAD_DESC	= 2138154   (%X'20A02A')
		; %PRINT:		XPO$_BAD_DEVICE	= 2138162   (%X'20A032')
		; %PRINT:		XPO$_BAD_DFLT	= 2138170   (%X'20A03A')
		; %PRINT:		XPO$_BAD_DIRECT	= 2138178   (%X'20A042')
		; %PRINT:		XPO$_BAD_DTYPE	= 2138186   (%X'20A04A')
		; %PRINT:		XPO$_BAD_FORMAT	= 2138194   (%X'20A052')
		; %PRINT:		XPO$_BAD_IO_OPT	= 2138202   (%X'20A05A')
		; %PRINT:		XPO$_BAD_LENGTH	= 2138210   (%X'20A062')
		; %PRINT:		XPO$_BAD_NAME	= 2138218   (%X'20A06A')
		; %PRINT:		XPO$_BAD_NEW	= 2138226   (%X'20A072')
		; %PRINT:		XPO$_BAD_NODE	= 2138234   (%X'20A07A')
		; %PRINT:		XPO$_BAD_ORG	= 2138242   (%X'20A082')
		; %PRINT:		XPO$_BAD_PROMPT	= 2138250   (%X'20A08A')
		; %PRINT:		XPO$_BAD_RECORD	= 2138258   (%X'20A092')
		; %PRINT:		XPO$_BAD_REQ	= 2138266   (%X'20A09A')
		; %PRINT:		XPO$_BAD_RLTD	= 2138274   (%X'20A0A2')
		; %PRINT:		XPO$_BAD_RSLT	= 2138282   (%X'20A0AA')
		; %PRINT:		XPO$_BAD_SPEC	= 2138290   (%X'20A0B2')
		; %PRINT:		XPO$_BAD_TYPE	= 2138298   (%X'20A0BA')
		; %PRINT:		XPO$_BAD_VER	= 2138306   (%X'20A0C2')
		; %PRINT:		XPO$_CHANNEL	= 2138314   (%X'20A0CA')
		; %PRINT:		XPO$_CLOSED	= 2138322   (%X'20A0D2')
		; %PRINT:		XPO$_CONFLICT	= 2138330   (%X'20A0DA')
		; %PRINT:		XPO$_CORRUPTED	= 2138338   (%X'20A0E2')
		; %PRINT:		XPO$_EXISTS	= 2138346   (%X'20A0EA')
		; %PRINT:		XPO$_FILE_LOCK	= 2138354   (%X'20A0F2')
		; %PRINT:		XPO$_FREE_MEM	= 2138362   (%X'20A0FA')
		; %PRINT:		XPO$_GET_MEM	= 2138370   (%X'20A102')
		; %PRINT:		XPO$_IN_USE	= 2138378   (%X'20A10A')
		; %PRINT:		XPO$_IO_BUFFER	= 2138386   (%X'20A112')
		; %PRINT:		XPO$_IO_ERROR	= 2138394   (%X'20A11A')
		; %PRINT:		XPO$_MISSING	= 2138402   (%X'20A122')
		; %PRINT:		XPO$_NETWORK	= 2138410   (%X'20A12A')
		; %PRINT:		XPO$_NO_ACCESS	= 2138418   (%X'20A132')
		; %PRINT:		XPO$_NO_BACKUP	= 2138426   (%X'20A13A')
		; %PRINT:		XPO$_NO_CHANNEL	= 2138434   (%X'20A142')
		; %PRINT:		XPO$_NO_CLOSE	= 2138442   (%X'20A14A')
		; %PRINT:		XPO$_NO_CONCAT	= 2138450   (%X'20A152')
		; %PRINT:		XPO$_NO_CREATE	= 2138458   (%X'20A15A')
		; %PRINT:		XPO$_NO_DELETE	= 2138466   (%X'20A162')
		; %PRINT:		XPO$_NO_DIRECT	= 2138474   (%X'20A16A')

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 80
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

		; %PRINT:		XPO$_NO_FILE	= 2138482   (%X'20A172')
		; %PRINT:		XPO$_NO_MEMORY	= 2138490   (%X'20A17A')
		; %PRINT:		XPO$_NO_OPEN	= 2138498   (%X'20A182')
		; %PRINT:		XPO$_NO_READ	= 2138506   (%X'20A18A')
		; %PRINT:		XPO$_NO_RENAME	= 2138514   (%X'20A192')
		; %PRINT:		XPO$_NO_SPACE	= 2138522   (%X'20A19A')
		; %PRINT:		XPO$_NO_SUBDIR	= 2138530   (%X'20A1A2')
		; %PRINT:		XPO$_NO_SUPPORT	= 2138538   (%X'20A1AA')
		; %PRINT:		XPO$_NO_WRITE	= 2138546   (%X'20A1B2')
		; %PRINT:		XPO$_NOT_CLOSED	= 2138554   (%X'20A1BA')
		; %PRINT:		XPO$_NOT_EXPIRE	= 2138562   (%X'20A1C2')
		; %PRINT:		XPO$_NOT_INPUT	= 2138570   (%X'20A1CA')
		; %PRINT:		XPO$_NOT_ONLINE	= 2138578   (%X'20A1D2')
		; %PRINT:		XPO$_NOT_OPEN	= 2138586   (%X'20A1DA')
		; %PRINT:		XPO$_NOT_OUTPUT	= 2138594   (%X'20A1E2')
		; %PRINT:		XPO$_OPEN	= 2138602   (%X'20A1EA')
		; %PRINT:		XPO$_PREV_ERROR	= 2138610   (%X'20A1F2')
		; %PRINT:		XPO$_PRIVILEGED	= 2138618   (%X'20A1FA')
		; %PRINT:		XPO$_PROTECTED	= 2138626   (%X'20A202')
		; %PRINT:		XPO$_PUT_MSG	= 2138634   (%X'20A20A')
		; %PRINT:		XPO$_REC_LOCK	= 2138642   (%X'20A212')
		; %PRINT:		XPO$_RENAME_NEW	= 2138650   (%X'20A21A')
		; %PRINT:		XPO$_RENAME_OLD	= 2138658   (%X'20A222')
		; %PRINT:		XPO$_TRUNCATED	= 2138666   (%X'20A22A')
		; %PRINT:		XPO$_WILDCARD	= 2138674   (%X'20A232')
		; %PRINT:		XPO$_BAD_ACCT	= 2138682   (%X'20A23A')
		; %PRINT:		XPO$_BAD_ATTR	= 2138690   (%X'20A242')
		; %PRINT:		XPO$_BAD_DATA	= 2138698   (%X'20A24A')
		; %PRINT:		XPO$_BAD_MEDIA	= 2138706   (%X'20A252')
		; %PRINT:		XPO$_BAD_MEMORY	= 2138714   (%X'20A25A')
		; %PRINT:		XPO$_BAD_PROT	= 2138722   (%X'20A262')
		; %PRINT:		XPO$_BAD_PTR	= 2138730   (%X'20A26A')
		; %PRINT:		XPO$_BAD_RECNUM	= 2138738   (%X'20A272')
		; %PRINT:		XPO$_BAD_SIZE	= 2138746   (%X'20A27A')
		; %PRINT:		XPO$_BAD_TEMP	= 2138754   (%X'20A282')
		; %PRINT:		XPO$_CHAN_USED	= 2138762   (%X'20A28A')
		; %PRINT:		XPO$_HOST_ERROR	= 2138770   (%X'20A292')
		; %PRINT:		XPO$_NO_NODE	= 2138778   (%X'20A29A')
		; %PRINT:		XPO$_NO_STACK	= 2138786   (%X'20A2A2')
		; %PRINT:		XPO$_SYS_ERROR	= 2138794   (%X'20A2AA')
		; %PRINT:		XPO$_BAD_CLASS	= 2138802   (%X'20A2B2')
		; %PRINT:		XPO$_NO_TEMP	= 2138810   (%X'20A2BA')
		; %PRINT:		XPO$_FOREGROUND	= 2138818   (%X'20A2C2')
		; %PRINT:		XPO$_NO_APPEND	= 2138826   (%X'20A2CA')
		; %PRINT:		XPO$_NO_SEQ	= 2138834   (%X'20A2D2')
		; %PRINT:		XPO$_BAD_ORDER	= 2138842   (%X'20A2DA')
		; %PRINT:		XPO$_BAD_SYNTAX	= 2138850   (%X'20A2E2')
		; %PRINT:		XPO$_BAD_IOB	= 2146308   (%X'20C004')
		; %PRINT:		XPO$_BAD_LOGIC	= 2146316   (%X'20C00C')
		; %PRINT:		XPO$_TERMINATE	= 2146324   (%X'20C014')
    0	   3694 
    0	   3695     $STR_COMP_CODES(					! Define all XPORT string completion codes
P   0	   3696 	SUCCESS = ( $STR_OK_CODE ),
P   0	   3697 	WARNING = ( $STR_WARN_CODE ),
P   0	   3698 	ERROR = ( $STR_ERROR_CODE ),
P   0	   3699 	FATAL = ( $STR_FATAL_CODE ) )
		; %PRINT:		STR$_END_STRING	= 2394113   (%X'248801')

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 81
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

		; %PRINT:		STR$_TRUNCATED	= 2394121   (%X'248809')
		; %PRINT:		STR$_NOT_TEMP	= 2394129   (%X'248811')
		; %PRINT:		STR$_BAD_CHAR	= 2402306   (%X'24A802')
		; %PRINT:		STR$_BAD_CLASS	= 2402314   (%X'24A80A')
		; %PRINT:		STR$_BAD_DESC	= 2402322   (%X'24A812')
		; %PRINT:		STR$_BAD_DTYPE	= 2402330   (%X'24A81A')
		; %PRINT:		STR$_BAD_LENGTH	= 2402338   (%X'24A822')
		; %PRINT:		STR$_BAD_MAXLEN	= 2402346   (%X'24A82A')
		; %PRINT:		STR$_BAD_PATTRN	= 2402354   (%X'24A832')
		; %PRINT:		STR$_BAD_PTR	= 2402362   (%X'24A83A')
		; %PRINT:		STR$_BAD_REQ	= 2402370   (%X'24A842')
		; %PRINT:		STR$_BAD_SOURCE	= 2402378   (%X'24A84A')
		; %PRINT:		STR$_BAD_STRNG1	= 2402386   (%X'24A852')
		; %PRINT:		STR$_BAD_STRNG2	= 2402394   (%X'24A85A')
		; %PRINT:		STR$_BAD_TARGET	= 2402402   (%X'24A862')
		; %PRINT:		STR$_CONFLICT	= 2402410   (%X'24A86A')
		; %PRINT:		STR$_NO_SPACE	= 2402418   (%X'24A872')
		; %PRINT:		STR$_NO_STRING	= 2402426   (%X'24A87A')
		; %PRINT:		STR$_NO_SUPPORT	= 2402434   (%X'24A882')
		; %PRINT:		STR$_NO_TEMP	= 2402442   (%X'24A88A')
		; %PRINT:		STR$_NULL_STRNG	= 2402450   (%X'24A892')
		; %PRINT:		STR$_OUT_RANGE	= 2402458   (%X'24A89A')
		; %PRINT:		STR$_TOO_LONG	= 2402466   (%X'24A8A2')
		; %PRINT:		STR$_BAD_LOGIC	= 2410500   (%X'24C804')
    0	   3700 
    0	   3701 
    0	   3702 $LITERAL						! XPORT action routine function codes:
    0	   3703     XPO$K_IO = $DISTINCT,				!    I/O
		; %PRINT:				  1
    0	   3704     XPO$K_PARSE = $DISTINCT,				!    PARSE_SPEC
		; %PRINT:				  2
    0	   3705     XPO$K_GET_MEM = $DISTINCT,				!    GET_MEMORY
		; %PRINT:				  3
    0	   3706     XPO$K_FREE_MEM = $DISTINCT,				!    FREE_MEMORY
		; %PRINT:				  4
    0	   3707     XPO$K_PUT_MSG = $DISTINCT;				!    PUT_MSG
		; %PRINT:				  5
    0	   3708 
    0	   3709 $LITERAL						! XPORT String Package action routine function codes:
    0	   3710     STR$K_COMPARE = $DISTINCT,				!    string comparison functions
		; %PRINT:				  1
    0	   3711     STR$K_COPY = $DISTINCT,				!    $STR_COPY
		; %PRINT:				  2
    0	   3712     STR$K_APPEND = $DISTINCT,				!    $STR_APPEND
		; %PRINT:				  3
    0	   3713     STR$K_SCAN = $DISTINCT,				!    $STR_SCAN
		; %PRINT:				  4
    0	   3714     STR$K_BINARY = $DISTINCT,				!    $STR_BINARY
		; %PRINT:				  5
    0	   3715     STR$K_PSEUDO = $DISTINCT;				!    $STR_ASCII, $STR_CONCAT, $STR_FORMAT  (no action routin
    0	   3715 e called)
		; %PRINT:				  6

                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 82
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

    0	   3717 !
    0	   3718 ! VAX/VMS-specific Definitions
    0	   3719 !
    0	   3720 
    0	   3721 %IF %BLISS(BLISS32) %THEN
    0	   3722 
    0	   3723 UNDECLARE %QUOTE $descriptor;				! Make believe $FIELD has not been used.
    0	   3724 %ASSIGN( $xpo$first_$field, 1 )
    0	   3725 
    0	   3726 MACRO
    0	   3727     CLI$_SYNTAX =
M   0	   3728 	SHR$_SYNTAX + 3^16 %,				! CLI-W-SYNTAX error message number
    0	   3729 
    0	   3730 
    0	   3731     $XPO_CALL_CLI( descriptor, work_area, extra_argument ) =
M   0	   3732 	BEGIN
M   0	   3733 	EXTERNAL ROUTINE SYS$CLI :  ADDRESSING_MODE( GENERAL );
M   0	   3734 	SYS$CLI( descriptor, work_area, extra_argument )
M   0	   3735 	END %,
    0	   3736 
    0	   3737 
    0	   3738     $XPO_KEY_TABLE( entry ) =
M   0	   3739 	VECTOR[ %LENGTH*2 + 1 ]
M   0	   3740 	INITIAL( %LENGTH*2
M   0	   3741 
M   0	   3742 	$XPO$KEY_TABLE( entry, %REMAINING )
M   0	   3743 
M   0	   3744 	) %,
    0	   3745 
    0	   3746 
    0	   3747     $XPO$KEY_TABLE( entry ) [] =
M   0	   3748 	$XPO$KEY_ENTRY( %REMOVE(entry) )
M   0	   3749 	$XPO$KEY_TABLE( %REMAINING ) %,
    0	   3750 
    0	   3751 
    0	   3752     $XPO$KEY_ENTRY( keyword, value ) =
M   0	   3753 	, UPLIT( %STRING( %CHAR(%CHARCOUNT(keyword)), keyword ) )
M   0	   3754 	    , value %;
    0	   3755 
    0	   3756 %FI
    0	   3757 
    0	   3758 	$SHOW( NONE )


                                Source Listing                   4-FEB-2004 11:01:32  BLISS-32I T1.1-053                Page 83
                                Source Listing                  19-MAR-2002 10:42:29  [LASTOVICA.XPORT.VMSGEN]XPORT.REQ;2

COMMAND LINE:

BLISSXPORT/LIBRARY/LIST
