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