Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/lngsrc/dixdn.bli
There are 21 other files named dixdn.bli in the archive. Click here to see a list.
%TITLE 'DIXDN -- Display Numeric Conversion Module'
MODULE dixdn
! 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 >DIXDN
!
! The module DIXDN contains the display numeric conversion routines
! and data structures.
!
! FACILITY: Data Conversion Routines (DIX)
!
! ABSTRACT: Display numeric conversion routines and related data
! structures.
!
! ENVIRONMENT:
!
! AUTHOR: Sandy Clemens, Creation Date: 26-Aug-83
!--
(
IDENT = '2.1(53)' ! \.p;\
%REQUIRE ('DIXSWI.REQ')
%BLISS36 (
, ENTRY ( ! ; .p;Entry names:
dixdxx, dixxxd, dixdn ! \
)
)
) =
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 (xport?) leaves this around...
dix$module_debug (off) !\.p;\Set debug flag for the module.
!++
! .hl 1 External References
!--
EXTERNAL ! \.p;\DATA STRUCTURES:
!++ copy /strip
dix$adtt_dn : dtt_dn; ! DNUM data type information table
!--
!;.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 Display Numeric character sets
! The following are the valid display numeric character sets:
! .list 0,"o"
! .le;ASCII -- standard ASCII display numeric characters
! .le;ASCIIX -- extended ASCII, valid only for type DN8TO
! .le;EBCDIC -- standard EBCDIC display numeric characters
! .le;SIXBIT -- standard SIXBIT display numeric characters
! .end list
!
!--
!++
! .hl 1 Display Numeric Character Representations -- Terminology
! .index display numeric character representations
! .index display numeric terminology
!
! The following terminology is used in this document to describe
! display numeric data. There are four types of display numeric
! characters described:
! .list
! .le;Separate sign characters
! .index separate sign -- display numeric character
! Separate sign characters are simply the "+" and "-" representations
! for the given character set. Separate signs are valid only in the
! sign position!
! .le;Simple digits
! .index simple digit -- display numeric character
! A simple digit character is one which is not overpunched and which
! represents an integer in the range 0 to 9. If a simple digit
! character occurs in a sign position it implys a positive sign. If a
! simple digit occurs anywhere else, it does not imply anything about
! the sign of the field. Simple digits are always one of the
! following: 0, 1, 2, 3, 4, 5, 6, 7, 8, 9. Character set encodings
! for simple digit representations always fall in numerical sequence
! starting with the zero digit, so it is easy to calculate the
! representation of any simple digit give the zero simple digit value.
! .le;Overpunched characters
! .index Overpunched character -- display numeric character
! An overpunched character always represents a sign and is, therefore,
! valid only in the sign position. An overpunched character can represent
! either a positive or negative sign. However, in destination fields
! a positive overpunched sign will always be represented by a simple
! digit, rather than an overpunched character.
! .le;Blank character
! .index blank character -- display numeric character
! Blank characters may be used as high order "filler" characters. A
! blank character in the sign position, which should only occur in a
! data type which has a leading overpunched sign, is the same as
! having a zero simple digit in the sign position. It indicates a
! positive sign with a zero digit. Blank characters will only occur
! in source display numeric data. When converting anything to display
! numeric the destination will always be filled with zeros -- never with
! blanks.
! .end list
!--
!++
! .hl 1 Own storage
!--
!++
! .hl 2 Auxiliary Information Table
! .index Auxiliary Information Table -- Display Numeric
! There is a single auxiliary information table. It contains the "+"
! and "-" (the separate sign characters), " " (the blank character)
! and "0" (the zero simple digit) for each display numeric character
! set.
! The auxiliary information table is indexed by character set code.
! Literals for characters set codes are defined in DIXLIB. All simple
! digits values can be easily calculated using the zero simple digit.
! Therefore, the zero simple digit value is the only simple digit
! information stored in the auxiliary information table.
!--
$field dnaux_fields =
SET
dnaux$v_zero = [$byte],
dnaux$v_pos = [$byte],
dnaux$v_neg = [$byte],
dnaux$v_space = [$byte]
TES;
LITERAL dnaux$k_size = $field_set_size;
MACRO
dnaux_entries =
[cs_ascii, dnaux$v_zero] = 48, ! the ascii "0" char
[cs_ascii, dnaux$v_pos] = 43, ! the ascii "+" char
[cs_ascii, dnaux$v_neg] = 45, ! the ascii "-" char
[cs_ascii, dnaux$v_space] = 32, ! the ascii space char
[cs_asciix, dnaux$v_zero] = 48, ! the asciix "0" char
[cs_asciix, dnaux$v_pos] = 43, ! the asciix "+" char
[cs_asciix, dnaux$v_neg] = 45, ! the asciix "-" char
[cs_asciix, dnaux$v_space] = 32, ! the asciix space char
[cs_ebcdic, dnaux$v_zero] = %X'F0', ! the ebcdic "0" char
[cs_ebcdic, dnaux$v_pos] = 78, ! the ebcdic "+" char
[cs_ebcdic, dnaux$v_neg] = 96, ! the ebcdic "-" char
[cs_ebcdic, dnaux$v_space] = 64, ! the ebcdic space char
[cs_sixbit, dnaux$v_zero] = 16, ! the sixbit "0" char
[cs_sixbit, dnaux$v_pos] = 11, ! the sixbit "+" char
[cs_sixbit, dnaux$v_neg] = 13, ! the sixbit "-" char
[cs_sixbit, dnaux$v_space] = 0 ! the sixbit space char
% ;
! auxiliary information table
OWN ! ;.s 1
dix$adnaux : ! \>\The auxiliary information table.
BLOCKVECTOR [cs_max, dnaux$k_size]
FIELD (dnaux_fields)
PSECT (readonly_psect)
PRESET (dnaux_entries) ;
!++
! .hl 2 Overpunched Character Tables (OVP's)
! .index OVP
! The overpunched character tables (OVP's) contain all the possible
! overpunched characters for each display numeric character
! set. There is one overpunched character table for each of the
! display numeric character sets.
! The information included in each index entry of an OVP is: display
! numeric character, associated (unsigned) xi_digit value and
! associated sign.
! Whenever anything is converted to display numeric the first OVP
! entry encountered with the correct corresponding xi_digit and sign
! representations will indicate the display numeric character to use.
! Therefore, if more than one representation occurs for a given
! sign/xi_digit combination, the first (smallest indexed) will be the
! default destination representation.
! Note that when converting ANYTHING to display numeric, a
! positive-signed overpunched character will never result. The simple
! digit with an implied sign will always be used instead.
!--
! ; BLISS definition of OVP form:
! ; .literal
!++ copy
$field ovp_fields =
SET
ovp$v_dn_char = [$byte], ! display numeric character code
ovp$v_xi_digit = [$byte], ! numeric value of associated integer
! to be stored in the XI form
ovp$v_sign = [$bit] ! associated sign value (0 or 1)
TES;
LITERAL ovp$k_size = $field_set_size;
!-- .end literal
! overpunched character table
!++
! .hl 3 Specific Macros Used
!--
!++
! OVP(TABLE_SIZE): This is a macro to define an OVP of specified
! size. TABLE_SIZE should be one of the display numeric character set
! size literals defined in DIXLIB and named
! OVP$K_<char_set_name`>_MAX.
!--
MACRO
ovp (table_size) = BLOCKVECTOR [table_size, ovp$k_size]
FIELD (ovp_fields) %;
!++
! DEF_OVP_CHAR(INDX, DNCHR, XIDGT, SGN): This macro is used to
! generate PRESET entries for the DNCHR, XIDGT and SGN information at
! the specified INDX in the OVP.
!--
MACRO def_ovp_char (indx, dnchr, xidgt, sgn) =
[indx, ovp$v_dn_char] = dnchr,
[indx, ovp$v_xi_digit] = xidgt,
[indx, ovp$v_sign] = sgn
%;
!++
! DEF_OVP_<CHAR_SET_NAME`>: These macros are used to define the
! specified display numeric overpunched character set table (OVP).
! Each DEF_OVP_<char_set_name`> macro consists of successive calls to
! the def_ovp_char macro, one for each overpunched character for this
! character set.
!--
! ; .s1.list 0, "o"
! NOTE: the value OVP$K_ASCII_MAX is defined in DIXLIB. When editing this
! table keep in mind that OVP$K_ASCII_MAX should be equal to the number of
! entries in this table.
MACRO def_ovp_ascii = ! \.le;\define ASCII DN character set
def_ovp_char(0, 93, 0, 1), ! "]" is negative 0
def_ovp_char(1, 74, 1, 1), ! "J" is negative 1
def_ovp_char(2, 75, 2, 1), ! "K" is negative 2
def_ovp_char(3, 76, 3, 1), ! "L" is negative 3
def_ovp_char(4, 77, 4, 1), ! "M" is negative 4
def_ovp_char(5, 78, 5, 1), ! "N" is negative 5
def_ovp_char(6, 79, 6, 1), ! "O" is negative 6
def_ovp_char(7, 80, 7, 1), ! "P" is negative 7
def_ovp_char(8, 81, 8, 1), ! "Q" is negative 8
def_ovp_char(9, 82, 9, 1) ! "R" is negative 9
% ;
! NOTE: the value OVP$K_EBCDIC_MAX is defined in DIXLIB. When editing this
! table keep in mind that OVP$K_EBCDIC_MAX should be equal to the number of
! entries in this table.
MACRO def_ovp_ebcdic = ! \.le;\define EBCDIC DN character set
def_ovp_char(0, 189, 0, 1), ! "]" is negative 0
def_ovp_char(1, 209, 1, 1), ! "J" is negative 1
def_ovp_char(2, 210, 2, 1), ! "K" is negative 2
def_ovp_char(3, 211, 3, 1), ! "L" is negative 3
def_ovp_char(4, 212, 4, 1), ! "M" is negative 4
def_ovp_char(5, 213, 5, 1), ! "N" is negative 5
def_ovp_char(6, 214, 6, 1), ! "O" is negative 6
def_ovp_char(7, 215, 7, 1), ! "P" is negative 7
def_ovp_char(8, 216, 8, 1), ! "Q" is negative 8
def_ovp_char(9, 217, 9, 1) ! "R" is negative 9
% ;
! NOTE: the value OVP$K_SIXBIT_MAX is defined in DIXLIB. When editing this
! table keep in mind that OVP$K_SIXBIT_MAX should be equal to the number of
! entries in this table.
MACRO def_ovp_sixbit = ! \.le;\define SIXBIT DN character set
def_ovp_char(0, 61, 0, 1), ! "]" is negative 0
def_ovp_char(1, 42, 1, 1), ! "J" is negative 1
def_ovp_char(2, 43, 2, 1), ! "K" is negative 2
def_ovp_char(3, 44, 3, 1), ! "L" is negative 3
def_ovp_char(4, 45, 4, 1), ! "M" is negative 4
def_ovp_char(5, 46, 5, 1), ! "N" is negative 5
def_ovp_char(6, 47, 6, 1), ! "O" is negative 6
def_ovp_char(7, 48, 7, 1), ! "P" is negative 7
def_ovp_char(8, 49, 8, 1), ! "Q" is negative 8
def_ovp_char(9, 50, 9, 1) ! "R" is negative 9
% ;
! NOTE: the value OVP$K_ASCIIX_MAX is defined in DIXLIB. When editing this
! table keep in mind that OVP$K_ASCIIX_MAX should be equal to the number of
! entries in this table.
MACRO def_ovp_asciix = ! \.le;\define DN ASCII extended char set
def_ovp_char(0, 93, 0, 1), ! "]" is negative 0
def_ovp_char(1, 74, 1, 1), ! "J" is negative 1
def_ovp_char(2, 75, 2, 1), ! "K" is negative 2
def_ovp_char(3, 76, 3, 1), ! "L" is negative 3
def_ovp_char(4, 77, 4, 1), ! "M" is negative 4
def_ovp_char(5, 78, 5, 1), ! "N" is negative 5
def_ovp_char(6, 79, 6, 1), ! "O" is negative 6
def_ovp_char(7, 80, 7, 1), ! "P" is negative 7
def_ovp_char(8, 81, 8, 1), ! "Q" is negative 8
def_ovp_char(9, 82, 9, 1), ! "R" is negative 9
def_ovp_char(10, 91, 0, 0), ! "[" is positive 0
def_ovp_char(11, 123, 0, 0), ! "{" is positive 0
def_ovp_char(12, 63, 0, 0), ! "?" is positive 0
def_ovp_char(13, 65, 1, 0), ! "A" is positive 1
def_ovp_char(14, 66, 2, 0), ! "B" is positive 2
def_ovp_char(15, 67, 3, 0), ! "C" is positive 3
def_ovp_char(16, 68, 4, 0), ! "D" is positive 4
def_ovp_char(17, 69, 5, 0), ! "E" is positive 5
def_ovp_char(18, 70, 6, 0), ! "F" is positive 6
def_ovp_char(19, 71, 7, 0), ! "G" is positive 7
def_ovp_char(20, 72, 8, 0), ! "H" is positive 8
def_ovp_char(21, 73, 9, 0), ! "I" is positive 9
def_ovp_char(22, 125, 0, 1), ! "}" is negative 0
def_ovp_char(23, 58, 0, 1), ! ":" is negative 0
def_ovp_char(24, 33, 0, 1), ! "!" is negative 0
def_ovp_char(25, 112, 0, 1), ! "p" is negative 0
def_ovp_char(26, 113, 1, 1), ! "q" is negative 1
def_ovp_char(27, 114, 2, 1), ! "r" is negative 2
def_ovp_char(28, 115, 3, 1), ! "s" is negative 3
def_ovp_char(29, 116, 4, 1), ! "t" is negative 4
def_ovp_char(30, 117, 5, 1), ! "u" is negative 5
def_ovp_char(31, 118, 6, 1), ! "v" is negative 6
def_ovp_char(32, 119, 7, 1), ! "w" is negative 7
def_ovp_char(33, 120, 8, 1), ! "x" is negative 8
def_ovp_char(34, 121, 9, 1) ! "y" is negative 9
% ; ! ; .end list
!++
! BUILD_OVP(CHAR_SET_NAME): This macro, when called with a valid
! character set name and a proper prior definition of
! OVP$K_char_set_name_MAX and DEF_OVP_<char_set_name`> will define
! DIX$ADNOVP_<char_set_name`>, the overpunched character table for
! the character set specified.
!--
MACRO build_ovp (char_set_name) =
OWN %NAME ('dix$adnovp_', char_set_name) :
ovp (%NAME ('ovp$k_', char_set_name, '_max'))
PSECT (readonly_psect)
PRESET (%NAME ('def_ovp_', char_set_name));
%;
! OVP's
! ; Expand the overpunched character tables for each character set:
! ; .s1.list 0, "o"
build_ovp ('ascii') ! \.le;\ -- generate dix$adnovp_ascii
build_ovp ('asciix') ! \.le;\ -- generate dix$adnovp_asciix
build_ovp ('ebcdic') ! \.le;\ -- generate dix$adnovp_ebcdic
build_ovp ('sixbit') ! \.le;\ -- generate dix$adnovp_sixbit
! ; .end list
! The overpunched_char structure is used locally to facilitate passing
! overpunched character information between routines.
$field overpunched_fields =
SET
overpunched_all = [$long_integer],
$OVERLAY (overpunched_all)
overpunched_sign = [$bytes (2)], ! the sign associated w/ an overpunched char
overpunched_digit = [$bytes (2)] ! the digit associated w/ an overpunched char
$CONTINUE
TES;
LITERAL overpunched_size = $field_set_size;
MACRO overpunched_char = BLOCK [overpunched_size]
FIELD (overpunched_fields) %;
%SBTTL 'ROUTINE dix$$con_dn_xi'
GLOBAL ROUTINE dix$$con_dn_xi ! \.!=;.hl 1\
! ; .index dix$$con_dn_xi
!++
! SCH: Level = 2, DD = 2. Pseudonym >dixdxx>.
!
! Convert a display numeric field to the fixed intermediate (XI) form.
!
! Algorithm: Taking the data type into account, calculate the
! number of high-order XI digits to fill with zeros and then do so.
!
! Process the field as dictated by the data type. Process the simple
! digit characters and store them in the XI form. Convert blanks to
! zeros and be sure that only leading blanks are accepted as legal.
! If the data type is signed, process the sign as indicated by the data
! type. The sign is either the first (leading) or last (trailing) character
! in the field and is either separate or overpunched.
!
! Routine value: None.
!
! Formal Arguements:
!--
( ! ; .s 1.list 1
src_ffd, ! \.le;\: Address of FFD for DN field
xi_field ! \.le;\: Address of XI field (modified)
) : NOVALUE = ! ; .end list
BEGIN ! global routine dix$$con_dn_xi
MAP xi_field : REF xi,
src_ffd : REF forgn_descr;
dix$routine_debug (off)
LOCAL
src_pnt : forgn_descr, ! modifiable copy of the src_ffd to be
! used as a byte pointer
digit_flag : INITIAL (0), ! if ON, indicates that digits have
! been encountered & blanks are no
! longer legal characters
xi_digit_ndx; ! index into XI digits
ROUTINE dix$$proc_digit ! \.!=;.hl 1\
! ; .index dix$$proc_digit
!++
! Fetch the DN digit character and make sure it is a valid
! simple digit or a blank, if blanks are legal. If it is, return
! the appropriate numeric digit to store in the XI form. If not,
! signal that an invalid character has been encountered.
!
! Routine value: the digit to store in the XI form.
!
! Formal arguements:
!--
(
src_pnt, ! The byte pointer to the src DN field
digit_flag ! Address of digit_flag. If digit_flag
! is ON, it indicates that digits were
! encountered & blanks are not legal.
) =
BEGIN ! LOCAL ROUTINE dix$$proc_digit
LOCAL
src_char, ! the source digit char fetched
xi_digit; ! the xi digit value to be returned
MAP src_pnt : REF forgn_descr;
! Fetch the digit character (of the specified size) pointed
! at by the source byte pointer.
src_char = dix$$fetch_bits (.src_pnt [ffd$v_unit],
.src_pnt [ffd$v_offset],
.dix$adtt_dn [.src_pnt [ffd$v_dt_type],
dnd$v_byt_siz]
);
SELECTONE .src_char OF
SET
[.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_char_set],
dnaux$v_space]] :
! if char is a blank space
IF ..digit_flag ! if digit_flag is set, blanks are
! not legal so signal error
THEN
SIGNAL (dix$_invdnumchr)
ELSE ! else return 0 because leading blanks
! are equivalent to zeros
xi_digit = 0;
[.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_char_set],
dnaux$v_zero]
TO
.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_char_set],
dnaux$v_zero] + 9] :
BEGIN ! case char is a simple digit
! calculate the numeric value of the simple digit by
! subtracting the zero digit character from it
xi_digit = .src_char -
.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_zero];
! set the digit flag to indicate that, since a simple digit has
! been found, blanks are no longer legal characters
.digit_flag = 1;
END; ! case char is a simple digit
[OTHERWISE] :
SIGNAL (dix$_invdnumchr); ! otherwise, this is not a
! legal char, so signal error
TES;
.xi_digit ! return the digit value to
! be stored in the XI form
END; ! end of local routine dix$$proc_digit
ROUTINE dix$$proc_sep_sign ! \.!=;.hl 1\
! ; .index dix$$proc_sep_sign
!++
! Fetch the character from the source field. If the character
! is a valid separate sign for the character set, return the XI
! sign value to be stored in the XI form. If the character is
! not a legal separate sign, signal an error.
!
! Routine value: value of xi sign to be stored in xi form
!
! Formal Arguements:
!--
(
src_pnt ! the byte pointer for the src DN field
) =
BEGIN ! local routine dix$$proc_sep_sign
LOCAL
src_sign, ! the DN sign char extracted from the DN src
xi_sign; ! the XI sign value to be returned
MAP src_pnt : REF forgn_descr;
! Fetch the sign character (of the specified size) pointed
! at by the source byte pointer.
src_sign = dix$$fetch_bits (.src_pnt [ffd$v_unit],
.src_pnt [ffd$v_offset],
.dix$adtt_dn [.src_pnt [ffd$v_dt_type],
dnd$v_byt_siz]
);
xi_sign = (
SELECTONE .src_sign OF
SET
[.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_pos]] :
! if char is valid pos sep sign, return XI pos sign value
0;
[.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_neg]] :
! if char is valid neg sep sign, return XI neg sign value
1;
[OTHERWISE] : ! if it's not a valid sign then signal error
SIGNAL
(dix$_invdnumsgn);
TES
);
.xi_sign ! return the sign value to be
! stored in the XI form
END; ! end of local routine dix$$proc_sep_sign
ROUTINE dix$$proc_ovp_char ! \.!=;.hl 1\
! ; .index dix$$proc_ovp_char
!++
! Fetch the source sign character from the source field. If
! the character is a simple digit, then the sign is positive and
! the digit value is figured by subtracting the zero digit
! character value from the character. If the character is not a
! simple digit, then, depending on the character set, select the
! OVP to use. Search the OVP for the source DN char. If the
! character is a valid overpunched character, set the sign and
! digit values be returned, otherwise signal an error.
!
! Routine value: None. (The overpunched_char structure passed is
! modified -- the correct XI sign and XI digit value associated with
! the source DN overpunched character are inserted in it.)
!
! Formal arguements:
!--
( ! ; .s 1 .list 1
src_pnt, ! \.le;\:the byte pointer to the source field
ovpchr ! \.le;\:addr of the overpunched_char structure to use
) : NOVALUE = ! ; .end list
BEGIN ! local routine dix$$proc_ovp_char
LOCAL
src_sign, ! source char extracted from src field
indx, ! an index
chr_found : INITIAL (0), ! if ON, this indicates that the
! char was found in the OVP table
src_ovp; ! the source OVP to use
MAP src_pnt : REF forgn_descr,
ovpchr : REF overpunched_char,
src_ovp : REF ovp(0); ! The OVP size is irrelevant. BLISS
! doesn't care about the actual size
! of the structure, only the field
! names used to reference the data.
! Fetch the overpunched character indicated by the source byte pointer
src_sign = dix$$fetch_bits (.src_pnt [ffd$v_unit],
.src_pnt [ffd$v_offset],
.dix$adtt_dn [.src_pnt [ffd$v_dt_type],
dnd$v_byt_siz]
);
SELECTONE .src_sign OF
SET
[.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_char_set],
dnaux$v_zero]
TO
.dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_char_set],
dnaux$v_zero] + 9 ] :
BEGIN ! case sign is a simple digit
! If the overpunched character is a simple digit, then the sign is
! ALWAYS positive. In this case the digit to return is simply the
! source simple digit value MINUS the zero digit value.
ovpchr [overpunched_sign] = 0;
ovpchr [overpunched_digit] =
.src_sign - .dix$adnaux [.dix$adtt_dn [.src_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_zero];
END; ! case sign is a simple digit
[OTHERWISE] :
BEGIN ! case sign isn't a simple digit
! Select the OVP to use, depending on the character
! set of the data type.
SELECTONE .dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_char_set] OF
SET
[cs_ascii] : src_ovp = dix$adnovp_ascii;
[cs_asciix] : src_ovp = dix$adnovp_asciix;
[cs_ebcdic] : src_ovp = dix$adnovp_ebcdic;
[cs_sixbit] : src_ovp = dix$adnovp_sixbit;
[OTHERWISE] : ! if character set is
! not legal - signal error
SIGNAL (dix$_impossible);
TES;
! Search the OVP for the src_char and if it's found, store the sign
! and digit value in the overpunched_char form.
INCR indx FROM 0 TO .dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_ovp_max_index] - 1 DO
IF .src_ovp [.indx, ovp$v_dn_char] EQL .src_sign
THEN
BEGIN ! correct entry found
! save correct OVP digit and sign information in the
! overpunched_char form:
ovpchr [overpunched_sign] = .src_ovp [.indx, ovp$v_sign];
ovpchr [overpunched_digit] = .src_ovp [.indx, ovp$v_xi_digit];
chr_found = 1; ! indicate char was found in the OVP
EXITLOOP ! don't waste time once char is found
END; ! correct entry found
IF .chr_found NEQ 1 ! if the char wasn't in the OVP
! then it is an invalid overpunched
THEN ! sign so signal an error
SIGNAL (dix$_invdnumsgn);
END; ! case sign isn't a simple digit
TES;
END; ! end of local routine dix$$proc_ovp_char
! begin body of dix$$con_dn_xi routine
dix$$copy_structure (.src_ffd, ffd$k_size, src_pnt); ! make copy of the src_ffd to use
! as a byte pntr (it will be modified)
xi_field [xi$v_sign] = 0; ! initialize the sign to positive
xi_field [xi$v_scale] = .src_ffd [ffd$v_scale]; ! Copy the DN field scale
! factor to the XI field
! Set the initial value of xi_digit_ndx 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 one if the sign is separate, since the length specified in the
! FFD includes any separate sign character. The XI digits are indexed from
! 0 to xi$k_digits, so we need to ALWAYS subtract 1 to account for that.
xi_digit_ndx =
(
SELECTONE .dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_sign_type] OF
SET
[dnd$k_lead_sep, dnd$k_trail_sep] : .src_pnt[ffd$v_length] - 2;
[OTHERWISE] : .src_pnt[ffd$v_length] - 1;
TES
);
DECR ndx FROM xi$k_digits TO .xi_digit_ndx + 1 DO ! Initialize high-order
xi_field [xi$v_digit, .ndx] = 0; ! XI digits to zero
! Depending on the sign type of the data type, scan the source from
! the left (highest order character) to the right (lowest order
! character). Process the sign, as indicated by the sign type.
SELECTONE .dix$adtt_dn [.src_pnt [ffd$v_dt_type], dnd$v_sign_type] OF
SET
[dnd$k_lead_sep] : ! if sign is leading & separate
BEGIN
! Process the leading separate DN sign and store the XI sign.
xi_field [xi$v_sign] = dix$$proc_sep_sign (src_pnt);
dix$$incr_des (src_pnt); ! increment pointer to next character
! Scan the rest of the source (left to right) and process the digits.
! The only characters left in the source now should be simple digits
! (and possibly leading blanks).
DO BEGIN ! scan source field loop
! Process each character and store the XI digit in the XI field.
xi_field [xi$v_digit, .xi_digit_ndx] = dix$$proc_digit (src_pnt,
digit_flag);
xi_digit_ndx = .xi_digit_ndx - 1; ! decrement the XI digit index
dix$$incr_des (src_pnt); ! incr byte pointer
END ! end scan source field loop
UNTIL .xi_digit_ndx EQL - 1; ! stop when all digits
! have been processed
END; ! case sign leading & separate
[dnd$k_lead_over] : ! if sign is leading & overpunched
BEGIN
LOCAL ovpchr : overpunched_char; ! the overpunched char information
! to be stored in the XI form after
! extraction from the DN field
! First, process the leading overpunched sign.
dix$$proc_ovp_char (src_pnt, ovpchr); ! ovpchr is modified
! Store the sign and digit information returned from processing
! the overpunched character.
xi_field [xi$v_digit, .xi_digit_ndx] = .ovpchr [overpunched_digit];
xi_field [xi$v_sign] = .ovpchr [overpunched_sign];
xi_digit_ndx = .xi_digit_ndx - 1; ! decrement XI digit index
dix$$incr_des (src_pnt); ! increment byte pointer
! Scan the rest of the source (left to right) and process the digits.
! The only characters left in the source now should be simple digits
! (and possibly leading blanks).
WHILE .xi_digit_ndx GTR -1 DO ! stop when all digits
! have been processed
BEGIN ! scan source field loop
! Process each character and store the XI digit in the XI field.
xi_field [xi$v_digit, .xi_digit_ndx] = dix$$proc_digit (src_pnt,
digit_flag);
xi_digit_ndx = .xi_digit_ndx - 1; ! decrement the XI digit index
dix$$incr_des (src_pnt); ! incr byte pointer
END; ! end scan source field loop
END; ! case sign leading & overpunched
[dnd$k_trail_sep] : ! if sign is trailing & separate
BEGIN
! Scan the source (left to right) and process the digits. All the
! characters except the last one should be simple digits (or possibly
! leading blanks). The last character should be the sign.
DO BEGIN ! scan source field loop
! Process each character and store the XI digit in the XI field.
xi_field [xi$v_digit, .xi_digit_ndx] = dix$$proc_digit (src_pnt,
digit_flag);
xi_digit_ndx = .xi_digit_ndx - 1; ! decrement the XI digit index
dix$$incr_des (src_pnt); ! incr byte pointer
END ! end scan source field loop
UNTIL .xi_digit_ndx EQL - 1; ! stop when all digits
! have been processed
! Process the trailing separate DN sign and store the XI sign.
xi_field [xi$v_sign] = dix$$proc_sep_sign (src_pnt);
END; ! case sign trailing & separate
[dnd$k_trail_over] : ! if sign is trailing & overpunched
BEGIN
LOCAL ovpchr : overpunched_char; ! the overpunched char information
! to be stored in the XI form after
! extraction from the DN field
! Scan the source (left to right) and process the digits. All the
! characters except the last one should be simple digits (or possibly
! leading blanks). The last character should be the sign.
WHILE .xi_digit_ndx GTR 0 DO ! stop when all digits
! have been processed
BEGIN ! scan source field loop
! Process each character and store the XI digit in the XI field.
xi_field [xi$v_digit, .xi_digit_ndx] = dix$$proc_digit (src_pnt,
digit_flag);
xi_digit_ndx = .xi_digit_ndx - 1; ! decrement the XI digit index
dix$$incr_des (src_pnt); ! incr byte pointer
END; ! end scan source field loop
! Process the trailing overpunched sign.
dix$$proc_ovp_char (src_pnt, ovpchr); ! ovpchr is modified
! Store the sign and digit information returned from processing
! the overpunched character.
xi_field [xi$v_digit, .xi_digit_ndx] = .ovpchr [overpunched_digit];
xi_field [xi$v_sign] = .ovpchr [overpunched_sign];
END; ! case sign trailing & overpunched
[dnd$k_unsigned] : ! if data type is unsigned
BEGIN
! Scan the source (left to right) and process the digits. The
! only characters in the source should be simple digits (and
! possibly leading blanks).
DO BEGIN ! scan source field loop
! Process each character and store the XI digit in the XI field.
xi_field [xi$v_digit, .xi_digit_ndx] = dix$$proc_digit (src_pnt,
digit_flag);
xi_digit_ndx = .xi_digit_ndx - 1; ! decrement the XI digit index
dix$$incr_des (src_pnt); ! incr byte pointer
END ! end scan source field loop
UNTIL .xi_digit_ndx EQL - 1; ! stop when all digits
! have been processed
xi_field [xi$v_sign] = 0; ! sign is unsigned, so set to
! zero in the XI form
END; ! case type is unsigned
[OTHERWISE] :
SIGNAL (dix$_impossible); ! If the sign type is not one
! of the legal cases, signal an
! impossible error.
TES;
END; ! end global routine dix$$con_dn_xi
%SBTTL 'ROUTINE dix$$con_xi_dn'
GLOBAL ROUTINE dix$$con_xi_dn ! \.!=;.hl 1\
! ; .index dix$$con_xi_dn
!++
! Convert fixed intermediate (XI) field to dixplay numeric field.
!
! SCH: Level = 2, DD = 2. Pseudonym >dixxxd>.
!
! Algorithm: Keeping the decimal point aligned, adjust the scale
! factor of the XI field. Calculate the number of digits which will
! be extracted from the XI, keeping the data type in mind. Verify
! that the destination field is large enough to hold the source field.
! Copy the scale factor of the source field to the XI field.
!
! Process the field as dictated by the data type. Process the XI
! digits and store them in the destination DN field. If the data type
! is signed, the sign is either the first (leading) or last (trailing)
! character in the field and is either separate or overpunched.
! Process the sign as indicated by the sign type of the data type.
!
! Routine value: Status value
!
! Formal Arugements:
!--
( ! ; .s 1 .list 1
xi_field, ! \.le;\: addres of XI field.
dst_ffd ! \.le;\: addres of DN field (field is written to).
) =
BEGIN ! global routine dix$$con_xi_dn
MAP xi_field : REF xi,
dst_ffd : REF forgn_descr;
dix$routine_debug (off)
LOCAL
status_dn, ! status value
dst_pnt : forgn_descr, ! modifiable copy of the destination
! ffd to be used as a byte pointer
xi_digit_ndx, ! index into XI digits
ndx; ! an index
ROUTINE dix$$mak_digit ! \.!=;.hl 2 \
! ; .index dix$$mak_digit
!++
! If the XI digit passed is valid, then find the display
! numeric destination simple digit value by adding the zero
! simple digit character to the XI digit value. Insert the
! destination character into the destination field.
!
! SCH: Level = 3, DD = 2
!
! Routine value: None. Destination field is, however, modified.
!
! Formal arguements:
!--
( ! ; .s 1 .list 1
xi_digit, ! \.le;\: the XI digit
dst_pnt ! \.le;\: the destination byte pointer
) : NOVALUE = ! ; .end list
BEGIN ! local routine dix$$mak_digit
MAP dst_pnt : REF forgn_descr;
LOCAL dst_char; ! the dest DN character
IF (.xi_digit LSS 0) OR (.xi_digit GTR 9)
THEN ! the digits stored in the XI form
! should never be invalid since they
SIGNAL (dix$_impossible); ! are checked when they are entered
! into it...
! the destination digit value is found by adding the zero digit
! character to the XI digit value
dst_char = .xi_digit + .dix$adnaux [.dix$adtt_dn [.dst_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_zero];
! store the dst character value in the destination field
dix$$stuff_bits (.dst_pnt [ffd$v_unit],
.dst_pnt [ffd$v_offset],
.dix$adtt_dn [.dst_pnt [ffd$v_dt_type], dnd$v_byt_siz],
.dst_char
);
END; ! end of local routine dix$$mak_digit
ROUTINE dix$$mak_sep_sign ! \.!=;.hl 2\
! ; .index dix$$mak_sep_sign
!++
! Use the auxiliary information table and the XI sign passed
! to determine the value of the DN separate sign. Store the
! sign character in the destination field.
!
! SCH: Level = 3, DD = 2
!
! Routine value: None. (The destination field is modified).
!
! Formal Arguements:
!--
( ! ; .s 1 .list 1
xi_sign, ! \.le;\: the XI sign value
dst_pnt ! \.le;\: the destination byte pointer
) : NOVALUE = ! ; .end list
BEGIN ! local routine dix$$mak_sep_sign
MAP dst_pnt : REF forgn_descr;
LOCAL dst_sign; ! the dest separate sign character
dst_sign =
(
SELECTONE .xi_sign OF
SET
[0] : .dix$adnaux [.dix$adtt_dn [.dst_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_pos];
[1] : .dix$adnaux [.dix$adtt_dn [.dst_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_neg];
[OTHERWISE] :
SIGNAL (dix$_impossible);
TES
);
! store the destination separate sign in the dest field
dix$$stuff_bits (.dst_pnt [ffd$v_unit],
.dst_pnt [ffd$v_offset],
.dix$adtt_dn [.dst_pnt [ffd$v_dt_type], dnd$v_byt_siz],
.dst_sign
);
END; ! end of local routine dix$$mak_sep_sign
ROUTINE dix$$mak_ovp_sgn ! \.!=;.hl 2 \
! ; .index dix$$mak_ovp_sgn
!++
! Use the XI sign and XI digit passed to make the display
! numeric sign character. If the XI sign is negative, use the XI
! digit to search the overpunched character table (OVP) for the
! correct DN character. If the sign is positive, add the zero
! char (from the auxiliary information table) to the XI digit to
! make the correct DN simple digit sign character. Store the
! sign character in the destination field.
!
! SCH: Level = 3
!
! Routine value: None. (The destination field is modified).
!
! Formal Arguements:
!--
( ! ; .s 1 .list 1
xi_digit, ! \.le;\: the XI digit
xi_sign, ! \.le;\: the XI sign
dst_pnt ! \.le;\: the dest byte pointer
) : NOVALUE = ! ; .end list
BEGIN ! local routine dix$$mak_ovp_sgn
LOCAL
dst_sign, ! the dest overpunched char to stuff
! into the destination field
indx, ! an index
char_found : INITIAL (0), ! set if the character is found
dst_ovp; ! the address of the dest OVP
MAP dst_pnt : REF forgn_descr,
dst_ovp : REF ovp(0);
! If XI sign is positive (0) when making a DN sign, then just
! return a simple digit, not an overpunched character.
IF .xi_sign EQL 0 ! XI sign is positive
THEN BEGIN ! to return the simple digit, just add
! the zero digit char to the xi digit
dst_sign = .xi_digit +
.dix$adnaux [.dix$adtt_dn [.dst_pnt [ffd$v_dt_type],
dnd$v_char_set],
dnaux$v_zero];
char_found = 1; ! indicate the char is found
END ! end XI sign is positive case
ELSE BEGIN ! XI sign is negative
dst_ovp =
(
SELECTONE .dix$adtt_dn [.dst_pnt [ffd$v_dt_type], dnd$v_char_set] OF
SET
[cs_ascii] : dix$adnovp_ascii;
[cs_asciix] : dix$adnovp_asciix;
[cs_ebcdic] : dix$adnovp_ebcdic;
[cs_sixbit] : dix$adnovp_sixbit;
[OTHERWISE] :
SIGNAL (dix$_impossible);
TES
);
! search the OVP selected for the desired negative sign value
INCR indx FROM 0 TO .dix$adtt_dn [.dst_pnt [ffd$v_dt_type],
dnd$v_ovp_max_index] - 1
DO
! if the digits are equal, be sure the signs are the same
IF .dst_ovp [.indx, ovp$v_xi_digit] EQL .xi_digit
THEN
IF .dst_ovp [.indx, ovp$v_sign] EQL .xi_sign
THEN
BEGIN ! correct OVP entry found
! set the dn sign value
dst_sign = .dst_ovp [.indx, ovp$v_dn_char];
char_found = 1; ! indicate char is found
EXITLOOP ! don't waste any time looking
END; ! correct OVP entry found
END; ! end case XI sign is negative
! If char_found isn't ON, then correct char wasn't found in the OVP,
! which isn't possible unless the internal tables got trashed:
IF .char_found NEQ 1
THEN
SIGNAL (dix$_impossible);
! store the dst sign character in the destination field
dix$$stuff_bits (.dst_pnt [ffd$v_unit],
.dst_pnt [ffd$v_offset],
.dix$adtt_dn [.dst_pnt [ffd$v_dt_type],
dnd$v_byt_siz],
.dst_sign
);
END; ! end of local routine dix$$mak_ovp_sign
! begin body of dix$$con_xi_dn routine
dix$$copy_structure(.dst_ffd, ffd$k_size, dst_pnt); ! make modifiable copy of dst
! ffd to use as a byte pointer
! Before doing anything else, make sure that we aren't trying to put
! a negative number into an unsigned field. If sign is negative and
! sign type is unsigned, then signal an error.
IF (.xi_field [xi$v_sign]
AND (.dix$adtt_dn [.dst_pnt [ffd$v_dt_type], dnd$v_sign_type] EQL dnd$k_unsigned))
THEN
SIGNAL (dix$_unsigned); ! signal error
! Adjust XI field to match the dest DN scale factor
status_dn = dix$$adj_xi_scal (.dst_pnt [ffd$v_scale],
.xi_field);
! Set xi_digit_ndx to the index of the first digit which will be
! extracted from the XI form. Account for a separate sign if one is
! indicated. Note that the xi_field digits are indexed starting at 0,
! so decrease xi_digit_ndx by 1 always.
xi_digit_ndx =
(
SELECTONE .dix$adtt_dn [.dst_pnt [ffd$v_dt_type], dnd$v_sign_type] OF
SET
[dnd$k_lead_sep, dnd$k_trail_sep] : .dst_pnt [ffd$v_length] - 2;
[OTHERWISE] : .dst_pnt [ffd$v_length] - 1;
TES
);
! make sure the dest fld is large enough to hold significant src digits
INCR ndx FROM .xi_digit_ndx + 1 TO xi$k_digits DO ! If any non-zero digit
! occurs in the XI at
IF .xi_field [xi$v_digit, .ndx] NEQ 0 ! a higher index than
! the highest we indend
! to use, then the src
THEN ! is too big for dest
SIGNAL (dix$_toobig);
! Depending on the sign type, put converted XI digits and sign
! characters into the destination field. Starting from the left (high
! order character) of the destination field and moving to the right
! (low order) consider each destination character. The highest order
! character and the lowest order character could be sign positions,
! depending on the sign type. Process sign as necessary.
SELECTONE .dix$adtt_dn [.dst_pnt [ffd$v_dt_type], dnd$v_sign_type] OF
SET
[dnd$k_lead_sep] : ! sign is leading & separate
BEGIN
dix$$mak_sep_sign (.xi_field [xi$v_sign], ! process sign
dst_pnt);
dix$$incr_des (dst_pnt); ! incr dst byte pointer
DO BEGIN ! process digits loop
dix$$mak_digit (.xi_field [xi$v_digit, .xi_digit_ndx],
dst_pnt); ! process a digit
dix$$incr_des (dst_pnt); ! incr dst byte pointer
xi_digit_ndx = .xi_digit_ndx - 1; ! decr XI digit index
END ! end of process digits loop
UNTIL .xi_digit_ndx EQL -1; ! loop til last digit processed
END; ! end case sign is leading & seaprate
[dnd$k_lead_over] : ! sign is leading & overpunched
BEGIN
dix$$mak_ovp_sgn (.xi_field [xi$v_digit, .xi_digit_ndx],
.xi_field [xi$v_sign],
dst_pnt); ! make ovp sign & store in dst
dix$$incr_des (dst_pnt); ! incr dst byte pointer
xi_digit_ndx = .xi_digit_ndx - 1; ! decr XI digit index
WHILE .xi_digit_ndx GTR -1 DO ! loop til last digit processed
BEGIN ! process digits loop
dix$$mak_digit (.xi_field [xi$v_digit, .xi_digit_ndx],
dst_pnt); ! process a digit
dix$$incr_des (dst_pnt); ! incr dst byte pointer
xi_digit_ndx = .xi_digit_ndx - 1; ! decr XI digit index
END; ! end of process digits loop
END; ! end case sign leading & overpunched
[dnd$k_trail_sep] : ! sign is trailing & separate
BEGIN
DO BEGIN ! process digits loop
dix$$mak_digit (.xi_field [xi$v_digit, .xi_digit_ndx],
dst_pnt); ! process a digit
dix$$incr_des (dst_pnt); ! incr dst byte pointer
xi_digit_ndx = .xi_digit_ndx - 1; ! decr XI digit index
END ! end of process digits loop
UNTIL .xi_digit_ndx EQL -1; ! loop til last digit processed
dix$$mak_sep_sign (.xi_field [xi$v_sign], ! process sign
dst_pnt);
END; ! end case sign trailing & separate
[dnd$k_trail_over] : ! sign is trailing & overpunched
BEGIN
WHILE .xi_digit_ndx GTR 0 DO ! loop til last digit processed
BEGIN ! process digits loop
dix$$mak_digit (.xi_field [xi$v_digit, .xi_digit_ndx],
dst_pnt); ! process a digit
dix$$incr_des (dst_pnt); ! incr dst byte pointer
xi_digit_ndx = .xi_digit_ndx - 1; ! decr XI digit index
END; ! end of process digits loop
dix$$mak_ovp_sgn (.xi_field [xi$v_digit, .xi_digit_ndx],
.xi_field [xi$v_sign],
dst_pnt); ! make ovp sign & store in dst
END; ! end case sign trailing & overpunched
[dnd$k_unsigned] : ! type is unsigned
DO BEGIN ! process digits loop
dix$$mak_digit (.xi_field [xi$v_digit, .xi_digit_ndx],
dst_pnt); ! process a digit
dix$$incr_des (dst_pnt); ! incr dst byte pointer
xi_digit_ndx = .xi_digit_ndx - 1; ! decr XI digit index
END ! end of process digits loop
UNTIL .xi_digit_ndx EQL -1; ! loop til last digit processed
TES;
.status_dn ! return status value
END; ! end of global routine dix$$con_xi_dn
%SBTTL 'GLOBAL ROUTINE dix$$con_dn'
GLOBAL ROUTINE dix$$con_dn ! \.!=;.hl 1\
! ; .index dix$$con_dn
!++
! Portal for Display Numeric conversions.
!
! SCH: Level = 1, DD = 1. Pseudonym >dixdn>.
!
! Alorgithm: Convert display numeric string to XI (fixed
! intermediate) form. Convert the intermediate digits to the
! destination character set. Use overpunched character tables where
! necessary and use the auxiliary information table.
!
! Routine value: Status value, one of the following:
! .s 1.list 1, "o"
! .le;dix$_invdnumsgn
! .le;dix$_invdnumchr
! .le;dix$_impossible
! .le;dix$_rounded (returned from dix$$adj_xi_scal)
! .le;dix$_toobig
! .le;dix$_unsigned
! .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 ! global routine dix$$con_dn
MAP
src_ffd : REF forgn_descr,
dst_ffd : REF forgn_descr;
dix$routine_debug (off)
LOCAL
error_tmp : VOLATILE, ! used by the condition handler
xi_field : xi; ! the intermediate form used
ENABLE dix$$port_hand (error_tmp); ! \Establish condition handler: \
dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);
dix$$con_dn_xi (.src_ffd, xi_field); ! ; .p;Convert src dn field to xi form.
! ; Signals if error.
dtype (on, 'XI field before scale adjustment: '); ! debugging code
debug_code (xidmp (xi_field); ! debugging code
tty_put_crlf ()); ! debugging code
dix$$con_xi_dn (xi_field, .dst_ffd) ! ;.p; Convert XI form to dst dn field.
! ; Signals if error. May return warning dix$_toobig.
END; ! end global routine dix$$con_dn
END
ELUDOM