Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/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;