Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/language-sources/dixpd.bli
There are 21 other files named dixpd.bli in the archive. Click here to see a list.
%TITLE 'DIXPD -- Packed Decimal Conversion Module'
MODULE dixpd
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1985, 1986.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!++
! .chapter >DIXPD
!
! The module DIXPD contains the packed decimal conversion routines
! and data structures.
!
! FACILITY: Data Conversion Routines (DIX)
!
! ABSTRACT: Packed decimal conversion routines and related data
! structures.
!
! ENVIRONMENT:
!
! AUTHOR: Sandy Clemens, Creation Date: 17-Jan-84
!--
( !
IDENT = '2.1(53)' ! \.p;\
%REQUIRE ('DIXSWI.REQ') ! **EDIT**
%BLISS36 (
, ENTRY ( ! ; .P;Entry names:
dixpxx, dixxxp, dixpd ! \
)
)
) =
BEGIN
!++
! .hl 1 Require files
!--
REQUIRE 'DIXREQ.REQ';
%sbttl 'Edit History'
!++
! .hl 1 Edit History
!--
LIBRARY 'VERSION';
! ; .autotable
!++ COPY
new_version (2, 0)
Edit (%O'36', '11-Apr-84', 'Sandy Clemens')
%( Put all Version 2 DIX development files under edit control. Some of
the files listed below have major code edits, or are new modules. Others
have relatively minor changes, such as cleaning up a comment.
FILES: COMDIX.VAX-COM, COMPDX.CTL, DIXCST.BLI, DIXDEB.BLI,
DIXDN.BLI (NEW), DIXFBN.BLI, DIXFP.BLI, DIXGBL.BLI, DIXGEN.BLI,
DIXHST.BLI, DIXINT.PR1, DIXINT.PR2, DIXLIB.BLI, DIXPD.BLI (NEW),
DIXREQ.REQ, DIXSTR.BLI, DIXUTL.BLI, DXCM10.10-CTL, MAKDIXMSG.BLI,
STAR36.BLI, VERSION.REQ.
)%
Edit (%O'50', '8-Oct-84', 'Sandy Clemens')
%( Add new format of COPYRIGHT notice. FILES: ALL )%
new_version (2, 1)
Edit (%O'53', '3-Jul-86', 'Sandy Clemens')
%( Add remaining sources to V2.1 area. Update copyright notices. )%
! **EDIT**
!-- .autoparagraph
mark_versions ('DIX')
!++
! .hl 1 Debugging Declarations
!--
UNDECLARE %QUOTE $descriptor; !\.p;\Something leaves this around.
dix$module_debug (off)
!++
! .hl 1 External References
!--
EXTERNAL ! \.p;\DATA STRUCTURES:
!++ copy /strip
dix$adtt_pd : dtt_pd;
!--
!;.p
!; EXTERNAL ROUTINES:
EXTERNAL ROUTINE ! ;.list 0, "o"
dix$$fetch_bits, ! \.le;\
dix$$stuff_bits : NOVALUE, ! \.le;\
dix$$incr_des : NOVALUE, ! \.le;\
dix$$copy_structure : NOVALUE, ! \.le;\
dix$$check_ffd : NOVALUE, ! \.le;\
dix$$port_hand, ! \.le;\
dix$$adj_xi_scal; ! \.le;\
! ;.end list
!++
! .hl 1 Own storage
!--
!++
! .hl 2 Packed Decimal Sign Table
! .index Packed Decimal Sign Table
! The packed decimal sign table contains the valid sign values for the
! packed decimal data types. At the present time, the possible sign values
! are the same for each of the supported packed decimal data types.
! There is, therefore, one table for all data types. The information
! included in this table is the following:
!
!--
$field pds_fields =
SET ! ; .list 0, "o"
pds$v_digit = [$byte], ! ; .le;numeric value of packed decimal sign digit
pds$v_sign = [$bit] ! ; .le;associated sign value (0 or 1)
TES; ! ; .end list
LITERAL pds$k_size = $field_set_size;
!++
! .hl 3 Macros Used
! .list
! .index pds
! .le;PDS -- This is a macro to define the PDS (packed decimal sign
! table) structure.
!--
MACRO
pds (table_size) = BLOCKVECTOR [table_size, pds$k_size]
FIELD (pds_fields) %;
!++
! .index build_pds
! .le;BUILD_PDS -- This is a macro to help put together a given PDS table.
! There is one PDS structure for each set of sign representations (sign_set).
! The legal sign sets are:
! .list "o"
! .index DECSTD
! .le;DECSTD -- the standard sign representations used by DEC-10/20 COBOL
! and VAX COBOL.
! .end list
!--
MACRO build_pds (sign_set) =
OWN %NAME ('dix$apds_', sign_set) :
pds (%NAME ('pds$k_', sign_set, '_max'))
PSECT (readonly_psect)
PRESET (%NAME ('def_pds_', sign_set));
%;
!++
! .index def_pds_decstd
! .le;DEF_PDS_DECSTD -- This is a macro to define the entries for the
! DECSTD sign table. Note that the first two entries should be the
! preferred positive sign value and the preferred negative sign value.
! This is necessary since, when converting something to a PD value,
! the first positive or negative sign value encountered in the table
! will be the one used in the destination PD field. Note that the
! table is of size pds$k_<sign_set`>_max, which is must be previously
! defined in module DIXLIB.
! .index pds$k_<sign_set`>_max
! .end list
!--
!++
! .hl 3 Packed Decimal Sign Table Entries
! .hl 4 DECSTD Sign Set
! The following are the entries in the packed decimal sign table for
! DECSTD sign set.
!--
MACRO def_pds_decstd = ! ; .s1 .list 0, "o"
[0, pds$v_digit] = 12, ! ; .le;Decimal 12 is the preferred positive sign value
[0, pds$v_sign] = 0,
[1, pds$v_digit] = 13, ! ; .le;Decimal 13 is the preferred negative sign value
[1, pds$v_sign] = 1,
[2, pds$v_digit] = 10, ! ; .le;Decimal 10 is a positive sign
[2, pds$v_sign] = 0,
[3, pds$v_digit] = 11, ! ; .le;Decimal 11 is a negative sign
[3, pds$v_sign] = 1,
[4, pds$v_digit] = 14, ! ; .le;Decimal 14 is a positive sign
[4, pds$v_sign] = 0,
[5, pds$v_digit] = 15, ! ; .le;Decimal 15 is a positive sign
[5, pds$v_sign] = 0 ! ; .end list
% ;
! PDS's
! ; .hl 3 Expand sign tables
! ; Expand the sign tables for each sign set:
! ; .s1 .list 0, " "
build_pds ('decstd') ! \.le;\ -- generate dix$apds_decstd
! ; .end list
%SBTTL 'ROUTINE dix$$con_pd_xi'
GLOBAL ROUTINE dix$$con_pd_xi ! \.!=;.hl 1\
! ; .index dix$$con_pd_xi
!++
! SCH: Level = 2, DD = 2. Pseudonym >dixpxx>.
!
! Algorithm: Initialize the XI mantissa to zero. Copy the PD scale
! into the XI form.
!
! Taking into account that each source PD byte contains two PD digits,
! scan the PD source, left to right, one byte at a time. Use a
! temporary copy of the source FFD as a byte pointer. While considering
! each byte, first fetch the high order nibble and then the low order
! nibble. Store each PD digit in the XI mantissa.
!
! The PD sign is always in the low order nibble of the last byte of the
! PD field. Note that the PD field may have a high order unused byte.
! If the field contains an odd number of digits then the sign is in the
! last nibble of the last byte, packed in with the last (least significant)
! digit. If the field contains an even number of bytes then the high order
! byte is unused and the sign is, again, in the last nibble of the last byte
! packed in with the least significant digit.
!
! Store the sign in the XI form.
!
! Routine value: None.
!
! Formal Arguements:
!--
( ! ; .s 1.list 1
src_ffd, ! \.le;\: Address of FFD for PD field
xi_field ! \.le;\: Address of XI intermediate field (field is written to)
) : NOVALUE = ! ;.end list
BEGIN ! dix$$con_pd_xi
MAP xi_field : REF xi,
src_ffd : REF forgn_descr;
dix$routine_debug (off)
LOCAL
src_pnt : forgn_descr, ! temp copy of FFD to use as a byt pntr
xi_digt_ndx,
src_digt,
nibble_offset;
ROUTINE dix$$proc_digt ! \.!=;.hl 2\
! ; .index dix$$proc_digt
!++
! SCH: Level = 3, DD = 3.
!
! Algorithm: If the digit is a valid PD digit (in the range 0
! through 9 decimal) then return the XI digit. Otherwise signal
! dix$_invpddgt (invalid source packed decimal digit).
!
! Routine value: .pd_digt (the value of the digit to be stored in
! the XI form).
!
! Formal arguements:
!--
( ! ; .s 1 .list 1
pd_digt ! \.le;\: the packed decimal digit
) = ! ;.end list
BEGIN
IF .pd_digt LSS 0
OR .pd_digt GTR 9 ! see if digit is invalid
THEN
SIGNAL (dix$_invpddgt);
.pd_digt ! if the digit is valid return it
! to be stored in the XI form
END; ! end local routine dix$$proc_digt
ROUTINE dix$$proc_sgn ! \.!=;.hl 2\
! ; .index dix$$proc_sgn
!++
! SCH: Level = 3, DD = 3.
!
! Algorithm: Select the packed decimal sign table to use. Look
! up the sign digit in the packed decimal sign table. If the
! sign digit does not exist in the PD sign table, signal an
! error, otherwise return the XI sign value.
!
! At the present time, there is one sign table (dix$apdt) since
! the valid sign representations are exactly the same for all
! supported PD data types. The sign table contains an entry for
! each valid PD sign and it's associated XI representation.
!
! Routine value: xi_sign (the value of the sign to be stored in
! the XI form).
!
! Formal Arguements:
!--
( ! ; .s 1 .list 1
pd_sgn, ! \.le;\: the packed decimal sign
src_pnt ! \.le;\: copy of the source ffd
) = ! ;.end list
BEGIN
LOCAL
src_pds, ! address of src PDS
pds_max_index, ! max index of src PDS
indx, ! an index
sign_found : INITIAL (0), ! if ON, indicates that the sign
! char has been found in the PDS
xi_sign : INITIAL (0); ! XI sign value to retun
MAP src_pnt : REF forgn_descr,
src_pds : REF pds (0); ! size is irrelevant
! get proper PD sign table to use for the given data type
SELECTONE .dix$adtt_pd [.src_pnt [ffd$v_dt_type], pdd$v_sign_set] OF
SET
[ss_decstd] : BEGIN
src_pds = dix$apds_decstd;
pds_max_index = pds$k_decstd_max - 1
END;
[OTHERWISE] : SIGNAL (dix$_impossible);
TES;
! search the PD sign table for the packed decimal sign
INCR indx FROM 0 TO .pds_max_index DO
IF .src_pds [.indx, pds$v_digit] EQL .pd_sgn
THEN BEGIN
xi_sign = .src_pds [.indx, pds$v_sign];
sign_found = 1;
EXITLOOP ! digit found so stop searching for it
END;
IF .sign_found NEQ 1 THEN SIGNAL (dix$_invpdsgn);
.xi_sign ! return XI sign value
END; ! end of local routine dix$$proc_sgn
! begin body of dix$$con_pd_xi
dix$$copy_structure (.src_ffd, ffd$k_size, src_pnt); ! make a modifiable copy of the src_ffd
xi_field [xi$v_sign] = 0; ! init the sign to positive
xi_field [xi$v_scale] = .src_ffd [ffd$v_scale]; ! copy the PD scale to XI form
! Initialize hign-order XI mantissa digits to zero.
DECR xi_digt_ndx FROM xi$k_digits TO .src_ffd [ffd$v_length] DO
xi_field [xi$v_digit, .xi_digt_ndx] = 0;
! Set the initial value of the XI digit index to the number of digits
! which should be stored in the XI field. This value is equal to the
! length of the source field minus 1. The XI digits are indexed from
! 0 to xi$k_digits, (rather than from 1 to xi$k_digits) so it is
! necessary to subtract 1 to reflect this.
xi_digt_ndx = .src_ffd [ffd$v_length] - 1;
!++
! Note some assumptions about packed decimal data storage:
! .list 0
! .le;There are always two nibbles in a byte.
! .le;All nibbles are of the same size (pdd$v_nbl_siz stored in dix$adtt_pd).
! .le;All nibbles are right justified within the byte with any unused bits
! collected at the left (high order) end of the byte.
! .end list
! All of this means that to look at the high order nibble of a byte, simply
! use the nibble size (pdd$v_nbl_siz stored in dix$adtt_pd) as the bit offset
! within the desired byte. To look at the low order nibble, the bit offset
! within a byte would be zero.
!--
! It may be necessary to skip the first (high order) nibble, since it may
! be unused. If field length is an even number then the high order nibble
! must be skipped, if the field length is odd, don't need to skip any nibbles.
IF .src_pnt [ffd$v_length] ! If length is "true" then the length is an odd number
THEN ! so set nibble offset to high order
nibble_offset = .dix$adtt_pd [.src_pnt [ffd$v_dt_type], ! nibble (offset equals the nibble size).
pdd$v_nbl_siz] ! If length is even, skip 1st nibble &
ELSE nibble_offset = 0; ! set nibble offset to zero for low order nibble.
DO BEGIN ! scan the source PD field and insert digits into the XI form
src_digt = dix$$fetch_bits(.src_pnt [ffd$v_unit], ! fetch desired nibble from specified byte
.src_pnt [ffd$v_offset] + .nibble_offset,
.dix$adtt_pd [.src_pnt [ffd$v_dt_type],
pdd$v_nbl_siz]
);
xi_field [xi$v_digit, .xi_digt_ndx] =
dix$$proc_digt(.src_digt); ! insert processed digit into the XI
xi_digt_ndx = .xi_digt_ndx - 1; ! decr XI digit index each time a digit is stored
SELECTONE .nibble_offset OF
SET
[0] : BEGIN
nibble_offset = .dix$adtt_pd [.src_pnt [ffd$v_dt_type],
pdd$v_nbl_siz]; ! set nibble offset to high order nibble
dix$$incr_des(src_pnt); ! increment pointer to next whole byte
END;
[.dix$adtt_pd [.src_pnt [ffd$v_dt_type], pdd$v_nbl_siz]] :
nibble_offset = 0; ! set nibble offset to low order nibble
! & don't increment byte pointer since
! we aren't done with this byte yet
TES;
END
UNTIL .xi_digt_ndx LSS 0;
!++
! While scanning the packed decimal field, the src_pnt (the byte
! pointer) has been incremented so that it is now pointing to the last
! byte of the field. Packed decimal signs are always stored in the
! low order nibble of the last (low order) byte. To get the sign,
! simply fetch the low order nibble of the present byte.
!--
! nibble_offset will always be zero here, since we want the low
! order nibble, therefore, don't need to add .nibble_offset to
! .src_pnt [ffd$v_offset] when fetching the sign...
src_digt = dix$$fetch_bits (.src_pnt [ffd$v_unit], ! fetch sign
.src_pnt [ffd$v_offset],
.dix$adtt_pd [.src_pnt [ffd$v_dt_type],
pdd$v_nbl_siz]
);
xi_field [xi$v_sign] = dix$$proc_sgn(.src_digt, src_pnt); ! store sign in XI form
END; ! end of global routine dix$$con_pd_xi
%SBTTL 'ROUTINE dix$$con_xi_pd'
GLOBAL ROUTINE dix$$con_xi_pd ! \.!=;.hl 1\
! ; .index dix$$con_xi_pd
!++
! Convert fixed intermediate (XI) field to packed decimal field.
!
! SCH: Level = 2, DD = 2. Pseudonym >dixxxp>.
!
! Algorithm: Adjust the XI mantissa so the XI form has the same scale
! as the destination field.
! Make sure the destination field is large enough to hold the XI
! significant digits.
! Using a temporary (modifiable) copy of the destination FFD as a byte
! pointer to the PD field, scan the XI field from left to right. Insert
! each XI digit into the corresponding PD nibble.
! Store the sign value in the PD field.
!
! Routine value: Status value
!
! Formal Arguements:
!--
( ! ; .s 1 .list 1
xi_field, ! \.le;\: address of XI field.
dst_ffd ! \.le;\: address of PD field (field written to).
) = ! ; .end list
BEGIN ! routine dix$$con_xi_pd
MAP xi_field : REF xi,
dst_ffd : REF forgn_descr;
dix$routine_debug (off)
LOCAL
status_pd, ! status value
xi_digt_ndx, ! index into XI digits
dst_pnt : forgn_descr, ! destination field byte pointer
nibble_offset, ! bit offset to high or low order nibble
xi_sign, ! temporary place to put XI sign
dst_sign; ! destination sign character
ROUTINE dix$$proc_sgn ! \.!=;.hl 2\
! ; .index dix$$proc_sgn
!++
! SCH: Level = 3, DD = 3.
!
! Algorithm: Find the preferred packed decimal sign
! representation from the packed decimal sign table. The first
! (smallest indexed) positive or negative sign value encountered
! in the PD sign table will automatically be the preferred
! representation.
!
! Routine value: Packed decimal sign value returned
!
! Formal Arguements:
!--
( ! ; .s 1 .list 1
xi_sign, ! \.le;\: the XI sign
dst_pnt ! \.le;\: copy of the destination ffd
) = ! ;.end list
BEGIN
LOCAL dst_pds,
pds_max_index,
indx,
sign_found : INITIAL (0),
pd_sign;
MAP dst_pnt : REF forgn_descr,
dst_pds : REF pds (0); ! size irrelevant
SELECTONE .dix$adtt_pd [.dst_pnt [ffd$v_dt_type], pdd$v_sign_set] OF
SET
[ss_decstd] : BEGIN
dst_pds = dix$apds_decstd;
pds_max_index = pds$k_decstd_max - 1;
END;
[OTHERWISE] : SIGNAL (dix$_impossible);
TES;
! Search dst PDS for sign character associated with given
! XI sign. Stop as soon as the sign is found.
INCR indx FROM 0 to .pds_max_index DO
IF .dst_pds [.indx, pds$v_sign] EQL .xi_sign ! sign is found
THEN BEGIN
pd_sign = .dst_pds [.indx, pds$v_digit];
sign_found = 1; ! indicate sign found
EXITLOOP ! & don't waste any time
END;
IF .sign_found NEQ 1 THEN SIGNAL (dix$_impossible); ! Sign should occur in PDS!
.pd_sign ! return value of PD sign
END; ! end of local routine dix$$proc_sgn
! begin body of dix$$con_xi_pd
dix$$copy_structure(.dst_ffd, ffd$k_size, dst_pnt); ! make tmp (modifiable) copy of dest
! ffd to be used as a byte pointer
status_pd = dix$$adj_xi_scal(.dst_pnt [ffd$v_scale], ! adjust XI field to match the dest scale
.xi_field); ! may return DIX$_ROUNDED or signal DIX$_TOOBIG
! Make sure the destination field is large enough to hold the significant
! XI digits:
INCR xi_digt_ndx FROM .dst_pnt [ffd$v_length] TO xi$k_digits DO
IF .xi_field [xi$v_digit, .xi_digt_ndx] NEQ 0 ! if non-zero digits occur in high ord positions
THEN ! then the source is too big for the dest
SIGNAL (dix$_toobig);
! Since the XI field is indexed from 0, not from 1, set the xi_digt_ndx to be
! the field length minus one:
xi_digt_ndx = .dst_pnt [ffd$v_length] - 1;
IF .dst_pnt [ffd$v_length] ! if length is "true"
THEN nibble_offset = .dix$adtt_pd [.dst_pnt [ffd$v_dt_type], ! start with
pdd$v_nbl_siz] ! high order nibble
ELSE BEGIN
nibble_offset = .dix$adtt_pd [.dst_pnt [ffd$v_dt_type], ! else put a zero
pdd$v_nbl_siz]; ! in high order unused
dix$$stuff_bits (.dst_pnt [ffd$v_unit], ! nibble as filler
.dst_pnt [ffd$v_offset] + .nibble_offset,
.dix$adtt_pd [.dst_pnt [ffd$v_dt_type],
pdd$v_nbl_siz],
0);
nibble_offset = 0; ! set nibble offset to get
! next low order nibble
END;
DO BEGIN ! Scan XI fld & put PD digits into dst
! Since the XI digits are simply packed decimal digits, store them directly
! in the destination field without conversion. No checking is made to see
! that the XI digits are valid, since the digits are checked when they are
! put INTO the XI digit form. Should a check for validity of XI digits be
! made here???
dix$$stuff_bits (.dst_pnt [ffd$v_unit], ! Stuff XI src digits into the dest
.dst_pnt [ffd$v_offset] + .nibble_offset, ! PD field, one nibble at a time
.dix$adtt_pd [.dst_pnt [ffd$v_dt_type],
pdd$v_nbl_siz],
.xi_field [xi$v_digit, .xi_digt_ndx]
) ;
xi_digt_ndx = .xi_digt_ndx - 1;
SELECTONE .nibble_offset OF ! set nibble offset & incr byte pntr if necessary
SET
[0] : BEGIN
nibble_offset = .dix$adtt_pd [.dst_pnt [ffd$v_dt_type], pdd$v_nbl_siz];
dix$$incr_des(dst_pnt);
END;
[.dix$adtt_pd [.dst_pnt [ffd$v_dt_type], pdd$v_nbl_siz]] :
nibble_offset = 0;
TES;
END
UNTIL .xi_digt_ndx LSS 0; ! end of scan XI digits loop
! Consider sign.
xi_sign = .xi_field [xi$v_sign]; ! get the XI sign value
dst_sign = dix$$proc_sgn(.xi_sign, dst_pnt); ! get the dest PD sign
! Store the destination packed decimal sign. Note: the nibble offset,
! when storing the sign, is always zero, so there is no need to add
! the nibble offset to the field offset as was done above.
dix$$stuff_bits (.dst_pnt [ffd$v_unit],
.dst_pnt [ffd$v_offset],
.dix$adtt_pd [.dst_pnt [ffd$v_dt_type], pdd$v_nbl_siz],
.dst_sign);
IF .xi_digt_ndx NEQ -1 ! we should use up all the XI digits
THEN SIGNAL (dix$_impossible);
.status_pd ! return status value
END; ! end of global routine dix$$con_xi_pd
%SBTTL 'GLOBAL ROUTINE dix$$con_pd'
GLOBAL ROUTINE dix$$con_pd ! \.!=;.hl 1\
! ; .index dix$$con_pd
!++
! Portal for Packed Decimal conversions.
!
! SCH: Level = 1, DD = 1. Pseudonym >dixpd>.
!
! Algorithm: Convert packed decimal field to XI (fixed intermediate)
! form. Convert the XI intermediate digits to the destination packed
! decimal type. Scaling is correctly handled.
!
! Routine value: Status Value, one of the following:
! .list 1, "o"
! .le;dix$_impossible
! .le;dix$_rounded
! .le;dix$_toobig
! .le;dix$_invpddgt
! .le;dix$_invpdsgn
! .end list
! Formal arguements:
!--
( ! ; .s 1 .list 1
src_ffd, ! \.le;\: Address of source FFD
dst_ffd ! \.le;\: Address of destination FFD
) = ! ; .end list
BEGIN ! Begin dix$$con_pd
MAP
src_ffd : REF forgn_descr,
dst_ffd : REF forgn_descr;
dix$routine_debug (off)
LOCAL
error_tmp : VOLATILE,
xi_field : xi;
ENABLE dix$$port_hand (error_tmp); ! \Establish condition handler: \
dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);
dix$$con_pd_xi (.src_ffd, xi_field); ! convert src PD field to xi form,
! signals if error
dtype (on, 'XI field before scale adjustment: ');
debug_code (xidmp (xi_field); ! debugging code
tty_put_crlf ());
dix$$con_xi_pd (xi_field, .dst_ffd) ! convert xi form to dst PD field,
! signals if error and may return warning
END; ! end global routine dix$$con_pd
END
ELUDOM