HP Business BASIC/XL Reference Manual - HP 3000 MPE/iX Computer Systems - Edition 1 (32715-90001)

G-: 26
end { processing individual strings }
end { with }
end; { procedure process_string_array }
$title 'PROCESS_ARRAY of ANYPARM_EXAMPLE',page$
{----------------------------------------------------------------------------}
{ procedure process_array of anyparm_example }
{----------------------------------------------------------------------------}
procedure process_array(
p_actual_param_table : tp_actual_parameter_array;
param_index : integer;
var tstfil : text
);
const
c_2_spaces = ' ';
var
array_element_num : integer; { element number in the array of }
{ appropriate type }
temp_real : longreal; { used for conversion from }
{ decimal and short dec }
begin
{----------------------------------------------------------------------------}
{ First de-reference the two pointers for the fields specified: }
{----------------------------------------------------------------------------}
with p_actual_param_table^[param_index].param_address^.p_array_data^,
{ short_decimal_array }
{ decimal_array }
{ sinteger_array }
{ integer_array }
{ short_array }
{ real_array }
p_actual_param_table^[param_index].param_address^.array_descriptor do
{ total_elements }
begin { with }
{-------------------------------------------------------------------------}
{ Process the actual parameter by selecting the processing appropriate }
{ for that type. }
{-------------------------------------------------------------------------}
case p_actual_param_table^[param_index].param_type of
c_short_decimal_type:
begin
writeln( tstfil, 'SHORT DECIMAL Array' );
for array_element_num := 0 to ( total_elements - 1 ) do
begin { short decimal element }
bb_sdtor( c_convert_short_decimal_to_real
, short_decimal_array[array_element_num]
, temp_real
);
writeln( tstfil
, c_2_spaces
, array_element_num:3
, c_2_spaces
, temp_real
);
end; { short decimal element }
end;
c_decimal_type:
begin
writeln( tstfil, 'DECIMAL Array' );
for array_element_num := 0 to ( total_elements - 1 ) do
begin
write( tstfil
, c_2_spaces