Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/diumap.bli
There are 4 other files named diumap.bli in the archive. Click here to see a list.
%TITLE 'DIUMAP -- Map CDD-32, DTR20 and DIL/DIU type codes to DIL/DIU codes'

!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 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.

MODULE DIUMAP(
       IDENT='236'
       %BLISS32 (,
                 ADDRESSING_MODE(EXTERNAL=GENERAL,NONEXTERNAL=LONG_RELATIVE)
                )
       %BLISS36 (,
                 ENTRY (frocdd, frodtr, frodil, mapdtp)
                )
              ) = 
!++
!   FACILITY: Data Interchange Utility (DIU)
!
!   ABSTRACT:  This module contains the DIU data type mapping routines.
!              These routines are used to map data type codes from
!              either DIL/DIU or other facilities (VAX CDD and
!              Datatrieve-20) to DIL/DIU data type codes.
!
!   AUTHOR: Sandy Clemens, Creation Date: 30-Jul-84
!
!   EDIT HISTORY:
!
!       3	Change LIBRARY 'DIUMSG' to 'DIU'.  Remove DIU$MAP_HANDLER
!               and use the handler enabled by whoever called mapping code.
!		Sandy Clemens	14-Jun-85
!
!       12      Update data type mapping tables to reflect support of COMPLEX
!               data types.  FILES: DIUMAP.BLI
!               Sandy Clemens   12-Jul-85
!
!       17      Make DIU$_INVDATTYP and DIU$_INVTYPSYS give the data
!               type code which is invalid.  FILES: DIUMAP.BLI, DIU.R36.
!               Sandy Clemens   16-Jul-85
!
! 70	Remove "need_usage" (not used anymore).
!	Sandy Clemens  25-Feb-86
!
! 72	Correct the format of the SIGNAL's of INVDATTYP and INVTYPSYS.
!	Sandy Clemens	3-Mar-86
!
! 73	Get rid of "need_usage".
!	Sandy Clemens	4-Mar-86
!
!  236  Change library of DIXLIB to DIUDIX.
!       Sandy Clemens  19-Jun-86
!--
BEGIN
!++
!
!   Library and require files
!   
!--

%IF %BLISS (BLISS32)
%THEN
     LIBRARY 'SYS$LIBRARY:XPORT';
     UNDECLARE %QUOTE $STRING;
     LIBRARY 'SYS$LIBRARY:STARLET';
     LIBRARY 'DIU$SOURCE_LIB:DIUVMS';	! DIU VMS Specifics
     LIBRARY 'DIU$SOURCE_LIB:DIUMSG';	! DIU MESSAGE Literals
     UNDECLARE %QUOTE $DESCRIPTOR;
     REQUIRE 'DIXB32.R32';
%FI

%IF %BLISS (BLISS36)
%THEN
     LIBRARY 'BLI:XPORT';
     LIBRARY 'FAOPUT';
     LIBRARY 'FAO';
     LIBRARY 'DIU';
     REQUIRE 'DIXB36.R36';
%FI

LIBRARY 'DIUTLB';

UNDECLARE %QUOTE STS$K_SEVERE, %QUOTE STS$K_ERROR, %QUOTE STS$K_WARNING,
          %QUOTE STS$K_SUCCESS, %QUOTE SS$_NORMAL, %QUOTE STS$K_INFO;
LIBRARY 'DIUDIX';

%IF %BLISS (BLISS32)
%THEN
     UNDECLARE %QUOTE $DESCRIPTOR;
%FI

LIBRARY 'DIUMLB';

LITERAL off = 0,
        on = 1;
!++
!
!   Define the OPTLST structures for all of the text and display
!   numeric types.  The addresses of these OPTLST structures will be
!   referenced by the various MAP_TABs defined later.
!
!--


OWN

  text_opt :                            ! options for all text string types

       OPTLST
             PRESET
             (optlst_vals
              (dix$k_dt_ascii_7, dix$k_dt_ascii_8, dix$k_dt_ebcdic_9,
               dix$k_dt_ebcdic_8, dix$k_dt_sixbit)
             ),


  dnu_opt :                             ! options for all unsigned display
                                        ! numeric types
      OPTLST
            PRESET
            (optlst_vals
             (dix$k_dt_dn7u, dix$k_dt_dn8u, dix$k_dt_dn9u, 0, dix$k_dt_dn6u)
            ),


  dnls_opt :                            ! options for all display numeric
                                        ! leading separate sign types
       OPTLST
             PRESET
             (optlst_vals
              (dix$k_dt_dn7ls, dix$k_dt_dn8ls, dix$k_dt_dn9ls, 0, dix$k_dt_dn6ls)
             ),


  dnlo_opt :                            ! options for all display numeric
                                        ! leading overpunched sign types
       OPTLST
             PRESET
             (optlst_vals
              (dix$k_dt_dn7lo, dix$k_dt_dn8lo, dix$k_dt_dn9lo, 0, dix$k_dt_dn6lo)
             ),


  dnts_opt :                            ! options for all display numeric
                                        ! trailing separate sign types
       OPTLST
             PRESET
             (optlst_vals
              (dix$k_dt_dn7ts, dix$k_dt_dn8ts, dix$k_dt_dn9ts, 0, dix$k_dt_dn6ts)
             ),


  dnto_opt :                            ! options for all display numeric
                                        ! trailing overpunched sign types
       OPTLST
             PRESET
             (optlst_vals
              (dix$k_dt_dn7to, dix$k_dt_dn8to, dix$k_dt_dn9to, 0, dix$k_dt_dn6to)
             );
%SBTTL 'DIU$MAP_FROM_CDD -- Map VAX CDD data type codes to DIL/DIU codes.'
!*****************************************************************************
!
!    G L O B A L    R O U T I N E    D I U $ M A P _ F R O M _ C D D
!
!*****************************************************************************
GLOBAL ROUTINE DIU$MAP_FROM_CDD (sysor, cdd_type, char_flag, pro_flag) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       This routine maps a CDD-32 data type code into a DIU data
!       type code.
!
! FORMAL PARAMETERS
!
!	sysor		(integer) system of origin of a field which the
!			data type will be associated with
!
!	cdd_type	(integer) data type code extracted from CDD;
!			it will be used as the table index
!
!       char_flag	(integer) flag indicating a character type, if
!			desired, to override any default (use literals
!			defined in module DIUMLB)
!
!       pro_flag	(integer) flag, set ON if this is a PRO 8-bit
!			data type, as opposed to a VAX 8-bit type.
!
!
! IMPLICIT PARAMETERS
!
!       none
!
! ROUTINE VALUE
!
!       The DIL data type code.
!--
!++
!
!   Define DIU$cddtab, the MAP_TAB used to map VAX CDD data type codes
!   to DIU data type codes.
!
!--

OWN
  DIU$cddtab : map_tab (cdd_max + 1)  ! the CDD-->DIU data type mapping table

  PRESET
!++
! Parameters to macro:
! -----------------------               ! CDD data type description:
! idx,txt fl,8bit,lcg,pro               ! --------------------------
!--

  (map_entry                            ! Unspecified
   (0, 0, diu$k_dt_structure, diu$k_dt_structure, diu$k_dt_structure),
   map_entry                            ! Bit Aligned
   (1, 0, 0, 0, 0),
   map_entry                            ! Unsigned Byte
   (2, 0, dix$k_dt_ubf8, dix$k_dt_ubf36, dix$k_dt_ubf8),
   map_entry                            ! Unsigned Word
   (3, 0, dix$k_dt_ubf16, dix$k_dt_ubf36, dix$k_dt_ubf16),
   map_entry                            ! Unsigned Longword
   (4, 0, dix$k_dt_ubf32, dix$k_dt_ubf72, dix$k_dt_ubf32),
   map_entry                            ! Unsigned Quadword
   (5, 0, dix$k_dt_ubf64, dix$k_dt_ubf72, dix$k_dt_ubf32),
   map_entry                            ! Signed Byte
   (6, 0, dix$k_dt_sbf8, dix$k_dt_sbf36, dix$k_dt_sbf8),
   map_entry                            ! Signed Word
   (7, 0, dix$k_dt_sbf16, dix$k_dt_sbf36, dix$k_dt_sbf16),
   map_entry                            ! Signed Longword
   (8, 0, dix$k_dt_sbf32, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! Signed Quadword
   (9, 0, dix$k_dt_sbf64, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! F_floating
   (10, 0, dix$k_dt_f_float, dix$k_dt_float_36, dix$k_dt_f_float),
   map_entry                            ! D_floating
   (11, 0, dix$k_dt_d_float, dix$k_dt_float_72, dix$k_dt_d_float),
   map_entry                            ! F_floating Complex
   (12, 0, dix$k_dt_f_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! D_floating Complex
   (13, 0, dix$k_dt_d_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! Text
   (14, 1, dix$k_dt_ascii_8, dix$k_dt_ascii_7, dix$k_dt_ascii_8, 'text'),
   map_entry                            ! Unsigned Numeric String
   (15, 1, dix$k_dt_dn8u, dix$k_dt_dn7u, dix$k_dt_dn8u,'dnu'),
   map_entry                            ! Numeric String W/ Sign Left Separate
   (16, 1, dix$k_dt_dn8ls, dix$k_dt_dn7ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! Num String W/ Sign Left Overpunched
   (17, 1, dix$k_dt_dn8lo, dix$k_dt_dn7lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! Numeric String W/ Sign Right Separate
   (18, 1, dix$k_dt_dn8ts, dix$k_dt_dn7ts, dix$k_dt_dn8ts,'dnts'),
   map_entry                            ! Num String W/ Sign Right Overpunched
   (19, 1, dix$k_dt_dn8to, dix$k_dt_dn7to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! Numeric String, Zoned
   (20, 0, 0, 0, 0),
   map_entry                            ! Packed Decimal
   (21, 0, dix$k_dt_pd8, dix$k_dt_pd9, dix$k_dt_pd8),
   map_entry                            ! Instruction Sequence
   (22, 0, 0, 0, 0),
   map_entry                            ! Entry Mask
   (23, 0, 0, 0, 0),
   map_entry                            ! Descriptor
   (24, 0, 0, 0, 0),
   map_entry                            ! Unsigned Octaword
   (25, 0, dix$k_dt_ubf128, dix$k_dt_ubf72, dix$k_dt_ubf32),
   map_entry                            ! Signed Octaword
   (26, 0, dix$k_dt_sbf128, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! G_floating
   (27, 0, dix$k_dt_g_float, dix$k_dt_g_float72, dix$k_dt_d_float),
   map_entry                            ! H_floating
   (28, 0, dix$k_dt_h_float, dix$k_dt_g_float72, dix$k_dt_d_float),
   map_entry                            ! G_floating Complex
   (29, 0, dix$k_dt_g_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! H_floating Complex
   (30, 0, dix$k_dt_h_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! COBOL Intermediate
   (31, 0, 0, 0, 0),
   map_entry                            ! Bound Procedure Value
   (32, 0, 0, 0, 0),
   map_entry                            ! Bound Label Value
   (33, 0, 0, 0, 0),
   map_entry                            ! Bit Unaligned
   (34, 0, 0, 0, 0),
   map_entry                            ! Absolute Date/Time
   (35, 0, 0, 0, 0),
   map_entry                            ! --UNKNOWN--
   (36, 0, 0, 0, 0),
   map_entry                            ! Varying Text
   (37, 0, 0, 0, 0),
   map_entry                            ! CDD Date
   (256, 0, 0, 0, 0),
   map_entry                            ! CDD Virtual Field
   (257, 0, 0, 0, 0),
   map_entry                            ! CDD Overlay
   (258, 0, diu$k_dt_overlay, diu$k_dt_overlay, diu$k_dt_overlay),
   map_entry                            ! CDD Varying String
   (259, 0, 0, 0, 0),
   map_entry                            ! Pointer
   (260, 0, 0, 0, 0)
  );

LOCAL diu_typ : INITIAL (0),
      opt_addr : INITIAL (0),
      error_tmp : VOLATILE;

MAP opt_addr : REF optlst;

IF .cdd_type GTR cdd_max
THEN SIGNAL (DIU$_INVDATTYP, 1, .cdd_type, 0) ; ! invalid source cdd type

!++
! If the text flag in the mapping table is set to OFF for the given
! data type, that means that the data type is not a string or display
! numeric type and that the data type will not be effected by any
! character set specified by the user.  If the users character set
! flag is turned ON, but the mapping table text flag is OFF, then set
! the character set flag (locally) to default_typ, so that we don't
! have to consider the char_flag, which is rendered irrelevant!!!
!
! Note that to preserve the data types OVERLAY and STRUCTURE, we have
! defined literals, DIU$K_DT_OVERLAY and DIU$K_DT_STRUCTURE which are
! returned for these values.  (These literals are in the proper places
! in the mapping table.)
!--

IF NOT .DIU$cddtab [.cdd_type, map_txt_flg] THEN char_flag = default_typ;

SELECTONE .char_flag OF                 ! depending on the char_flag, find
SET                                     !  the corresponding DIU type
 
[default_typ, unspec_typ] :             ! default data type (or text type)

      SELECTONE .sysor OF
      SET

      [sys_lcg] :                       ! If LCG system, select LCG default
          diu_typ = .DIU$cddtab [.cdd_type, map_deflcg];

      [sys_8bit] :
          IF .pro_flag                  ! If pro_flag ON, select PRO default
          THEN
              diu_typ = .DIU$cddtab [.cdd_type, map_defpro]
          ELSE                          ! Else, select usual 8-bit default
              diu_typ = .DIU$cddtab [.cdd_type, map_def8];

      TES;


[ascii_txt] :                           ! ASCII char set, regardless of default
      BEGIN
      opt_addr = .DIU$cddtab [.cdd_type, map_optlst];
      IF .sysor EQL sys_lcg
      THEN
          diu_typ = .opt_addr [opt_ascii7]
      ELSE
          diu_typ = .opt_addr [opt_ascii8]      ! VAX & PRO always have same
      END;                                      ! default for ASCII text


[ebcdic_txt] :                          ! EBCDIC char set, regardless of default
        BEGIN
        opt_addr = .DIU$cddtab [.cdd_type, map_optlst];
        IF .sysor EQL sys_lcg
        THEN
            diu_typ = .opt_addr [opt_ebcdic9]
        ELSE
            diu_typ = .opt_addr [opt_ebcdic8]   ! VAX & PRO always have same
        END;                                    ! default for EBCDIC text


[sixbit_txt] :                          ! SIXBIT char set was specified
        BEGIN
        opt_addr = .DIU$cddtab [.cdd_type, map_optlst];
        IF .sysor EQL sys_lcg
        THEN
            diu_typ = .opt_addr [opt_sixbit]
        ELSE
            BEGIN                       ! do the same thing whether VAX or PRO
            diu_typ = .opt_addr [opt_sixbit];
            ! invalid datatype for sys. (targ sys doesn't support datatype)
            SIGNAL (DIU$_INVTYPSYS, 1, .diu_typ, 0)
            END
        END;
TES;

IF .diu_typ EQL 0
THEN SIGNAL (DIU$_INVDATTYP, 1, .diu_typ, 0) ;  ! datatype not supported by DIU

.diu_typ                                ! return diu_typ

END;                                    ! end of routine DIU$MAP_FROM_CDD
%SBTTL 'DIU$MAP_FROM_DTR -- Map DTR-20 data type codes to DIL/DIU codes.'
!*****************************************************************************
!
!    G L O B A L    R O U T I N E    D I U $ M A P _ F R O M _ D T R
!
!*****************************************************************************
GLOBAL ROUTINE DIU$MAP_FROM_DTR (sysor, dtr_type, char_flag, pro_flag) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       This routine maps a DTR-20 data type code into a DIU data
!       type code.
!
! FORMAL PARAMETERS
!
!	sysor		(integer) system of origin of a field which the
!			data type will be associated with
!
!	dtr_type	(integer) data type code extracted from DTR-20;
!			it will be used as the table index
!
!       char_flag	(integer) flag indicating a character type, if
!			desired, to override any default (use literals
!			defined in module DIUMLB)
!
!       pro_flag	(integer) flag, set ON if this is a PRO 8-bit
!			data type, as opposed to a VAX 8-bit type.
!
!
! IMPLICIT PARAMETERS
!
!       none
!
! ROUTINE VALUE
!
!       The DIL data type code.
!--
!++
!
!   Define DIU$dtrtab, the MAP_TAB used to map DTR-20 data type codes
!   to DIU data type codes.
!
!--

OWN
  DIU$dtrtab : map_tab (dtr_max + 1)

  PRESET
!++
! Parameters to macro:
! -----------------------               ! DTR data type description:
! idx,txt fl,8bit,lcg,pro               ! --------------------------
!--

  (map_entry                            ! Unspecified Type
   (0, 0, 0, 0, 0),
   map_entry                            ! 36bit signed 2-comp integer
   (1, 0, dix$k_dt_sbf32, dix$k_dt_sbf36, dix$k_dt_sbf32),
   map_entry                            ! 72bit signed 2-comp integer
   (2, 0, dix$k_dt_sbf64, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! 36bit double precision binary fp
   (3, 0, dix$k_dt_f_float, dix$k_dt_float_36, dix$k_dt_f_float),
   map_entry                            ! 72bit double precision binary fp
   (4, 0, dix$k_dt_d_float, dix$k_dt_float_72, dix$k_dt_d_float),
   map_entry                            ! 36bit binary internal date-time word
   (5, 0, 0, 0, 0),
   map_entry                            ! 7bit ASCII text
   (6, 1, dix$k_dt_ascii_8, dix$k_dt_ascii_7, dix$k_dt_ascii_8, 'text'),
   map_entry                            ! 7bit ASCII numeric unsigned
   (7, 1, dix$k_dt_dn8u, dix$k_dt_dn7u, dix$k_dt_dn8u, 'dnu'),
   map_entry                            ! 7bit ASCII num, sign leading separate
   (8, 1, dix$k_dt_dn8ls, dix$k_dt_dn7ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! 7b ASCII num, sign leading overpunch
   (9, 1, dix$k_dt_dn8lo, dix$k_dt_dn7lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! 7b ASCII num, sign trailing separate
   (10, 1, dix$k_dt_dn8ts, dix$k_dt_dn7ts, dix$k_dt_dn8ts, 'dnts'),
   map_entry                            ! 7b ASCII num, sign trailing overpunch
   (11, 1, dix$k_dt_dn8to, dix$k_dt_dn7to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! SIXBIT text
   (12, 1, dix$k_dt_ascii_8, dix$k_dt_sixbit, dix$k_dt_ascii_8, 'text'),
   map_entry                            ! SIXBIT numeric unsigned
   (13, 1, dix$k_dt_dn8u, dix$k_dt_dn6u, dix$k_dt_dn8u,  'dnu'),
   map_entry                            ! SIXBIT numeric, sign leading separate
   (14, 1, dix$k_dt_dn8ls, dix$k_dt_dn6ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! SIXBIT num, sign leading overpunched
   (15, 1, dix$k_dt_dn8lo, dix$k_dt_dn6lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! SIXBIT num, sign trailing separate
   (16, 1, dix$k_dt_dn8ts, dix$k_dt_dn6ts, dix$k_dt_dn8ts, 'dnts'),
   map_entry                            ! SIXBIT num, sign trailing overpunched
   (17, 1, dix$k_dt_dn8to, dix$k_dt_dn6to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! 8bit ASCII text
   (18, 1, dix$k_dt_ascii_8, dix$k_dt_ascii_7, dix$k_dt_ascii_8, 'text'),
   map_entry                            ! 8bit ASCII numeric unsigned
   (19, 1, dix$k_dt_dn8u, dix$k_dt_dn7u, dix$k_dt_dn8u, 'dnu'),
   map_entry                            ! 8bit numeric, sign leading separate
   (20, 1, dix$k_dt_dn8ls, dix$k_dt_dn7ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! 8bit num, sign leading overpunched
   (21, 1, dix$k_dt_dn8lo, dix$k_dt_dn7lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! 8bit num, sign trailing separate
   (22, 1, dix$k_dt_dn8ts, dix$k_dt_dn7ts, dix$k_dt_dn8ts, 'dnts'),
   map_entry                            ! 8bit num, sign trailing overpunched
   (23, 1, dix$k_dt_dn8to, dix$k_dt_dn7to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! VAX 128 bit H-floating
   (24, 0, dix$k_dt_h_float, dix$k_dt_g_float72, dix$k_dt_d_float),
   map_entry                            ! VAX 64 bit date/time
   (25, 0, 0, 0, 0),
   map_entry                            ! 9 bit packed decimal
   (26, 0, dix$k_dt_pd8, dix$k_dt_pd9, dix$k_dt_pd8)
  );

LOCAL diu_typ : INITIAL (0),
      opt_addr : INITIAL (0),
      error_tmp : VOLATILE;

MAP opt_addr : REF optlst;

IF .dtr_type GTR dtr_max
    THEN SIGNAL (DIU$_INVDATTYP, 1, .dtr_type, 0);      ! invalid src dtr type

!++
! If the text flag in the mapping table is set to OFF for the given
! data type, that means that the data type is not a string or display
! numeric type and that the data type will not be effected by any
! character set specified by the user.  If the users character set
! flag is turned ON, but the mapping table text flag is OFF, then set
! the character set flag (locally) to default_typ, so that we don't
! have to consider the char_flag, which is rendered irrelevant!!!
!--

IF NOT .DIU$dtrtab [.dtr_type, map_txt_flg] THEN char_flag = default_typ;


SELECTONE .char_flag OF
SET
 
[default_typ, unspec_typ] :             ! default data type (or text type)

      SELECTONE .sysor OF
      SET

      [sys_lcg] :                       ! If LCG system, select LCG default
          diu_typ = .DIU$dtrtab [.dtr_type, map_deflcg];

      [sys_8bit] :
          IF .pro_flag                  ! If pro_flag ON, select PRO default
          THEN
              diu_typ = .DIU$dtrtab [.dtr_type, map_defpro]
          ELSE                          ! Else, select usual 8-bit default
              diu_typ = .DIU$dtrtab [.dtr_type, map_def8];

      TES;

[ascii_txt] :                           ! ASCII char set, regardless of default
      BEGIN
      opt_addr = .DIU$dtrtab [.dtr_type, map_optlst];
      IF .sysor EQL sys_lcg
      THEN
          diu_typ = .opt_addr [opt_ascii7]
      ELSE
          diu_typ = .opt_addr [opt_ascii8]      ! VAX & PRO always have same
      END;                                      ! default for ASCII text
 
[ebcdic_txt] :                          ! EBCDIC char set, regardless of default
       BEGIN
       opt_addr = .DIU$dtrtab [.dtr_type, map_optlst];
       IF .sysor EQL sys_lcg
       THEN
           diu_typ = .opt_addr [opt_ebcdic9]
       ELSE
           diu_typ = .opt_addr [opt_ebcdic8]    ! VAX & PRO always have same
       END;                                     ! default for EBCDIC text

[sixbit_txt] :                          ! SIXBIT char set, regardless of default
       BEGIN
       opt_addr = .DIU$dtrtab [.dtr_type, map_optlst];
       IF .sysor EQL sys_lcg
       THEN
           diu_typ = .opt_addr [opt_sixbit]
       ELSE
           BEGIN                        ! do the same thing whether VAX or PRO
           diu_typ = .opt_addr [opt_sixbit];
           ! invalid datatype for sys. (targ sys doesn't support datatype)
           SIGNAL (DIU$_INVTYPSYS, 1, .diu_typ, 0)
           END
       END;
TES;

IF .diu_typ EQL 0
THEN SIGNAL (DIU$_INVDATTYP, 1, .diu_typ, 0) ;  ! datatype not supported by DIU

.diu_typ                                ! return diu_typ

END;                                    ! end of routine DIU$MAP_FROM_DTR
%SBTTL 'DIU$MAP_FROM_DIL -- Map DIL/DIU data type codes to DIL/DIU codes.'
!*****************************************************************************
!
!    G L O B A L    R O U T I N E    D I U $ M A P _ F R O M _ D I L
!
!*****************************************************************************
GLOBAL ROUTINE DIU$MAP_FROM_DIL (sysor, dil_type, char_flag, pro_flag) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       This routine maps a DIU data type code into a DIU data
!       type code.
!
! FORMAL PARAMETERS
!
!	sysor		(integer) system of origin of a field which the
!			data type will be associated with
!
!	dil_type	(integer) DIU/DIL data type code; it will be used
!			as the table index
!
!       char_flag	(integer) flag indicating a character type, if
!			desired, to override any default (use literals
!			defined in module DIUMLB)
!
!       pro_flag	(integer) flag, set ON if this is a PRO 8-bit
!			data type, as opposed to a VAX 8-bit type.
!
!
! IMPLICIT PARAMETERS
!
!       none
!
! ROUTINE VALUE
!
!       The DIL data type code.
!--
!++
!
!   Define MAP_TABs used to map DIL data type codes to DIU data type
!   codes.
!
!--

!++
!   Rather than waste alot of space with a VERRRRY sparse table of DIL
!   to DIL data type code mappings, there are 5 different tables, one
!   for each DIL data class (string, fbin, fp, dnum, pdec).  Each
!   table is indexed by the within-class type code of the data type.
!--

OWN
  DIU$dilstr_tab : map_tab (dt_class_string_max + 1)

  PRESET
!++
! Parameters to macro:
! -----------------------               ! DIL data type description:
! idx,txt fl,8bit,lcg,pro               ! --------------------------
!--

  (map_entry                            ! Ascii-7 Text
   (1, 1, dix$k_dt_ascii_8, dix$k_dt_ascii_7, dix$k_dt_ascii_8, 'text'),
   map_entry                            ! Ascii-8 Text
   (2, 1, dix$k_dt_ascii_8, dix$k_dt_ascii_7, dix$k_dt_ascii_8, 'text'),
   map_entry                            ! Asciiz Text
   (3, 1, dix$k_dt_ascii_8, dix$k_dt_asciz, dix$k_dt_ascii_8, 'text'),
   map_entry                            ! Ebcdic-8 Text
   (4, 1, dix$k_dt_ebcdic_8, dix$k_dt_ebcdic_9, dix$k_dt_ebcdic_8, 'text'),
   map_entry                            ! Ebcdic-9 Text
   (5, 1, dix$k_dt_ebcdic_8, dix$k_dt_ebcdic_9, dix$k_dt_ebcdic_8, 'text'),
   map_entry                            ! Sixbit Text
   (6, 1, dix$k_dt_ascii_8, dix$k_dt_sixbit, dix$k_dt_ascii_8, 'text')
  );

OWN
  DIU$dilfbn_tab : map_tab (dt_class_fbin_max + 1)

  PRESET
!++
! Parameters to macro:
! -----------------------               ! DIL data type description:
! idx,txt fl,8bit,lcg,pro               ! --------------------------
!--

  (map_entry                            ! Sbf128
   (1, 0, dix$k_dt_sbf128, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! Sbf16
   (2, 0, dix$k_dt_sbf16, dix$k_dt_sbf36, dix$k_dt_sbf16),
   map_entry                            ! Sbf32
   (3, 0, dix$k_dt_sbf32, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! Sbf36
   (4, 0, dix$k_dt_sbf16, dix$k_dt_sbf36, dix$k_dt_sbf16),
   map_entry                            ! Sbf48
   (5, 0, dix$k_dt_sbf48, 0, 0),
   map_entry                            ! Sbf64
   (6, 0, dix$k_dt_sbf64, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! Sbf72
   (7, 0, dix$k_dt_sbf64, dix$k_dt_sbf72, dix$k_dt_sbf32),
   map_entry                            ! Sbf8
   (8, 0, dix$k_dt_sbf8, dix$k_dt_sbf36, dix$k_dt_sbf8),
   map_entry                            ! Sbfvar -- Unsupported
   (9, 0, 0, 0, 0),
   map_entry                            ! Ubf16
   (10, 0, dix$k_dt_ubf16, dix$k_dt_ubf36, dix$k_dt_sbf16),
   map_entry                            ! Ubf32
   (11, 0, dix$k_dt_ubf32, dix$k_dt_ubf72, dix$k_dt_ubf32),
   map_entry                            ! Ubf8
   (12, 0, dix$k_dt_ubf8, dix$k_dt_ubf36, dix$k_dt_ubf8),
   map_entry                            ! Ubfvar
   (13, 0, 0, 0, 0),
   map_entry                            ! Ubf128
   (14, 0, dix$k_dt_ubf128, dix$k_dt_ubf72, dix$k_dt_ubf32),
   map_entry                            ! Ubf36
   (15, 0, dix$k_dt_ubf16, dix$k_dt_ubf36, dix$k_dt_ubf16),
   map_entry                            ! Ubf64
   (16, 0, dix$k_dt_ubf64, dix$k_dt_ubf72, dix$k_dt_ubf32),
   map_entry                            ! Ubf72
   (17, 0, dix$k_dt_ubf64, dix$k_dt_ubf72, dix$k_dt_ubf32)
  );

OWN
  DIU$dilfp_tab : map_tab (dt_class_fp_max + 1)

  PRESET
!++
! Parameters to macro:
! -----------------------               ! DIL data type description:
! idx,txt fl,8bit,lcg,pro               ! --------------------------
!--

  (map_entry                            ! D_float
   (1, 0, dix$k_dt_d_float, dix$k_dt_float_72, dix$k_dt_d_float),
   map_entry                            ! F_float
   (2, 0, dix$k_dt_f_float, dix$k_dt_float_36, dix$k_dt_f_float),
   map_entry                            ! Float_36
   (3, 0, dix$k_dt_f_float, dix$k_dt_float_36, dix$k_dt_f_float),
   map_entry                            ! Float_72
   (4, 0, dix$k_dt_d_float, dix$k_dt_float_72, dix$k_dt_d_float),
   map_entry                            ! G_float
   (5, 0, dix$k_dt_g_float, dix$k_dt_g_float72, dix$k_dt_d_float),
   map_entry                            ! G_float72
   (6, 0, dix$k_dt_g_float, dix$k_dt_g_float72, dix$k_dt_d_float),
   map_entry                            ! H_float
   (7, 0, dix$k_dt_h_float, dix$k_dt_g_float72, dix$k_dt_d_float),
   map_entry                            ! VAX D_floating Complex
   (8, 0, dix$k_dt_d_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! VAX F_floating Complex
   (9, 0, dix$k_dt_f_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! TOPS-10/20 F_floating Complex
   (10, 0, dix$k_dt_f_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! VAX G_Floating Complex
   (11, 0, dix$k_dt_g_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx),
   map_entry                            ! VAX H_floating Complex
   (12, 0, dix$k_dt_h_cmplx, dix$k_dt_f_cmplx36, dix$k_dt_f_cmplx)
  );

OWN
  DIU$dildn_tab : map_tab (dt_class_dnum_max + 1)

  PRESET
!++
! Parameters to macro:
! -----------------------               ! DIL data type description:
! idx,txt fl,8bit,lcg,pro               ! --------------------------
!--

  (map_entry                            ! Dn6lo
   (1, 1, dix$k_dt_dn8lo, dix$k_dt_dn6lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! Dn6ls
   (2, 1, dix$k_dt_dn8ls, dix$k_dt_dn6ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! Dn6to
   (3, 1, dix$k_dt_dn8to, dix$k_dt_dn6to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! Dn6ts
   (4, 1, dix$k_dt_dn8ts, dix$k_dt_dn6ts, dix$k_dt_dn8ts, 'dnts'),
   map_entry                            ! Dn6u
   (5, 1, dix$k_dt_dn8u, dix$k_dt_dn6u, dix$k_dt_dn8u, 'dnu'),
   map_entry                            ! Dn7lo
   (6, 1, dix$k_dt_dn8lo, dix$k_dt_dn7lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! Dn7ls
   (7, 1, dix$k_dt_dn8ls, dix$k_dt_dn7ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! Dn7to
   (8, 1, dix$k_dt_dn8to, dix$k_dt_dn7to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! Dn7ts
   (9, 1, dix$k_dt_dn8ts, dix$k_dt_dn7ts, dix$k_dt_dn8ts, 'dnts'),
   map_entry                            ! Dn7u
   (10, 1, dix$k_dt_dn8u, dix$k_dt_dn7u, dix$k_dt_dn8u, 'dnu'),
   map_entry                            ! Dn8lo
   (11, 1, dix$k_dt_dn8lo, dix$k_dt_dn7lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! Dn8ls
   (12, 1, dix$k_dt_dn8ls, dix$k_dt_dn7ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! Dn8to
   (13, 1, dix$k_dt_dn8to, dix$k_dt_dn7to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! Dn8ts
   (14, 1, dix$k_dt_dn8ts, dix$k_dt_dn7ts, dix$k_dt_dn8ts, 'dnts'),
   map_entry                            ! Dn8u
   (15, 1, dix$k_dt_dn8u, dix$k_dt_dn7u, dix$k_dt_dn8u, 'dnu'),
   map_entry                            ! Dn9lo
   (16, 1, dix$k_dt_dn8lo, dix$k_dt_dn9lo, dix$k_dt_dn8lo, 'dnlo'),
   map_entry                            ! Dn9ls
   (17, 1, dix$k_dt_dn8ls, dix$k_dt_dn9ls, dix$k_dt_dn8ls, 'dnls'),
   map_entry                            ! Dn9to
   (18, 1, dix$k_dt_dn8to, dix$k_dt_dn9to, dix$k_dt_dn8to, 'dnto'),
   map_entry                            ! Dn9ts
   (19, 1, dix$k_dt_dn8ts, dix$k_dt_dn9ts, dix$k_dt_dn8ts, 'dnts'),
   map_entry                            ! Dn9u
   (20, 1, dix$k_dt_dn8u, dix$k_dt_dn9u, dix$k_dt_dn8u, 'dnu')
  );

OWN
  DIU$dilpd_tab : map_tab (dt_class_pdec_max + 1)

  PRESET
!++
! Parameters to macro:
! -----------------------               ! DIL data type description:
! idx,txt fl,8bit,lcg,pro               ! --------------------------
!--

  (map_entry                            ! Pd8
   (1, 0, dix$k_dt_pd8, dix$k_dt_pd9, dix$k_dt_pd8),
   map_entry                            ! Pd9
   (2, 0, dix$k_dt_pd8, dix$k_dt_pd9, dix$k_dt_pd8)
  );

LOCAL diu_typ : INITIAL (0),
      opt_addr : INITIAL (0),
      error_tmp : VOLATILE,
      dil_map,
      typ_sep : data_type_sep;

MAP opt_addr : REF optlst,
    dil_map : REF map_tab (0);          ! size irrelevant here

IF .dil_type EQL DIU$K_DT_OVERLAY	! overlay is special case
THEN RETURN (DIU$K_DT_OVERLAY);		! return DIU overlay literal

IF .dil_type EQL DIU$K_DT_STRUCTURE     ! structure is special case
THEN RETURN (DIU$K_DT_STRUCTURE);       ! return DIU structure literal


typ_sep = .dil_type;

! If the within-class datatype code is valid, then select
! the map table to use, otherwise signal error.
SELECTONE .typ_sep [dt_class_sep] OF
    SET

    [dt_string] :
	BEGIN
	IF .typ_sep [dt_code_sep] GTR dt_class_string_max
	THEN SIGNAL (DIU$_INVDATTYP, 1, .dil_type, 0);  ! inval src dil type
        dil_map = DIU$dilstr_tab;
	END;

    [dt_fbin] :
	BEGIN
	IF .typ_sep [dt_code_sep] GTR dt_class_fbin_max
	THEN SIGNAL (DIU$_INVDATTYP, 1, .dil_type, 0);  ! inval src dil type
        dil_map = DIU$dilfbn_tab;
	END;

    [dt_fp] :
	BEGIN
	IF .typ_sep [dt_code_sep] GTR dt_class_fp_max
	THEN SIGNAL (DIU$_INVDATTYP, 1, .dil_type, 0);  ! inval src dil type
        dil_map = DIU$dilfp_tab;
	END;

    [dt_dnum] :
	BEGIN
	IF .typ_sep [dt_code_sep] GTR dt_class_dnum_max
	THEN SIGNAL (DIU$_INVDATTYP, 1, .dil_type, 0);  ! inval src dil type
        dil_map = DIU$dildn_tab;
	END;

    [dt_pdec] :
	BEGIN
	IF .typ_sep [dt_code_sep] GTR dt_class_pdec_max
	THEN SIGNAL (DIU$_INVDATTYP, 1, .dil_type, 0);  ! inval src dil type
        dil_map = DIU$dilpd_tab;
	END;

    [OTHERWISE] :
        SIGNAL (DIU$_INVDATTYP, 1, .dil_type, 0);       ! invalid src dil type

    TES;

!++
! If the text flag in the mapping table is set to OFF for the given
! data type, that means that the data type is not a string or display
! numeric type and that the data type will not be effected by any
! character set specified by the user.  If the users character set
! flag is turned ON, but the mapping table text flag is OFF, then set
! the character set flag (locally) to default_typ, so that we don't
! have to consider the char_flag, which is rendered irrelevant!!!
!--
IF NOT .dil_map [.typ_sep [dt_code_sep], map_txt_flg]
   THEN char_flag = default_typ;


SELECTONE .char_flag OF
SET

[default_typ, unspec_typ] :             ! default data type (or text type)
      SELECTONE .sysor OF
      SET

      [sys_lcg] :                       ! If LCG system, select LCG default
          diu_typ = .dil_map [.typ_sep [dt_code_sep], map_deflcg];

      [sys_8bit] :
           IF .pro_flag                 ! If pro_flag ON, select PRO default
           THEN
               diu_typ = .dil_map [.typ_sep [dt_code_sep], map_defpro]
           ELSE                         ! Else, select usual 8-bit default
               diu_typ = .dil_map [.typ_sep [dt_code_sep], map_def8];
      TES;

[ascii_txt] :                           ! ASCII char set was specified
      BEGIN
      opt_addr = .dil_map [.typ_sep [dt_code_sep], map_optlst];
      IF .sysor EQL sys_lcg
      THEN
          diu_typ = .opt_addr [opt_ascii7]
      ELSE
          diu_typ = .opt_addr [opt_ascii8]      ! VAX & PRO always have same
      END;                                      ! default for ASCII text

[ebcdic_txt] :                          ! EBCDIC char set was specified
       BEGIN
       opt_addr = .dil_map [.typ_sep [dt_code_sep], map_optlst];
       IF .sysor EQL sys_lcg
       THEN
           diu_typ = .opt_addr [opt_ebcdic9]
       ELSE
           diu_typ = .opt_addr [opt_ebcdic8]    ! VAX & PRO always have same
       END;                                     ! default for EBCDIC text

[sixbit_txt] :                          ! SIXBIT char set was specified
       BEGIN
       opt_addr = .dil_map [.typ_sep [dt_code_sep], map_optlst];
       IF .sysor EQL sys_lcg
       THEN
           diu_typ = .opt_addr [opt_sixbit]
       ELSE
           BEGIN                        ! do the same thing whether VAX or PRO
           diu_typ = .opt_addr [opt_sixbit];
           ! invalid datatype for sys. (targ sys doesn't support datatype)
           SIGNAL (DIU$_INVTYPSYS, 1, .diu_typ, 0)
           END
       END;

TES;

IF .diu_typ EQL 0
THEN
    ! invalid datatype for sys. (targ sys doesn't support datatype)
    SIGNAL (DIU$_INVTYPSYS, 1, .diu_typ, 0);

.diu_typ                                ! return diu_typ

END;                                    ! end of routine DIU$MAP_FROM_DIL
%SBTTL 'DIU$MAP_DATATYPES -- Portal routine to data type mapping routines.'
!**************************************************************************
!
!                D I U $ M A P _ D A T A T Y P E S

!**************************************************************************
GLOBAL ROUTINE DIU$MAP_DATATYPES (sysor, type_code, chr_flg, src_ind)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       This routine is the portal routine which calls the various
!       routines to map CDD-32, DTR20 and DIL/DIU data type codes
!       to DIL/DIU type codes.
!
! FORMAL PARAMETERS
!
!	sysor		(integer) system of origin of a field which the
!			data type will be associated with
!
!	type_code	(integer) data type code extracted from CDD;
!			it will be used as the table index
!
!       chr_flg  	(integer) flag indicating a character type, if
!			desired, to override any default (use literals
!			defined in module DIUMLB)
!
!       src_ind         (integer) source indicator; a value indicating
!                       whether this is a CDD32, DTR20 or DIL/DIU type
!                       code (use literals defined in DIUMLB).
!
! IMPLICIT PARAMETERS
!
!       none
!
! ROUTINE VALUE
!
!       The DIL data type code returned from the specific mapping
!       routine called.
!--

LOCAL diu_typ : INITIAL (0),            ! the final diu type to be returned
      pro_flg : INITIAL (OFF);          ! set ON if this is a PRO 8-bit type

IF .sysor EQL sys_pro                   ! if type is sys_pro then set pro_flg
THEN (pro_flg = ON;                     ! and set sysor to sys_8bit
      sysor = sys_8bit);

SELECTONE .src_ind OF
SET

   [dtr20_src] : 
                 diu_typ = diu$map_from_dtr (.sysor, .type_code,
                                           .chr_flg, .pro_flg);

   [cdd32_src] : 
                 diu_typ = diu$map_from_cdd (.sysor, .type_code,
                                           .chr_flg, .pro_flg);

   [dil_src] :
               diu_typ = diu$map_from_dil (.sysor, .type_code,
                                         .chr_flg, .pro_flg);

TES;

.diu_typ                                ! return diu_typ

END;

END
ELUDOM