Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-1/language-sources/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.
!  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.0(50)'                   ! \.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 )%

! **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