HP 3000 Manuals HP 3000 Manuals
A Pascal ANYPARM Procedure Designed to Process Any Parameter
This section contains an example procedure that can process any of the
Business BASIC/XL data types. The procedure uses the file of definitions
shown in the previous section as an include file. The procedure is
followed by the HP Business BASIC/XL program that calls this procedure.
The section also contains a display that shows a logical representation
of memory during the ANYPARM call to the Pascal procedure.
$standard_level 'os_features', os 'MPE/XL'$
$partial_eval on, literal_alias on$
$tables on, code_offsets on$
$diagnostic 'mapinfo_on'$
$optimize 'level2'$
$subprogram$
program pascal_example( input, output );
$include 'anyparm.decls.basic'$
$title 'ANYPARM_EXAMPLE/ANYPARM external testing all valid BASIC types',page$
{----------------------------------------------------------------------------}
{ ANYPARM_EXAMPLE }
{ }
{ This procedure is written to accept a pointer to an actual parameter table }
{ as the formal parameter to the procedure. The actual parameter table }
{ contains addresses referencing any of the data types. The referenced }
{ values can be either scalars or arrays. The procedure will print the data }
{ type of the value and the value itself to a file named TESTFILE. TESTFILE }
{ must be created before calling this procedure. Testfile should be created }
{ as an ASCII file with a fixed record length of 80 bytes. }
{ }
{ ANYPARM_EXAMPLE contains the following second level procedures: }
{ }
{ write_header - writes a header for the call to the file. }
{ process_string_array - writes the value of individual elements of a }
{ string array to the file. }
{ process_array - writes the value of individual elements of }
{ numeric arrays to the file. }
{ process_scalar - writes the value of all scalar types to the }
{ file. }
{ }
{----------------------------------------------------------------------------}
procedure anyparm_example( num_params : integer
; p_actual_param_table : tp_actual_parameter_array
);
var
param_index : integer; { references entry in actual parameter table }
tstfil : text; { text file to which output is written }
$title 'EXTERNAL DECLARATIONS FOR THE FUNCTIONS TO CONVERT DECIMAL TYPES',page$
{----------------------------------------------------------------------------}
{ External declarations used to convert decimals to reals and short decimals }
{ to reals. It is the caller's responsibility to check the values of }
{ parameters passed to these procedures to ensure that no overflow occurs }
{ during the conversion. }
{----------------------------------------------------------------------------}
const
c_convert_short_decimal_to_real = 3;
c_convert_decimal_to_real = 1;
procedure bb_sdtor $alias 'bb_fp_decimal_convert'$(
conversion_type : integer; { c_convert_short_decimal_to_real }
var short_dec_param : t_short_decimal_type;
var longreal_param : longreal
); external;
procedure bb_dtor $alias 'bb_fp_decimal_convert'$(
conversion_type : integer; { c_convert_decimal_to_real }
var decimal_param : t_decimal_type;
var longreal_param : longreal
); external;
$title 'ANYPARM_EXAMPLE/Example of ANYPARM external testing all BASIC types'$
$page$
{----------------------------------------------------------------------------}
{ procedure write_header of anyparm_example }
{----------------------------------------------------------------------------}
procedure write_header(
num_parms : integer;
var tstfil : text
);
begin { procedure write_header}
writeln( tstfil, ' ' );
writeln( tstfil, 'enter the external anyparm_example' );
writeln( tstfil
, 'the total number of parameters passed to anyparm_example is: '
, num_params:2
);
writeln( tstfil, 'param type' );
writeln( tstfil, '----- -------------' )
end; { procedure write_header}
$title 'PROCESS_STRING_ARRAY of ANYPARM_EXAMPLE',page$
{----------------------------------------------------------------------------}
{ procedure process_string_array of anyparm_example }
{----------------------------------------------------------------------------}
procedure process_string_array(
p_actual_param_table : tp_actual_parameter_array;
param_index : integer;
var tstfil : text
);
const
c_2_spaces = ' ';
type
t_pascal_string = string[c_max_str_len];
tp_pascal_string = ^t_pascal_string;
var
array_element_num : integer; { element number in the array of strings }
word_view_index : integer; { index for the word view of p_array_data }
p_pascal_string : tp_pascal_string; { pointer to string in the array }
array_element_word_length : integer; { maximum length of the string }
begin { procedure process_string_array}
writeln( tstfil, 'STRING Array' );
with p_actual_param_table^[param_index].param_address^.p_array_data^,
{ word_view }
p_actual_param_table^[param_index].param_address^.array_descriptor do
{ total_elements }
begin { with}
{-------------------------------------------------------------------------}
{ The maximum length of each string in the array is identical and can be }
{ set to a constant for processing of the array. Since the information }
{ in word_view[0] is in units of bytes and an extra byte is always }
{ reserved at the end of the string, a simple calculation is performed }
{ to convert the 8 bit byte units to the 32 bit word units. }
{-------------------------------------------------------------------------}
array_element_word_length :=
( ( word_view[0] + c_bytes_per_32_bit_word ) div c_bytes_per_32_bit_word )
+ 1 { for maximum length field } + 1 { for actual length field };
{-------------------------------------------------------------------------}
{ The array of strings is stored as an array of 32 bit words. }
{ word_view_index is used to reference each of these words. }
{-------------------------------------------------------------------------}
word_view_index := 1;
for array_element_num := 0 to ( total_elements - 1 ) do
begin { processing individual strings }
{----------------------------------------------------------------------}
{ Move that part of the word_view array that contains the actual }
{ characters of the string into the temp_string. }
{----------------------------------------------------------------------}
$push, type_coercion 'conversion'$
p_pascal_string := addr( word_view[word_view_index] );
$pop$
writeln( tstfil
, c_2_spaces
, array_element_num:3
, c_2_spaces
, p_pascal_string^
);
{----------------------------------------------------------------------}
{ Increment to the index to the next element in the string array. }
{----------------------------------------------------------------------}
word_view_index := word_view_index + array_element_word_length;
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
, array_element_num:3
, c_2_spaces
);
{----------------------------------------------------------------}
{ Check to ensure that there will not be a numeric overflow when }
{ the decimal value is converted to a real. }
{----------------------------------------------------------------}
if
( decimal_array[array_element_num].decimal_rep.exponent > -308 ) and
( decimal_array[array_element_num].decimal_rep.exponent < 308 ) then
begin { decimal element }
bb_dtor( c_convert_decimal_to_real
, decimal_array[array_element_num]
, temp_real
);
writeln( tstfil, temp_real );
end { decimal element }
else
writeln( tstfil, 'Decimal value is too large to convert' )
end
end;
c_short_integer_type:
begin
writeln( tstfil, 'SHORT INTEGER Array' );
for array_element_num := 0 to ( total_elements - 1 ) do
writeln( tstfil
, c_2_spaces
, array_element_num:3
, c_2_spaces
, sinteger_array[array_element_num]:1
)
end;
c_integer_type:
begin
writeln( tstfil, 'INTEGER Array' );
for array_element_num := 0 to ( total_elements - 1 ) do
writeln( tstfil
, c_2_spaces
, array_element_num:3
, c_2_spaces
, integer_array[array_element_num]:1
)
end;
c_short_real_type:
begin
writeln( tstfil, 'SHORT REAL Array' );
for array_element_num := 0 to ( total_elements - 1 ) do
writeln( tstfil
, c_2_spaces
, array_element_num:3
, c_2_spaces
, short_array[array_element_num]
)
end;
c_real_type:
begin
writeln( tstfil, 'REAL Array' );
for array_element_num := 0 to ( total_elements - 1 ) do
writeln( tstfil
, c_2_spaces
, array_element_num:3
, c_2_spaces
, real_array[array_element_num]
)
end;
c_whole_string_type:
process_string_array( p_actual_param_table, param_index, tstfil );
otherwise
writeln( tstfil,'error in passed type')
end { case }
end { with }
end; { procedure process_array }
$title 'PROCESS_SCALAR of ANYPARM_EXAMPLE',page$
{----------------------------------------------------------------------------}
{ procedure process_scalar of anyparm_example }
{----------------------------------------------------------------------------}
procedure process_scalar(
p_actual_param_table : tp_actual_parameter_array;
param_index : integer;
var tstfil : text
);
var
temp_real : longreal; { used for conversion from dec and short dec }
temp_integer : integer;
begin { procedure process_scalar }
{----------------------------------------------------------------------------}
{ First de-reference the pointer for the associated fields specified. }
{----------------------------------------------------------------------------}
with p_actual_param_table^[param_index].param_address^.scalar_value do
{ short_decimal_value }
{ decimal_value }
{ sinteger_value }
{ integer_value }
{ short_value }
{ real_value }
{ string_value.pascal_string_view }
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 { short decimal value }
bb_sdtor( c_convert_short_decimal_to_real
, short_decimal_value
, temp_real
);
writeln( tstfil, 'SHORT DECIMAL ', temp_real );
end; { short decimal value }
c_decimal_type:
begin
{-------------------------------------------------------------------}
{ Check to ensure that there will not be a numeric overflow when }
{ the decimal value is converted to a real. }
{-------------------------------------------------------------------}
if ( decimal_value.decimal_rep.exponent > -308 ) and
( decimal_value.decimal_rep.exponent < 308 ) then
begin { decimal value }
bb_dtor( c_convert_decimal_to_real, decimal_value, temp_real );
writeln( tstfil, 'DECIMAL ', temp_real );
end { decimal value }
else
writeln( tstfil
, 'DECIMAL '
, 'Decimal value is too large to convert'
)
end;
c_short_integer_type:
begin { short integer }
temp_integer := sinteger_value;
writeln( tstfil, 'SHORT INTEGER ', temp_integer:1 );
end; { short integer }
c_integer_type:
writeln( tstfil, 'INTEGER ', integer_value:1 );
c_short_real_type:
writeln( tstfil, 'SHORT REAL ', short_value );
c_real_type:
writeln( tstfil, 'REAL ', real_value );
c_whole_string_type:
writeln( tstfil, 'STRING ', string_value.pascal_string_view );
otherwise
writeln( tstfil,'error in passed type');
end { case }
end { with }
end; { procedure process_scalar }
$title 'ANYPARM_EXAMPLE/Example of ANYPARM external testing all BASIC types'$
$page$
{----------------------------------------------------------------------------}
{ main of ANYPARM_EXAMPLE }
{----------------------------------------------------------------------------}
begin { anyparm_example }
{----------------------------------------------------------------------------}
{ TESTFILE is opened in append mode so that information written to the file }
{ by previous calls is not overwritten. }
{----------------------------------------------------------------------------}
append( tstfil, 'testfile' );
write_header( num_params, tstfil );
{----------------------------------------------------------------------------}
{ Check to ensure that the number of actual parameters passed can be }
{ processed by the external. }
{----------------------------------------------------------------------------}
if num_params > c_max_num_parameters then
begin { too many parameters to process }
writeln( tstfil, ' Too many actual parameters passed to ANYPARM_EXAMPLE' );
writeln( tstfil, ' Maximum number is: ', c_max_num_parameters:1 )
end { too many parameters to process }
else
begin { anyparm_example's actual parameter array is large enough }
{-------------------------------------------------------------------------}
{ Process each of the entries in the actual parameter table referenced by }
{ the formal parameter, p_actual_parameter_array. }
{-------------------------------------------------------------------------}
for param_index := 1 to num_params do
begin { for loop processing of the parameters }
{----------------------------------------------------------------------}
{ Write the number of the parameter, the value(s) of which are about }
{ to be written. }
{----------------------------------------------------------------------}
write( tstfil, param_index:3, ' ' );
{----------------------------------------------------------------------}
{ Do the appropriate processing dependent upon the dimensionality of }
{ the parameter in the actual parameter array currently being }
{ processed. }
{----------------------------------------------------------------------}
if p_actual_param_table^[param_index].number_of_dimensions > 0 then
process_array( p_actual_param_table, param_index, tstfil )
else
process_scalar( p_actual_param_table, param_index, tstfil )
end { for loop processing of the parameters }
end; { anyparm_example's actual parameter array is large enough }
writeln( tstfil, 'exiting anyparm_example' );
end; { anyparm_example }
begin
end.
The ANYPARM Call
Assume that the Pascal program presented in the previous section is in
the file, ANYPROG. To add the EXAMPLE procedure to the local executable
library named XL, do the following:
:pasxl anyprog
:linkeditor
linked>buildxl xl
linked>addxl from= $oldpass; to=xl
linked>exit
:
Consult the HPLink Editor/XL Reference Manual for more information.
Enter HP Business BASIC/XL and type the following program:
100 ! --- purge the file to which the &
external writes the information --
110 PURGE "TESTFILE";STATUS=Status
120 !
130 ! --------- create the file to which &
the external will write -------
140 CREATE ASCII "TESTFILE",RECSIZE=-80
150 !
160 ! ----------- declare and initialize variables -------------
170 REAL Real1
180 DIM Str8$[8]
190 DIM SHORT INTEGER Sint_array(1,1) &
! Assumes the OPTION BASE is zero
200 Real1=1.23E+45
210 Str8$="ANYPARM"
220 Sint_array(0,0)=1
230 Sint_array(0,1)=2
240 Sint_array(1,0)=3
250 Sint_array(1,1)=4
260 !
270 ! ---------------- call the external --------------------
280 _EXAMPLE Real1,Str8$,Sint_array(*,*)
290 !
300 ! ---------- print the contents of testfile -------------
310 COPYFILE "testfile"
320 END
Display of Memory during an ANYPARM Procedure Call
When the program is executed, the following is the layout of memory just
as execution of the external, EXAMPLE, is beginning:
![[]](../../pic3k/M010189/FORMAL3c50.gif)
Figure G-2. Memory Layout
The Results of Program Execution
The first call to the external from within the interpreter will require
substantially more time than subsequent calls. The reason is that the
external procedure must be dynamically loaded before it can be called.
Subsequent calls do not need to reload the external. The amount of time
required to do the initial load is dependent on the size of the external
being loaded. Externals called from compiled HP Business BASIC/XL
programs are loaded when program execution starts.
The following is the result of program execution in the interpreter.
>run
hello from the external example
the total number of parameters passed to example is: 3
param type
----- ------------
1 REAL 1.2300000000000L+45
2 STRING ANYPARM
3 SHORT INTEGER Array
0 1
1 2
2 3
3 4
exiting example
>