Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/t20src/diudix.r36
There are 4 other files named diudix.r36 in the archive. Click here to see a list.
%TITLE 'Library of DIX definitions for DIU'
!
!  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.
!
!++
!  EDIT HISTORY:
!
!  236	Add DIUDIX.R36 (a smaller clone of DIXLIB, FIELDS and STAR36).
!	Sandy Clemens  19-Jun-86
!--
!++
! This module is a clone of the DIX module DIXLIB.  It defines global
! data structures and code values necessary to talk to DIX.
!--

LIBRARY 'BLI:XPORT';

! These macros are used to make it easy to work with fields defined by masks or
! positions, etc.  (These are also defined in FIELDS in DIL).

MACRO
    make_mask

    ! Make a mask for a field given the bit position within the word, and the
    ! length of the field.

        (
        pos,                            ! Bit position in normal BLISS notation
        lng                             ! Length in bits
        ) =

        ((1^lng - 1)^pos)%,

    field_position

    !   Given a mask, return the field position (bit number of the LO bit).

        (
        mask                            ! The mask
        ) =

        (%NBITSU (mask AND - mask) - 1) %,

    field_length

    ! Given a mask, return the field length in bits.

        (
        mask                            ! The mask
        ) =

        ! %BPVAL - %NBITSU ( NOT (mask^(%BPVAL - %NBITSU (MASK))))
        ! %NBITSU (mask) - (%NBITSU (mask AND - mask) - 1)

        (%NBITSU (mask) - field_position (mask)) % ,

    position_field

        ! Given a value and a mask, put the value in that position within the
        ! word (and restrict its size).

        (
        mask,                           ! Mask
        val                             ! Value
        ) =

        ((val^field_position(mask)) AND mask) %;


! Define condition value stuff.  The condition value is really a BLISS concept
! on TOPS, so it isn't defined in any of the system interface files.  (These
! are also defined in STAR36 in DIL).

LITERAL

    ! Severity codes: These are used to fill in the severity field, the low 3
    ! bits of a condition.

    sts$k_warning = 0,
    sts$k_success = 1,
    sts$k_error = 2,
    sts$k_info = 3,
    sts$k_severe = 4,

    ! Fields of a condition value: These are defined as masks, and then as
    ! macros.

    sts$m_severity = make_mask(0, 3),   ! Position, field width
    sts$m_success = make_mask(0, 1),
    sts$m_cond_id = make_mask(3, 29),
    sts$m_msg_no = make_mask(3, 15),
    sts$m_fac_sp = make_mask(17, 1),
    sts$m_code = make_mask(3, 14),
    sts$m_fac_no = make_mask(18, 14),
    sts$m_cust_def = make_mask(31, 1);


! These are the actual field names for the condition value fields:

MACRO
    sts$v_severity = 0, field_position (sts$m_severity), field_length (sts$m_severity), 0 % ,
    sts$v_success = 0, field_position (sts$m_success), field_length (sts$m_success), 0 % ,
    sts$v_cond_id = 0, field_position (sts$m_cond_id), field_length (sts$m_cond_id), 0 % ,
    sts$v_msg_no = 0, field_position (sts$m_msg_no), field_length (sts$m_msg_no), 0 % ,
    sts$v_fac_sp = 0, field_position (sts$m_fac_sp), field_length (sts$m_fac_sp), 0 % ,
    sts$v_code = 0, field_position (sts$m_code), field_length (sts$m_code), 0 % ,
    sts$v_fac_no = 0, field_position (sts$m_fac_no), field_length (sts$m_fac_no), 0 % ,
    sts$v_cust_def = 0, field_position (sts$m_cust_def), field_length (sts$m_cust_def), 0 %;


! This is a standard code that must be defined somewhere...

LITERAL ss$_normal = 1;

MACRO
    blf$comma =                         ! Hack to format $OVERLAY right
    %;
%SBTTL 'Misc declarations'
!++
! These assorted declarations go here so that they can be referred to
! later in the file.  A few more miscellaneous declarations
! (system-dependent) are put in the require file >DIXREQ.REQ>.  They
! are there only when BLISS or system restrictions force that for one
! system or another.
!--

LITERAL
       ! This is the number of bits required to represent the maximum bit
       ! offset within an addressable unit on the current host system.  It
       ! is used for optimizing structure declarations on each system.
       unit_offset_size = %BLISS36 (6);

!  Integer codes for the various types of systems which DIX must know about:

$literal
    sys_lcg = $distinct,                ! 36-bit addressable systems
    sys_8bit = $distinct,               ! 8-bit addressable systems
    sys_ult = $distinct;                ! for hackery

LITERAL
    sys_max = sys_ult - 1;              ! max sys code assigned
%SBTTL 'Foreign Field Descriptor (FFD)'

!++
!   The Foreign Field Descriptor (FFD)
!
! This structure is the descriptor used to describe a foreign field anywhere
! within the DIX package.
!
! A single occurrence of an FFD points to and identifies a (foreign or local)
! field somewhere in local memory.  This is the structure used to identify a
! field to the conversion routines (below the user interface level).
!
! A data type code has two parts: a data class code, and a within-class type
! code.  The classes are as described in the functional specification: string,
! fixed binary, floating point, boolean, complex, display-numeric, packed
! decimal, etc.  The sizes of the fields are controlled by the following
! parameters:
!
!--

LITERAL
    class_code_bits = 4,                ! Size of data class code
    type_code_bits = 8;                 ! Size of within-class type code


!  Here are the field definitions for the FFD:

MACRO ffd_flds (prefx) =                ! This macro is added for DIU.  It will
                                        ! make the transform structure easier
                                        ! to keep compatible with DIL.

      %NAME (prefx, '$v_unit') = [$address],    ! Adr of lowest unit containing
                                                ! some bit of the field
      %NAME (prefx, '$v_length') = [$bits(16)], ! Field len in "natural" units
                                                ! (listed explicitly with data
                                                ! type definitions)
      %NAME (prefx, '$v_scale') = [$short_integer],     ! Scale factor for
                                        ! fixed-point decimal-based data types
                                        
      %NAME (prefx, '$v_offset') = [$bits (unit_offset_size)],	! Bit offset
					! within addressable unit to low-order
					! bit of field
      %NAME (prefx, '$v_type') = [$bits (class_code_bits        ! Data type
                                         + type_code_bits)],    !  codes
      $overlay (%NAME (prefx, '$v_type')) blf$comma
      %NAME (prefx, '$v_dt_type') = [$bits (type_code_bits)],	! Type subfield
      %NAME (prefx, '$v_dt_class') = [$bits (class_code_bits)],	! Class subfld
      $continue
      %NAME (prefx, '$v_align') = [$bits (6)],	! Bit offset within original
                                                ! system addressable unit to
                                                ! low-order bit of field
      %NAME (prefx, '$v_sys_orig') = [$bits (2)]        ! system of origin code
      %;

$field
    ffd_fields =
        SET
        ffd_flds ('ffd')
        TES;

LITERAL
    ffd$k_size = $field_set_size;

! To declare a data segment to be of type FFD, use the forgn_descr macro in
! place of the structure and field attributes in the data declaration.  It
! works with both immediate and REF structures.

MACRO
    forgn_descr =
	BLOCK [ffd$k_size]
	FIELD
	(ffd_fields) %;

! Data type codes are sometimes accessed outside of an FFD.  These definitions
! give you access to the fields from a fullword value.

FIELD
    dt_fields =
        SET
        dt_class_sep =                  ! Data class code only
                 [0, type_code_bits, %BPVAL - type_code_bits, 0],
                                        ! Make sure def looks at whole word,
                                        ! or garbage may sneak through
        dt_code_sep =                   ! With-in class type code only
                [0, 0, type_code_bits, 0]
        TES;

MACRO
    data_type_sep = BLOCK [1] FIELD (dt_fields) % ;
%SBTTL 'Condition handling and status values'

!++
! Define general condition handling and status value structures and literals.
! We use the VAX-based status-value (condition-value) concept described in the
! BLISS language manual chapter on condition handling.  STS is the standard
! naming-prefix for the status-code facility.
!--

!++
! This macro (DIX$FACILITY_NAME) expands to the facility prefix for the DIX.
! This is used within macros that construct names from their parameters.
!--

MACRO
    DIX$facility_name =
	'DIX' %;

LITERAL

    dix$k_facility = 232;		! This is the formally registered DIX
                                        ! facility code.

! To declare a data segment to be of type CONDITION_VALUE, use the macro
! CONDITION_VALUE instead of the structure and field attributes in the data
! declaration.

MACRO
    condition_value =
	BLOCK [1]

! STARLET avoids the need to declare these fields, so we have to follow suit.
!	FIELD
!            (
!            sts$v_severity,
!            sts$v_success,
!            sts$v_cond_id,
!            sts$v_msg_no,
!            sts$v_fac_sp,
!            sts$v_code,
!            sts$v_fac_no,
!            sts$v_cust_def
!            )
    % ;

    ! The keyword macro sts$value generates a numeric condition value in the
    ! format suitable for the system on which it was compiled.  The keywords
    ! and defaults are as follows:
    
    KEYWORDMACRO
        sts$value (
    	    severity = sts$k_severe,
    	    CODE,
    	    fac_sp = 1,			! Default is facility specific
    	    fac_no = 0,			! Customer use desires this default
    	    cust_def = 0 		! Default is Digital defined
    	    ) =
    	(
        position_field (sts$m_severity, severity) OR
        position_field (sts$m_CODE, CODE) OR
        position_field (sts$m_fac_sp, fac_sp) OR
        position_field (sts$m_fac_no, fac_no) OR
        position_field (sts$m_cust_def, cust_def) 
	)
    %;
%SBTTL 'Define conditions used by the DIX'

!++
!
! All the conditions used by the DIX are defined here.
! 
! Each definition results in a literal of the form DIX$_name whose value is the
! condition with the default severity.  The message numbers are assigned
! sequentially using the compiletime variable cnd_seq.
! 
! The macro DIX$DEF_CONS is also defined.  When expanded, it generates calls to
! a user-defined macro COND_DAT, passing the full condition name as a string
! literal ('DIX$_name'), the FORTRAN pseudonym (6 chars) as a string literal,
! the condition value as a numeric literal, and the text of the standard
! message as a string literal.
!
! To make a list of condition names and messages, for example, you would do the
! following: Write a program that searched this library.  Define COND_DAT to
! build the data structures you want containing selected condition information.
! Then call DIX$DEF_CONS.  You now have your data structures containing
! everything you wanted to print.  It should be a simple problem to print it
! out.
!--

COMPILETIME
    cnd_seq = 0;

MACRO
    DIX$def_con (cond_nam, fort_pseud, default_severity, msg_txt) =

	%QUOTE %EXPAND %ASSIGN (cnd_seq, cnd_seq + 1)
        %QUOTE %EXPAND %PRINT
            (                           ! Begin %PRINT actuals
            cond_nam,                   ! %PRINT actual
            '  code is ',               ! %PRINT actual
            %QUOTE %EXPAND %NUMBER (cnd_seq)    ! %PRINT actual
            )                           ! End %PRINT actuals
	cond_dat
            (                           ! Begin cond_dat actuals
            %QUOTE %EXPAND %NAME        ! cond_dat actual
                (                       ! Begin %NAME actuals
                %QUOTE %EXPAND DIX$facility_name, 	! %NAME actual
                '$_',                   ! %NAME actual
                cond_nam                ! %NAME actual
                ),                      ! End %NAME actuals
            fort_pseud,                 ! cond_dat actual
            %QUOTE %EXPAND sts$value	! cond_dat actual
                (                       ! Begin sts$value actuals
                fac_no = DIX$k_facility, 	! sts$value actual
                CODE = %QUOTE %EXPAND %NUMBER(cnd_seq), ! sts$value actual
                severity = (default_severity)	! sts$value actual
                ),                      ! End sts$value actuals
            msg_txt                     ! cond_dat actual
	)				! End cond_dat actuals
    %,					! end DIX$def_con definition

    !++
    ! Definitions of new conditions should be put into the macro definition in
    ! a manner consistent with the existing entries:
    !      %EXPAND DIX$def_con ('name', 'fortpseud',  default-severity,
    !                           'message text')
    ! In particular, note the absence of commas and semicolons at the end of
    ! the macro call to DIX$def_con.
    !
    ! The "%EXPAND" is necessary to cause the generation of message codes to
    ! occur at library compile time.  It is necessary that literal values be
    ! contained in the defined DIX$def_cons so that all calls to it are
    ! guaranteed of getting the same values.
    !--

    DIX$def_cons =
	%EXPAND DIX$def_con('rounded', 'rnded', sts$k_info,
            'Result is rounded')
        %EXPAND DIX$def_con ('toobig', 'toobig', sts$k_severe,
            'Converted source field too large for destination field')
        %EXPAND DIX$def_con ('invdattyp', 'dattyp', sts$k_severe,
            'Invalid data type code')
        %EXPAND DIX$def_con ('unkargtyp', 'argtyp', sts$k_severe,
            'Argument passed by descriptor is unknown type')
        %EXPAND DIX$def_con ('unksys', 'unksys', sts$k_severe,
            'Unknown system of origin specified')
        %EXPAND DIX$def_con ('invlng', 'invlng', sts$k_severe,
            'Length invalid or unspecified')
        %EXPAND DIX$def_con ('invscal', 'invscl', sts$k_severe,
            'Scale factor invalid or unspecified') 
        %EXPAND DIX$def_con ('graphic', 'graphc', sts$k_warning, 
            'Graphic character changed in conversion')
        %EXPAND DIX$def_con ('fmtlost', 'fmtlst', sts$k_warning,
            'Format effector gained or lost in conversion')
        %EXPAND DIX$def_con ('nonprint', 'nonprn', sts$k_warning,
            'Non-printing character gained or lost in conversion')
        %EXPAND DIX$def_con ('trunc', 'trunc', sts$k_info,
            'String too long for destination -- truncated')
        %EXPAND DIX$def_con ('unimp', 'unimp', sts$k_severe,
            'Unimplemented conversion')
        %EXPAND DIX$def_con ('invalchar', 'invchr', sts$k_error,
            'Invalid character in source field or conversion table')
        %EXPAND DIX$def_con ('align', 'align', sts$k_severe,
            'Invalid alignment for data type')
        %EXPAND DIX$def_con ('unnorm', 'unnorm', sts$k_severe,
            'Floating point number improperly normalized')
        %EXPAND DIX$def_con ('impossible', 'imposs', sts$k_severe,
            'Severe internal error')    ! [%O'26'] 
        %EXPAND DIX$def_con ('unsigned', 'unsign', sts$k_error,
            'Negative value moved to unsigned field')
	%EXPAND dix$def_con ('invbytsiz', 'bytsiz', sts$k_severe,
	    'Invalid byte size specified')
	%EXPAND dix$def_con ('invdnumchr','dnmchr',sts$k_severe,
	    'Invalid source display numeric character')
	%EXPAND dix$def_con ('invdnumsgn','dnmsgn',sts$k_severe,
	    'Invalid source display numeric sign character')
        %EXPAND dix$def_con ('invpddgt', 'pddgt', sts$k_severe,
            'Invalid source packed decimal digit')
        %EXPAND dix$def_con ('invpdsgn', 'pdsgn', sts$k_severe,
            'Invalid source packed decimal sign')
    %,                                  ! End DIX$def_cons definition

    !++
    ! Now that DIX$def_cons is defined, we can construct the literals for the
    ! status codes by creating a local definition of cond_dat (which is
    ! undeclared after use) and expanding DIX$def_cons.
    !--
    cond_dat (cond_nam, fort_pseud, cond_value, cond_msg_txt) =
	cond_nam %BLISS36 ( = cond_value) , %;

LITERAL                                 ! Expand above cond_dat for each
       dix$def_cons                     ! dix$def_con call above, thus defining
       dix$$foo = 0;                    ! literals for all conditions

LITERAL
    max_condition = %NUMBER (cnd_seq),
    dix_max_cond = %NUMBER (cnd_seq);

UNDECLARE
    cnd_seq,
    dix$$foo,
    %QUOTE cond_dat,
    %QUOTE dix$def_con;
%SBTTL 'Macros for data type declarations'

!++
! All the information about each data type will be embedded in a macro
! declaration below.
! 
! A macro called dt_class_`class name`_def will be defined for each class
! which, when expanded, calls the locally-defined macro decl_`class name`_item
! once for each data item in the class, passing all the information provided in
! the initial definition.
! 
! This approach centralizes all the data type characteristics in a single
! place, making them easy to change and to find.
! 
! There are some special macros used here to set up the macros described above.
! First, an example:
!
!   COMPILETIME
!       dt_class = 0,
!       dt_code = 0;
!
!   declare_class (class_name);
!   %EXPAND data_type (type_name, short_name);
!   .
!   .
!   .
!   %EXPAND end_class;
!   declare_class (class_name);
!   %EXPAND data_type (type_name, short_name);
!   .
!   .
!   .
!   %EXPAND end_class;
!   .
!   .
!   .
!
! This produces the following literal declarations:
!   DT_class            Class number for each class
!   DT_CLASS_class_MAX  Max data type code assigned in that class
!                       (min is always 1)
!   DIX$K_MAX_CLASS     Highest class code assigned
!
! It also declares the macro DT_CLASS_class_DEF, described below.
!
! Then, when you want to build a table (or whatever) based on the
! information you gave for each data type:
!
!   MACRO
!       DECL_class_name_ITEM (class_code, item_name, short_name, type_code, 
!         user_specified ...) =
!         Appropriate_code; %;
!
!   DT_CLASS_class_name_DEF;
!--

MACRO
    !++
    ! Call the declare_class macro at the start of the list of items for each
    ! class:
    !
    ! The MACRO declare_class basically does the following:
    !  1) Define the MACRO current_class (which is undeclared
    !     in the MACRO end_class.
    !  2) %ASSIGN dt_code = 0.
    !  3) %ASSIGN dt_class = dt_class + 1.
    !  4) Define the LITERAL dt_<class_name> = dt_class.
    !  5) Define the MACRO dt_class_<class_name>_def.  This is a little
    !     unusual because the definition is left open-ended.  The MACRO
    !     declare_class is defined such that it expands to the following
    !     definition of dt_class_<class_name>_def ==>
    ! 
    !            MACRO %NAME ('dt_class', class_name, '_def') =
    !                  %,             ! End declare_class
    !    This means that when declare_class is invoked, the call must be
    !    followed by the code that the user wishes to be the body of the
    !    MACRO dt_class_<class_name>_def.
    ! 
    !--

    declare_class (class_name) =

	MACRO
	    current_class =
		class_name %QUOTE %;

	%ASSIGN (dt_code, 0)		! Initialize type code
	%ASSIGN (dt_class, dt_class + 1)

	LITERAL
	    %NAME ('dt_', class_name) = %NUMBER (dt_class);

	!
	! At compile time, prints the number assigned to this class.
	!
	%PRINT (%NAME ('dt_', class_name), '=', %NUMBER (%NAME ('dt_', class_name)))

        ! Define the name of the MACRO whose body directly follows the call to
        ! declare_class (class_name).  The name is built using the parameter
        ! "class_name" and is the following: dt_class_<class_name>_def.  NOTE:
        ! The body of this MACRO does not appear here, but rather appears in
        ! the code directly after the call to declare_class.

	MACRO
	    %NAME ('dt_class_', class_name, '_def') =
    %,                                  ! End declare_class

    !++
    ! The data_type macro is used to declare a specific data type within a
    ! class declaration.  It assigns the within-class type code from
    ! compiletime variable dt_code, which is incremented.
    !--

    data_type (item_name, short_name) =
        %QUOTE %EXPAND %ASSIGN (dt_code, dt_code + 1)

        !++
        ! Expansion calls macro decl_<class name>_item (which the user must
        ! define) to do whatever is wanted for each item in the class.
        !--

        %QUOTE %EXPAND %NAME ('decl_', current_class, '_item')	! Name of macro to invoke
            (                           ! MACRO-actuals enclosed
            %QUOTE %EXPAND %NAME ('dt_', current_class),        ! MACRO actual
            item_name,                  ! Macro actual
            short_name,                 ! Macro actual
            %QUOTE %EXPAND %NUMBER(dt_code),    ! Macro actual
            %QUOTE %EXPAND %REMAINING   ! Macro actual
            )                           ! End of MACRO-actuals

        ! At compile-time, data_type prints the within-class code assigned to
        ! each data type.

        %QUOTE %EXPAND %PRINT
            (                           ! %PRINT actuals enclosed
            item_name,                  ! %PRINT actual
            ' type code=',              ! %PRINT actual
            %QUOTE %EXPAND %NUMBER(dt_code)     ! %PRINT actual
            )                           ! End %PRINT actuals
    %,                                  ! End data_type definition

    !++
    ! The macro end_class handles termination of the declarations for a class
    ! of data items.
    !--
    end_class =
	%QUOTE %;

	LITERAL                         ! The literal dt_class_<name>_max is
                                        ! defined as the max code in the class
            %QUOTE %EXPAND %NAME
                (                       ! %NAME actuals enclosed
                'dt_class_',            ! %NAME actual
                current_class,          ! %NAME actual
                '_max'                  ! %NAME actual
                )                       ! End %NAME actuals
	    =
            %QUOTE %EXPAND %NUMBER (dt_code);

        ! At compile-time, print the max code in the class from the literal
        ! just defined.

	%QUOTE %EXPAND %PRINT (		! Begin actuals to %PRINT
            %QUOTE %EXPAND %NAME        ! Actual to %PRINT
                (                       ! Begin actuals to %NAME
                'dt_class_',            ! Actual to %NAME
                current_class,          ! Actual to %NAME
                '_max'                  ! Actual to %NAME
                ),                      ! End actuals to %NAME
            '=',                        ! Actual to %PRINT
            %QUOTE %EXPAND %NUMBER      ! Actual to %PRINT
                (                       ! Begin actuals to %NUMBER
                %QUOTE %EXPAND %NAME    ! Actual to %NUMBER
                    (                   ! Begin actuals to %NAME
                    'dt_class_',        ! Actual to %NAME
                    current_class,      ! Actual to %NAME
                    '_max'              ! Actual to %NAME
                    )                   ! End of actuals to %NAME
                )                       ! End of actuals to %NUMBER
           )				! End of actuals to %PRINT
        UNDECLARE                       ! Get rid of one-shot variables
            %QUOTE %QUOTE current_class;
    %;                                  ! End definition of end_class
%SBTTL 'Data type definitions'

!++
! The characteristics of all data types in all classes will be defined here.
! The resulting information will be stored mostly as macro definitions
! (described above) and will be expanded into tables as necessary in the
! general and type-specific conversion modules.
!--

COMPILETIME
    dt_class = 0,
    dt_code = 0;
%sbttl 'Class String data type definitions'
!++
! Information to be provided for each data type:
!   o  Name as quoted string
!   o  Short name as quoted string
!   o  Byte size
!   o  System of origin
!   o  Length indicating technique (value indicating whether a length must be
!      given or if a null length is expected)
!   o  Name of character set as quoted string.  Since the build_cst macro
!      (defined and used in DIXSTR) names everything consistently based on the
!      character set name, this is all that is needed to find everything.
!   o  Fill character to use (numeric)
!   o  Character to substitute if no matching char in set (numeric)
!--

$literal                                ! Names for methods of
    std$k_lng_spec = $distinct,         !  indicating length
    std$k_lng_nul = $distinct,
    std$k_lng_ult = $distinct;

LITERAL
    std$k_max_lng_indic = %NUMBER (std$k_lng_ult) - 1;

UNDECLARE std$k_lng_ult;

declare_class ('string')                ! call declare_class

! The code following the call to declare_class is actually the body of the
! MACRO dt_class_string_def.

%EXPAND
data_type ('ASCII_7', 'ASCII7', 7, sys_lcg, std$k_lng_spec, 'ascii', 32, 92)
%EXPAND
data_type ('ASCII_8', 'ASCII8', 8, sys_8bit, std$k_lng_spec, 'ascii', 32, 92)
%EXPAND
data_type ('ASCIZ', 'ASCIZ', 7, sys_lcg, std$k_lng_nul, 'ascii', 0, 92)
%EXPAND
data_type ('EBCDIC_8', 'EBCDC8', 8, sys_8bit, std$k_lng_spec, 'ebcdic', 64, 224)
%EXPAND
data_type ('EBCDIC_9', 'EBCDC9', 9, sys_lcg, std$k_lng_spec, 'ebcdic', 64, 224)
%EXPAND
data_type ('SIXBIT', 'SIXBIT', 6, sys_lcg, std$k_lng_spec, 'sixbit', 0, 60)
!
%EXPAND
end_class
%SBTTL 'String data table (STD)'

! Format for the alphanumeric string data table.  This table is indexed by data
! subtype (within its class).

$field
    std_fields =
	SET
	std$v_byt_siz = [$bits (6)],	! Byte size of string
	std$v_sys_orig = [$bits (3)],	! Code for system of origin
	std$v_lng_indic = [$bits (2)]	! Length indication (see std$k_lng_xxx
                                        !     defined above)
	TES;

LITERAL
    std$k_size = $field_set_size;

! To declare a data segment to be of type std, use the macro dtt_st in place of
! the structure and field attributes in the data item declaration.

MACRO
    dtt_st = BLOCKVECTOR [dt_class_string_max + 1, std$k_size]
             FIELD (std_fields) %;
%sbttl 'Class fixed binary data type definitions'

!++
! Information to be provided for each data type:
!   o  Name as quoted string
!   o  Short name as quoted string
!   o  Fixed or variable length (use literals)
!   o  Signed or unsigned (use literals)
!   o  Minimum length if variable (unsigned) (zero if not variable)
!   o  Maximum length if variable (unsigned)
!   o  Minimum scale factor (signed)
!   o  Maximum scale factor (signed)
!   o  Program for BPM/BIM
!--

! Literals for specifying above parameters:

LITERAL
    fbd$k_lng_fixed = 1,                ! Type is fixed-length
    fbd$k_lng_variable = 2,             ! Type is variable-length
    fbd$k_signed = 3,                   ! Type is signed
    fbd$k_unsigned = 4;                 ! Type is unsigned


! Define the pseudo-machine to run (in different directions) in the routines
! that convert FB to CB and vs.
!
! Each pseudo-instruction has an op code and two signed integer (small)
! operands.  The structure to represent a single instruction is defined as a
! block with the following fields:

$field
    bpm_fields =
        SET
        bpm$v_opcode = [$byte],         ! Op code is $byte for VAX alignment
        bpm$v_op_1 = [$tiny_integer],   ! Must be signed, at least +/- 128
        bpm$v_op_2 = [$tiny_integer]    ! Must be signed, at least +/- 128
        TES;

LITERAL
    bpm$k_size = $field_set_size,
    bpm$b_opcode = 0,                           ! OFFSET
    bpm$s_opcode = %BLISS36 (9) %BLISS32 (8),   ! Size of field
    bpm$b_op_1 =  %BLISS36 (9) %BLISS32 (8),    ! These fields depend on the
    bpm$s_op_1 =  %BLISS36 (9) %BLISS32 (8),    !   way XPORT processes the
    bpm$b_op_2 = %BLISS36 (18) %BLISS32 (16),   !   definitions above!!!
    bpm$s_op_2 =  %BLISS36 (9) %BLISS32 (8);    !   Watch out!!!

!   The op-codes for the pseudo-machine are as follows:

$LITERAL
    bpm$k_op_move = $distinct,          ! Move contiguous bits
    bpm$k_op_move_var = $distinct,      ! Move contiguous bits with variable length
    bpm$k_op_sign = $distinct,          ! Process sign
    bpm$k_op_sign_var = $distinct,      ! Process sign in variable length
    bpm$k_op_done = $distinct;          ! Do cleanup and terminate.
                                        !   Must be last in list!!

LITERAL
    bpm$k_op_max = bpm$k_op_done - 1;


!   Macros to build pseudo-machine instructions are defined here.

MACRO
    bpm_any                             ! Builds any pseudo-machine instr.
        (
        op_code,                        ! opcode for instruction
        op_1,                           ! signed value for first op
        op_2                            ! signed value for second op
        ) =
        op_code OR
            (op_1 AND (1^bpm$s_op_1 - 1))^bpm$b_op_1 OR
            (op_2 AND (1^bpm$s_op_2 - 1))^bpm$b_op_2 %,

    bpm_move                            ! Builds the pseudo-machine instruction
                                        ! to move contiguous bits between FB
                                        ! and CB fields.
        (
        Offset,                         ! from LO bit of FB
        length                          ! number of bits to move
        ) =
        bpm_any (bpm$k_op_move, offset, length) %,

    bpm_move_var                        ! builds the pseudo-machine instruction
                                        ! to move continuous bits between FB
                                        ! and CB variable length fields.
        (
        Offset,                         ! from LO bit of FB
        length                          ! number of bits to move - length
        ) =
        bpm_any (bpm$k_op_move_var, offset, length) %,

    bpm_sign                            ! builds pseudo-machine instr to move
                                        ! sign information between FB & CB flds
        (
        Offset                          ! from LO bit of FB
        ) =
        bpm_any (bpm$k_op_sign, offset, 0) %,

    bpm_sign_var                        ! builds pseudo-mach instr to move sign
                                        ! info between FB & CB var len fields
        (
        Offset                          ! from LO bit of FB - length
        ) =
        bpm_any (bpm$k_op_sign_var, offset, 0) %,

    bpm_done                            ! builds the pseudo-machine instruction
                                        ! to terminate a pseudo-program.
        =
        bpm_any (bpm$k_op_done, 0, 0) %;

! And now, the fixed binary data type class definitions.

declare_class ('fbin')                  ! call declare_class
!
! The code following the call to declare_class is actually the body of the
! MACRO dt_class_fbin_def.
!
%EXPAND data_type ('SBF128', 'SBF128', fbd$k_lng_fixed, fbd$k_signed,0,0,0,0,
    (bpm_move (0, 127), bpm_sign (127), bpm_done), 128, 127)
%EXPAND data_type ('SBF16', 'SBF16', fbd$k_lng_fixed, fbd$k_signed,0,0,-18,18,
    (bpm_move (0, 15), bpm_sign (15), bpm_done), 16, 15)
%EXPAND data_type ('SBF32', 'SBF32', fbd$k_lng_fixed, fbd$k_signed,0,0,-18,18,
    (bpm_move (0, 31), bpm_sign (31), bpm_done), 32, 31)
%EXPAND data_type ('SBF36', 'SBF36', fbd$k_lng_fixed, fbd$k_signed,0,0,-18,18,
    (bpm_move (0, 35), bpm_sign (35), bpm_done), 36, 35)
%EXPAND data_type ('SBF48', 'SBF48', fbd$k_lng_fixed, fbd$k_signed,0,0,0,0,
    (bpm_move (0, 47), bpm_sign (47), bpm_done), 48, 47)
%EXPAND data_type ('SBF64', 'SBF64', fbd$k_lng_fixed, fbd$k_signed,0,0,-18,18,
    (bpm_move (0, 63), bpm_sign (63), bpm_done), 64, 63)
%EXPAND data_type ('SBF72', 'SBF72', fbd$k_lng_fixed, fbd$k_signed,0,0,-18,18,
    (bpm_move (0, 35), bpm_move (-36, 35), bpm_sign (-1), bpm_done), 72, 70)
%EXPAND data_type ('SBF8', 'SBF8', fbd$k_lng_fixed, fbd$k_signed,0,0,0,0,
    (bpm_move (0, 7), bpm_sign (7), bpm_done), 8, 7)
%EXPAND data_type ('SBFVAR', 'SBFVAR', fbd$k_lng_variable, fbd$k_signed,0,36,0,0,
    (bpm_move_var (0, -1), bpm_sign_var (-1), bpm_done), 0, 0)
%EXPAND data_type ('UBF16', 'UBF16', fbd$k_lng_fixed, fbd$k_unsigned,0,0,0,0,
    (bpm_move (0, 16), bpm_done), 16, 16)
%EXPAND data_type ('UBF32', 'UBF32', fbd$k_lng_fixed, fbd$k_unsigned,0,0,0,0,
    (bpm_move (0, 32), bpm_done), 32, 32)
%EXPAND data_type ('UBF8', 'UBF8', fbd$k_lng_fixed, fbd$k_unsigned,0,0,0,0,
    (bpm_move (0, 8), bpm_done), 8, 8)
%EXPAND data_type ('UBFVAR', 'UBFVAR', fbd$k_lng_variable, fbd$k_unsigned,0,36,0,0,
    (bpm_move_var (0, 0), bpm_done), 0, 0)

! UBF128 is new for DIL V2.1

%EXPAND data_type ('UBF128', 'UBF128', fbd$k_lng_fixed, fbd$k_unsigned,0,0,-18,18,
    (bpm_move (0, 128), bpm_done), 128, 128)

! UBF36 is new for DIL V2.1

%EXPAND data_type ('UBF36', 'UBF36', fbd$k_lng_fixed, fbd$k_unsigned,0,0,-18,18,
    (bpm_move (0, 36), bpm_done), 36, 36)

! UBF64 is new for DIL V2.1

%EXPAND data_type ('UBF64', 'UBF64', fbd$k_lng_fixed, fbd$k_unsigned,0,0,-18,18,
    (bpm_move (0, 64), bpm_done), 64, 64)

! UBF72 is new for DIL V2.1

%EXPAND data_type ('UBF72', 'UBF72', fbd$k_lng_fixed, fbd$k_unsigned,0,0,-18,18,
    (bpm_move (0, 36), bpm_move (-36, 36), bpm_done), 72, 72)

%EXPAND end_class
%SBTTL 'Fixed Binary data table (FBD)'

! Format for the fixed binary data table.  This table is indexed by data
! subtype (within class).

 $field
   fbd_fields =
        SET
        fbd$v_bpm_program = [$address], ! Address of BPM program
        ! These two bits occupy HO part of word on 36-bit system:
        fbd$v_signed = [$bit],          ! Bit set if field is signed
        fbd$v_variable = [$bit],        ! Bit set if field length variable
            $align (byte)               ! Align remaining fields
        fbd$v_min_lng = [$byte],        ! Minimum length (unsigned field)
        fbd$v_max_lng = [$byte],        ! Maximum length (unsigned)
        fbd$v_min_scale = [$tiny_integer],      ! Signed minimum scale
        fbd$v_max_scale = [$tiny_integer],      ! Signed maximum scale
        fbd$v_siz = [$byte],            ! fld size in bits (necessary for DIU)
        fbd$v_signif_bits = [$byte]     ! for unsigned integers = # of bits used,
                                        ! for signed integers = # of significant bits (necessary for DIU)

        TES;

LITERAL
    fbd$k_size = $field_set_size;

MACRO
    dtt_fbin

    ! declares an item to have the right structure and field attributes for the
    ! fixed binary data table.

        = BLOCKVECTOR [dt_class_fbin_max + 1, fbd$k_size] FIELD (fbd_fields) %;
%SBTTL 'Class floating point data type definitions'

!++
! Class floating point
!
!   Information to be provided for each data type:
!
!   o  Name as quoted string
!   o  Short name as quoted string
!   o  Representation (use literals)
!   o  Exponent offset
!   o  Number of significant bits in mantissa (including hidden high-order
!      bit if there is one)
!   o  Program for FPM/FIM
!
!--

$LITERAL                                ! literals for specfying above:
    fpd$k_lcg = $distinct,              ! Number is in LCG representation
    fpd$k_vax = $distinct,              ! Number is in VAX/PDP-11 representation
    fpd$k_rep_ult = $distinct;

LITERAL
    fpd$k_rep_max = fpd$k_rep_ult - 1;  ! Max representation value

UNDECLARE
    fpd$k_rep_ult;

! Literals for complex/simple floating point types

$LITERAL fpd$k_complex = $DISTINCT,
         fpd$k_simple = $DISTINCT,
         fpd$k_typ_ult = $DISTINCT;

LITERAL fpd$k_typ_max = fpd$k_typ_ult - 1;

UNDECLARE fpd$k_typ_ult;

!++
! Define the pseudo-machine used to convert FP to CF and VS (the programs are
! also run to convert CF to FP; of course the interpretation of the
! instructions changes).
!
! Each instruction has an op code and two signed small integer operands.  The
! structure to represent a single instruction is defined as a block with the
! following fields:
!--

$field
    fpm_fields =
        SET
        fpm$v_opcode = [$byte],         ! Op code is large for alignment on vax
        fpm$v_op_1 = [$tiny_integer],   ! Must be signed, +/- 128
        fpm$v_op_2 = [$tiny_integer]    ! Must be signed, +/- 128
        TES;

LITERAL
    fpm$k_size = $field_set_size,

! Create names for bit positions of above fields.  These definitions depend on
! how XPORT processes the above stuff, so be extremely careful whem mucking
! about with either one!!!

    fpm$b_opcode = 0,                   ! Offset
    fpm$s_opcode = %BLISS36 (9) %BLISS32 (8),   ! Size of field
    fpm$b_op_1 =  %BLISS36 (9) %BLISS32 (8),    
    fpm$s_op_1 =  %BLISS36 (9) %BLISS32 (8),    
    fpm$b_op_2 = %BLISS36 (18) %BLISS32 (16),   
    fpm$s_op_2 =  %BLISS36 (9) %BLISS32 (8);    


! Op-codes for the FPM:

$LITERAL
    fpm$k_op_sign = $distinct,          ! Set sign to pos or neg
    fpm$k_op_exp = $distinct,           ! Move exponent bits
    fpm$k_op_mant = $distinct,          ! Move mantissa bits
    fpm$k_op_mant1 = $distinct,         ! Create hidden leading mantissa bit
    fpm$k_op_done = $distinct;          ! Do cleanup and terminate.
                                        !   "DONE" must be last!!!

! Macros to build pseudo-machine instructions:

MACRO
    fpm_any                             ! builds any pseudo-machine instruction
        (
        op_code,                        ! opcode for instruction
        op_1,                           ! signed value for first op
        op_2                            ! signed value for second op
        ) =
        op_code OR
            (op_1 AND (1^fpm$s_op_1 - 1))^fpm$b_op_1 OR
            (op_2 AND (1^fpm$s_op_2 - 1))^fpm$b_op_2 %,

    fpm_sign                            ! Builds pseudo-machine instruction to
                                        ! set the CF sign to pos or neg (zero
                                        ! is handled in the done routine).
        (
        offset                          ! Offset from low order bit of FP
        ) =

    fpm_any (fpm$k_op_sign, offset, 0) %,

    fpm_exp                             ! Builds the pseudo-machine instruction
                                        ! to move exponent bits.

        ! Exponent bits are moved from low order to high order.  No sign
        ! extension is done -- this must be handled by the done routine.  This
        ! instruction may only be called once -- segmented exponents are not
        ! supported.  Exponents larger than a fullword are not supported.

        (
        offset,                         ! Offset from low order bit of FP
        length                          ! Number of bits to move
        ) =

    fpm_any (fpm$k_op_exp, offset, length) %,

    fpm_mant                            ! builds the psedo-machine instruction
                                        ! to move mantissa bits.

        ! Mantissa bits are moved from high order to low order.  Therefore the
        ! offset specified is to the highest-order bit to be moved.  This
        ! instruction may be used several times to move non-contiguous mantissa
        ! fields.

        (
        offset,                         ! Offset from LO bit of FP
                                        !  to HO bit to move.
        length                          ! Number of bits to move
                                        ! lower-order bits).
        ) =

    fpm_any (fpm$k_op_mant, offset, length) %,

    fpm_mant1                           ! Builds instr for creating the leading
                                        ! mantissa bit, which isn't represented
                                        ! in some implementations.
    =
    fpm_any (fpm$k_op_mant1, 0, 0) %,

    fpm_done                            ! Builds the done instruction.

    ! This terminates processing of the pseudo-program and executes the
    !  final cleanup routine.  The final cleanup routine transforms the
    ! broken-down bit fields made by the simple moves of the other instructions
    ! into the true canonical form.

    =
    fpm_any (fpm$k_op_done, 0, 0) %;


! And now, the floating point data type class definitions:

declare_class ('fp')                    ! call declare_class
!
! The code following the call to declare_class is actually the body of the
! MACRO dt_class_fp_def.
!
%EXPAND data_type ('D_FLOAT', 'DFLOAT', fpd$k_vax, 128, 56,
    (fpm_sign (15), fpm_exp (7, 8), fpm_mant1, fpm_mant (6, 7), 
    fpm_mant (31, 16), fpm_mant (47, 16), fpm_mant (63, 16), fpm_done ), 64,
    fpd$k_simple)
%EXPAND data_type ('F_FLOAT', 'FFLOAT', fpd$k_vax, 128, 24,
    (fpm_sign (15), fpm_exp (7, 8), fpm_mant1, fpm_mant (6, 7), 
    fpm_mant (31, 16), fpm_done ), 32, fpd$k_simple)
%EXPAND data_type ('FLOAT_36', 'FLOT36', fpd$k_lcg, 128, 27,
    (fpm_sign (35), fpm_exp (27, 8), fpm_mant (26, 27), fpm_done ), 36,
    fpd$k_simple)
%EXPAND data_type ('FLOAT_72', 'FLOT72', fpd$k_lcg, 128, 62,
    (fpm_sign (-1), fpm_exp (-9, 8), fpm_mant (-10, 27), fpm_mant (34, 35),
    fpm_done ), 72, fpd$k_simple)
%EXPAND data_type ('G_FLOAT', 'GFLOAT', fpd$k_vax, 1024, 53,
    (fpm_sign (15), fpm_exp (4, 11), fpm_mant1, fpm_mant (3, 4), 
    fpm_mant (31, 16), fpm_mant (47, 16), fpm_mant (63, 16), fpm_done ), 64,
    fpd$k_simple)
%EXPAND data_type ('G_FLOAT72', 'GFLO72', fpd$k_lcg, 1024, 59,
    (fpm_sign (-1), fpm_exp (-12, 11), fpm_mant (-13, 24), fpm_mant (34, 35),
    fpm_done ), 72, fpd$k_simple)
%EXPAND data_type ('H_FLOAT', 'HFLOAT', fpd$k_vax, 16384, 113,
    (fpm_sign (15), fpm_exp (0, 15), fpm_mant1, fpm_mant (31, 16),
    fpm_mant (47, 16), fpm_mant (63, 16), fpm_mant (79, 16),
    fpm_mant (95, 16), fpm_mant (111, 16), fpm_mant (127, 16), fpm_done ), 128,
    fpd$k_simple)
%EXPAND data_type ('D_CMPLX', 'DCMPLX', fpd$k_vax, 128, 56,
    (fpm_sign (15), fpm_exp (7, 8), fpm_mant1, fpm_mant (6, 7),
    fpm_mant (31, 16), fpm_mant (47, 16), fpm_mant (63, 16), fpm_done ),
    64, fpd$k_complex)
%EXPAND data_type ('F_CMPLX', 'FCMPLX', fpd$k_vax, 128, 24,
    (fpm_sign (15), fpm_exp (7, 8), fpm_mant1, fpm_mant (6, 7),
    fpm_mant (31, 16), fpm_done ), 32, fpd$k_complex)
%EXPAND data_type ('F_CMPLX36', 'FCMP36', fpd$k_lcg, 128, 27,
    (fpm_sign (35), fpm_exp (27, 8), fpm_mant (26, 27), fpm_done ), 
    36, fpd$k_complex)
%EXPAND data_type ('G_CMPLX', 'GCMPLX', fpd$k_vax, 1024, 53, 
    (fpm_sign (15), fpm_exp (4, 11), fpm_mant1, fpm_mant (3, 4),
    fpm_mant (31, 16), fpm_mant (47, 16), fpm_mant (63, 16), fpm_done ),
    64, fpd$k_complex)
%EXPAND data_type ('H_CMPLX', 'HCMPLX', fpd$k_vax, 16384, 113,
    (fpm_sign (15), fpm_exp (0, 15), fpm_mant1, fpm_mant (31, 16),
    fpm_mant (47, 16), fpm_mant (63, 16), fpm_mant (79, 16),
    fpm_mant (95, 16), fpm_mant (111, 16), fpm_mant (127, 16), fpm_done ),
    128, fpd$k_complex)

%EXPAND end_class
%SBTTL 'Floating point data table'

! Format for the floating point data table.  This table is indexed by the data
! subtype (within its class).

$field
    fpd_fields =
        SET
        fpd$v_fpm_program = [$address], ! Address of FPM program for type
        fpd$v_representation = [$byte], ! Encodes details of representation
                                        ! within the 3 standard fields
        fpd$v_exp_offset = [$bytes(2)], ! Unsigned offset to apply to exponent
        fpd$v_mant_bits = [$byte],      ! Unsigned number of significant bits
                                        !  in the mantissa
        fpd$v_siz = [$short_integer],   ! fld size in bits (necessary for DIU)
        fpd$v_typ = [$byte]             ! code indicating simple or complex fp
                                        !  type (for DIU)
        TES;

LITERAL 
    fpd$k_size = $field_set_size;

MACRO
    dtt_fp

    ! declares an item to have the right structure and field attributes for the
    ! floating point data table.

    = BLOCKVECTOR [dt_class_fp_max + 1, fpd$k_size]
      FIELD (fpd_fields) % ;
%SBTTL 'Class Display Numeric data type definitions'
!++
! Class Display Numeric
!
! Information to be provided for each data type:
!   o  Name as quoted string
!   o  Short name as quoted string
!   o  Byte size
!   o  System of origin
!   o  code indicating sign type (use literals provided below)
!   o  Maximum length allowed
!   o  Character set used
!   o  Size of character set
!--

LITERAL                                 ! Literals for sign representations:
       dnd$k_unsigned = 0,              !  unsigned
       dnd$k_lead_sep = 1,              !  signed leading separate
       dnd$k_lead_over = 2,             !  signed leading overpunched
       dnd$k_trail_sep = 3,             !  signed trailing separate
       dnd$k_trail_over = 4;            !  signed trailing overpunched

LITERAL                                 ! Literals for each DN char set:
       cs_ascii = 0,                    !  ascii char set
       cs_asciix = 1,                   !  ascii extended char set
       cs_ebcdic = 2,                   !  ebcdic char set
       cs_sixbit = 3,                   !  sixbit char set
       cs_max = 4;

LITERAL                                 ! Literals for DN char set size:
       ovp$k_ascii_max = 10,            !  size of ascii dn character set
       ovp$k_asciix_max = 35,           !  size of ascii dn extended char set
       ovp$k_ebcdic_max = 10,           !  size of ebcdic dn character set
       ovp$k_sixbit_max = 10;           !  size of sixbit dn character set


declare_class ('dnum')                  ! call declare_class
!
! The code following the call to declare_class is actually the body of the
! MACRO dt_class_dnum_def.
!
%EXPAND
       data_type ('DN6LO', 'DN6LO', 6, sys_lcg, dnd$k_lead_over, 'sixbit', 18)
%EXPAND
       data_type ('DN6LS', 'DN6LS', 6, sys_lcg, dnd$k_lead_sep, 'sixbit', 19)
%EXPAND
       data_type ('DN6TO', 'DN6TO', 6, sys_lcg, dnd$k_trail_over, 'sixbit', 18)
%EXPAND
       data_type ('DN6TS', 'DN6TS', 6, sys_lcg, dnd$k_trail_sep, 'sixbit', 19)
%EXPAND
       data_type ('DN6U', 'DN6U', 6, sys_lcg, dnd$k_unsigned, 'sixbit', 18)
%EXPAND
       data_type ('DN7LO', 'DN7LO', 7, sys_lcg, dnd$k_lead_over, 'ascii', 18)
%EXPAND
       data_type ('DN7LS', 'DN7LS', 7, sys_lcg, dnd$k_lead_sep, 'ascii', 19)
%EXPAND
       data_type ('DN7TO', 'DN7TO', 7, sys_lcg, dnd$k_trail_over, 'ascii', 18)
%EXPAND
       data_type ('DN7TS', 'DN7TS', 7, sys_lcg, dnd$k_trail_sep, 'ascii', 19)
%EXPAND
       data_type ('DN7U', 'DN7U', 7, sys_lcg, dnd$k_unsigned, 'ascii', 18)
%EXPAND
       data_type ('DN8LO', 'DN8LO', 8, sys_8bit, dnd$k_lead_over, 'ascii', 31)
%EXPAND
       data_type ('DN8LS', 'DN8LS', 8, sys_8bit, dnd$k_lead_sep, 'ascii', 32)
%EXPAND
       data_type ('DN8TO', 'DN8TO', 8, sys_8bit, dnd$k_trail_over, 'asciix',31)
%EXPAND
       data_type ('DN8TS', 'DN8TS', 8, sys_8bit, dnd$k_trail_sep, 'ascii', 32)
%EXPAND
       data_type ('DN8U', 'DN8U', 8, sys_8bit, dnd$k_unsigned, 'ascii', 31)
%EXPAND
       data_type ('DN9LO', 'DN9LO', 9, sys_lcg, dnd$k_lead_over, 'ebcdic', 18)
%EXPAND
       data_type ('DN9LS', 'DN9LS', 9, sys_lcg, dnd$k_lead_sep, 'ebcdic', 19)
%EXPAND
       data_type ('DN9TO', 'DN9TO', 9, sys_lcg, dnd$k_trail_over, 'ebcdic', 18)
%EXPAND
       data_type ('DN9TS', 'DN9TS', 9, sys_lcg, dnd$k_trail_sep, 'ebcdic', 19)
%EXPAND
       data_type ('DN9U', 'DN9U', 9, sys_lcg, dnd$k_unsigned, 'ebcdic', 18)

%EXPAND
end_class                               ! call MACRO end_class
%SBTTL 'Display Numeric date table (DND)'

! The format for the display numeric data table is below.  This table is
! indexed by the data subtype (within its class).

$FIELD
      dnd_fields =
      SET
      dnd$v_byt_siz = [$bits(6)],       ! byte size
      dnd$v_sys_orig = [$bits(3)],      ! system of origin
      dnd$v_sign_type = [$bits(3)],     ! sign type indicator
      dnd$v_ovp_max_index = [$byte],    ! maximum index of OVP
      dnd$v_max_length = [$bits(6)],    ! maximum field length
      dnd$v_char_set = [$bits(3)]       ! character set code
      TES;

LITERAL dnd$k_size = $field_set_size;

MACRO
     dtt_dn

    ! declares an item to have the right structure and field attributes for the
    ! display numeric data table.

         = BLOCKVECTOR [dt_class_dnum_max + 1, dnd$k_size]
           FIELD (dnd_fields) % ;
%SBTTL 'Class Packed Decimal data type definitions'
!++
! Class Packed Decimal
!
! Information to be provided for each data type:
!   o  Name as quoted string
!   o  Short name as quoted string
!   o  Byte size
!   o  System of origin
!   o  Maximum length allowed
!   o  Name of sign set to be used.  Note the only valid sign set names is:
!        DECSTD
!   o  size of sign set
!--

LITERAL                                 ! Literal for PD sign table size
       pds$k_decstd_max = 6;

LITERAL                                 ! Literal for PD sign set:
       ss_decstd = 0,                   ! DEC-10/DEC-20 COBOL and VAX COBOL
                                        !  packed decimal standard sign set
       ss_max = 1;

declare_class ('pdec')
!
! The code following the call to declare_class is actually the body of the
! MACRO dt_class_pdec_def.
! 
%EXPAND
       data_type ('PD8', 'PD8', 8, 4, sys_8bit, 31, 'decstd')
%EXPAND
       data_type ('PD9', 'PD9', 9, 4, sys_lcg, 18, 'decstd')
%EXPAND
end_class                               ! call MACRO end_class
%SBTTL 'Packed Decimal data table (PDD)'

! Format for the packed decimal data table.  This table is indexed by the data
! subtype (within its class).

$FIELD
      pdd_fields =
      SET
      pdd$v_byt_siz = [$bits(6)],       ! byte size
      pdd$v_nbl_siz = [$bits(6)],       ! nibble size (within a byte)
      pdd$v_sys_orig = [$bits(3)],      ! system of origin
      pdd$v_max_length = [$byte],       ! maximum field length
      pdd$v_sign_set = [$bits(4)]       ! addr of sign table to use
      TES;

LITERAL pdd$k_size = $field_set_size;

MACRO
     dtt_pd

     ! Declares an item to have the right structure and field attributes for
     ! the packed decimal data table.

         = BLOCKVECTOR [dt_class_pdec_max + 1, pdd$k_size]
           FIELD (pdd_fields) % ;
%SBTTL 'Clean up'

LITERAL
    dix$k_max_class = dt_class;         ! This is set to max class code used.

%PRINT (dix$k_max_class, '=', %NUMBER (dix$k_max_class))

UNDECLARE
    dt_class,
    dt_code,
    %QUOTE declare_class,
    %QUOTE data_type,
    %QUOTE end_class;

! six character routine names...

MACRO
    dix$$bit_offset = dixbof %,
    dix$$check_alignment = dixcal %,
    dix$$con_gen = dixgen %,
    dix$$copy_structure = dixcpy %,
    dix$$des_by_det = dixdbd %;

! Six character names for tables
MACRO
    dix$adtt_fbin = dixfbd %,
    dix$adtt_fp = dixfpd %,
    dix$adttx_st = dixsdx %,
    dix$adtt_st = dixstd %,
    dix$adtt_dn = dixdnd %,
    dix$adtt_pd = dixpdd %;

! XPORT seems to be in the habit of leaving the following definition lying
! around, but won't tolerate its existence at the start of a file.  Therefore
! it must be UNDECLAREd here:

UNDECLARE
    %QUOTE $descriptor;