Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/diuaction.req
There are 4 other files named diuaction.req in the archive. Click here to see a list.
! 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.
!
! ACTION.REQ
!++
! FACILITY: DIU
!
! ABSTRACT:
!
! ACTION.REQ defines the data structures used by the semantic actions
! during parsing of record descriptions and transforms.
!
! ENVIRONMENT: XPORT
!
! AUTHOR: Charlotte L. Richardson, CREATION DATE: 8-Nov-84
!
! MODIFIED BY:
!
! 1 Implement DIU$INITIAL_VALUE and DIU$TAG_FIELD.
! Charlotte Richardson 29-May-85
!
! 2 Account for DIL complex numbers in datatype tables.
! Charlotte Richardson 12-July-85
!
! 3 Fix datatype table to accurately reflect fixed-binary VAX
! datatypes -- mapping will reset these if the system of
! origin is not a VAX after all.
! Charlotte Richardson 15-July-85
!
! 236 Change library of DIXLIB to DIUDIX.
! Sandy Clemens 19-Jun-86
!
! 241 In ACTION.REQ, add OTHERWISE case to select statement in SIZE_OF macro.
! Sandy Clemens 20-Jun-86
!
! 253 Rename file to DIUACTION.
! Gregory A. Scott 1-Jul-86
!--
!
! Include Files:
require 'DIUPATREQPRO'; ! Standard PAT require file prolog
library 'BLI:XPORT'; ! XPORT data structures
library 'DIUDIX';
%if %bliss (bliss32) %then
require 'DIXB32.R32';
%else
require 'DIXB36.R36';
%fi
! Routine name equivalences for TOPS-10/20 LINK (sigh...):
%IF %BLISS (BLISS36) %THEN
macro
!ACTION_RTN = ACTION %, ! Driver for semantic actions
CLEAR_ATTRIBUTE_FLAGS = CLRATT %, ! Clears attribute flags
COMPUTE_ARRAY_LENGTH = CMTARR %, ! Compute offset for an array
COMPUTE_BYTE_SIZE = CMTBSZ %, ! Compute byte size of field
COMPUTE_BYTE_SIZE_WALKER = CMTBSW %, ! Used by COMPUTE_BYTE_SIZE
COMPUTE_END_OFFSETS = CMTEND %, ! Compute offsets at end of field
COMPUTE_OFFSETS = CMTOFF %, ! Compute field offsets
COMPUTE_STRIDES = CMTSTR %, ! Compute stride for an array dimension
COPY_RECORD = CPYREC %, ! Copy a record template
CREATE_STR_ATT = CRESTR %, ! Creates a string attribute structure
DEAL_WITH_TRANSFORM_NAMES = DWTNMS %, ! Deal with field names in transform
DEFINE_DIMENSION = DEFDIM %, ! Creates a dimension
DEFINE_DTYPE = DEFTYP %, ! Defines datatype and length
DEFINE_FIELD = DEFFLD %, ! Creates a field
DEFINE_GROUP_ATTS = DEFGRP %, ! Defines group length and offsets
DEFINE_NUM_ATT = DEFNUM %, ! Defines numeric attributes
DEFINE_RECORD = DEFREC %, ! Defines record name and description
DEFINE_SCALE = DEFSCL %, ! Defines scale
DEFINE_TRANSFORM = DEFTRN %, ! Complete a transform
DUPLICATE_SUBTREE = DUPDSC %, ! Duplicate a description subtree
END_SET = ENDSET %, ! Cleans up at 'END' statement
EXTRACT_NAME = EXTNAM %, ! Puts name from token into NAME_BLOCK
DIU$FIND_FIELD = FNDFLD %, ! Find specified field
FIND_DATATYPE = FNDTYP %, ! Find a datatype for a field
FIND_DATATYPE_WALKER = FNDTYW %, ! Used by FIND_DATATYPE
FIND_MATCHING_MEMBER = FNDMTC %, ! Find matching member block
FIND_NAMES_IN_TREES = FNDNAM %, ! Look up names used in transform
FIX_COPY_TEMPLATE = FIXCPY %, ! Map datatypes in COPY template
FIX_VARIANTS = FIXVAR %, ! Complete VARIANT blocks in tree
! More routine name equivalences for TOPS-10/20 (sigh...):
FREE_DIMENSIONS = FREDIM %, ! Free a list of dimensions
FREE_LITLIST = FRELIT %, ! Free a list of literal lists
FREE_MEMBERS = FREMEM %, ! Releases a crx_member and all subtrees
FREE_RECORD = FREREC %, ! Free a record and all subtrees
FREE_STRINGLIST = FRESTR %, ! Free a stringlist and all subtrees
FULLY_QUALIFIED_NAME = FULQUL %, ! Creates fully-qualified name
INIT_LITERAL = INTLIT %, ! Initialize a crx_literal node
INIT_MEMBER = INTMEM %, ! Initialize a crx_member node
INIT_STRINGLIST = INTSTR %, ! Initialize a crx_stringlist node
DIU$INITIAL_VALUE = INTVAL %, ! Fix initial values
INITIAL_VALUE_WALKER = INTVLW %, ! Internal routine for DIU$INITIAL_VALUE
MAKE_DIMS = MAKDIM %, ! Makes a dims node
MAKE_FQN = MAKFQN %, ! Make an FQN stringlist
MAKE_TRANSFORM = MAKTRA %, ! Make a transform block
MM_STATEMENT = MMST %, ! Process a MOVE MATCHING statement
MOM_STATEMENT = MOMST %, ! Process a MOVE OTHERS MATCHING
MOVE_STATEMENT = MOVEST %, ! Process a MOVE statement
NAME_SYNTAX = NAMSYM %, ! Check field name syntax
PRODUCE_FQN = PRDFQN %, ! Produce a fully-qualified name list
SAVE_COMPLEX_VALUE = SAVCPX %, ! Stores part of complex number
SAVE_DEST = SAVDST %, ! Saves destination field name
SAVE_FIELDNAME = SAVFLD %, ! Saves current field name
SAVE_LOWER_BOUND = SAVLWR %, ! Saves lower bound for range
SAVE_SOURCE = SAVSRC %, ! Saves source field name
SAVE_VALUES_LIST = SAVVAL %, ! Saves value list
SET_ATT = SETATT %, ! Sets some attributes
SET_CHARACTER_TYPE = SETCHR %, ! Sets the character type
SET_SYNCHRONIZED = SETSYN %, ! Handle SYNCHRONIZED clause
SETUP_VALUE_RANGE = SETRNG %, ! Saves a value
DIU$TAG_FIELD = TAGFLD %, ! Fix up tag values
TAG_FIELD_WALKER = TAGFLW %, ! Internal routine for DIU$TAG_FIELD
VALIDATE_FQN = VLDFQN %; ! Validate a fully-qualified name
%FI
! Additional field information block:
! Holds additional information about a field during record description
! construction; deleted at completion. Each crx_member's crm$a_facility
! field points to one of these.
$FIELD crx_additional$FIELDSET =
SET
cra$l_locator = [$LONG_INTEGER], ! Source locator, needed in case
! an error is found later
cra$l_alignment = [$LONG_INTEGER], ! Token type for alignment
cra$l_type = [$LONG_INTEGER], ! Field type (see below)
cra$l_max_member_length = [$LONG_INTEGER], ! Max_member_length for VARIANT
cra$l_initial_type = [$LONG_INTEGER], ! Token type for initial value,
! or datatype, if cra$v_src_crx
cra$l_initial_type_1 = [$LONG_INTEGER], ! Token type of real part of
! complex initial value
cra$l_initial_type_2 = [$LONG_INTEGER], ! Token type of imaginary part
! of complex initial value
cra$l_initial_length_1 = [$LONG_INTEGER], ! Length of real part of
! complex initial vaue
cra$v_alignment_exists = [$BITS (1)], ! Alignment-exists flag
cra$v_length_set = [$BITS (1)], ! Length-setup flag
cra$v_offset_set = [$BITS (1)], ! Offset-set flag
cra$v_dimension = [$BITS (1)], ! Dimension-seen flag
cra$v_sync_left = [$BITS (1)], ! Synchronized-left flag
cra$v_sync_right = [$BITS (1)], ! Synchronized-right flag
cra$v_src_crx = [$BITS (1)] ! Initial-value-from-CRX flag
TES;
LITERAL cra$s_crx_additional = $FIELD_SET_SIZE;
MACRO crx_additional = BLOCK [cra$s_crx_additional]
FIELD (crx_additional$FIELDSET) %;
! Field types:
LITERAL
FLD$K_COPY = 1, ! A COPY field
FLD$K_ELEMENTARY = 2, ! An elementary field
FLD$K_STRUCTURE = 3, ! A structure field
FLD$K_VARIANT = 4, ! A Variant field
FLD$K_VARIANTS = 5; ! A VARIANTS field
! Record formats (for crx_record crx$l_format field):
LITERAL
CDD$K_REC_FIXED = 1, ! Fixed-length
CDD$K_REC_VARIABLE = 2; ! Variable-length
! Tag FFD block:
! The tag stringlists pointed to by crx_dimension nodes are replaced by these
! tag_FFD blocks by DIU$TAG_FIELD during transform loading.
$FIELD crx_tag_FFD$FIELDSET =
SET
crt$a_previous = [$ADDRESS], ! Back pointer to previous node
crt$a_next = [$ADDRESS], ! Pointer to next node (not used)
crt$b_id = [$BYTE], ! Always CRX$K_TAG_FFD
crt$v_suspicious_tag = [$BITS (1)], ! "Suspicious" tag value
crt$v_ffd = [$SUB_BLOCK (0)],! Fullword alignment needed for FFDs
ffd_flds ('crt') ! FFD (See DIXLIB)
TES;
LITERAL diu$s_crx_tag_FFD = $FIELD_SET_SIZE;
MACRO crx_tag_ffd = BLOCK [diu$s_crx_tag_FFD]
FIELD (crx_tag_FFD$FIELDSET) %;
LITERAL CRX$K_TAG_FFD = 200;
! Datatypes:
literal
DIU$K_DTYPE_B = DIX$K_DT_SBF8, ![3] Signed byte -- always VAX
DIU$K_DTYPE_BU = DIX$K_DT_UBF8, ![3] Unsigned byte -- always VAX
DIU$K_DTYPE_D = %BLISS32 (DIX$K_DT_D_FLOAT) ! D-floating
%BLISS36 (DIX$K_DT_FLOAT_72),
DIU$K_DTYPE_DC = DIX$K_DT_D_CMPLX, ! D-floating complex always
DIU$K_DTYPE_F = %BLISS32 (DIX$K_DT_F_FLOAT) ! F-floating
%BLISS36 (DIX$K_DT_FLOAT_36),
DIU$K_DTYPE_FC = %BLISS32 (DIX$K_DT_F_CMPLX) ! F-floating complex
%BLISS36 (DIX$K_DT_F_CMPLX36),![2]
DIU$K_DTYPE_G = %BLISS32 (DIX$K_DT_G_FLOAT) ! G-floating
%BLISS36 (DIX$K_DT_G_FLOAT72),
DIU$K_DTYPE_GC = DIX$K_DT_G_CMPLX, ! G-floating complex always
!DIU$K_DTYPE_VU ! Bit string
DIU$K_DTYPE_H = DIX$K_DT_H_FLOAT, ! H-floating - always VAX type
DIU$K_DTYPE_HC = DIX$K_DT_H_CMPLX, ! H-floating complex - ditto
DIU$K_DTYPE_L = %BLISS32 (DIX$K_DT_SBF32) ! Signed longword
%BLISS36 (DIX$K_DT_SBF72),
DIU$K_DTYPE_LU = %BLISS32 (DIX$K_DT_UBF32) ! Unsigned longword
%BLISS36 (DIX$K_DT_UBF72),
!DIU$K_DTYPE_NZ ! Zoned numeric
DIU$K_DTYPE_NU = %BLISS32 (DIX$K_DT_DN8U) ! Unsigned numeric
%BLISS36 (DIX$K_DT_DN7U),
DIU$K_DTYPE_NL = %BLISS32 (DIX$K_DT_DN8LS) ! Signed left separate
%BLISS36 (DIX$K_DT_DN7LS),
DIU$K_DTYPE_NLO = %BLISS32 (DIX$K_DT_DN8LO) ! Signed left overpunched
%BLISS36 (DIX$K_DT_DN7LO),
DIU$K_DTYPE_NR = %BLISS32 (DIX$K_DT_DN8TS) ! Signed right separate
%BLISS36 (DIX$K_DT_DN7TS),
DIU$K_DTYPE_NRO = %BLISS32 (DIX$K_DT_DN8TO) ! Signed right overpunched
%BLISS36 (DIX$K_DT_DN7TO),
DIU$K_DTYPE_O = DIX$K_DT_SBF128, ![3] Signed octaword always VAX
DIU$K_DTYPE_OU = DIX$K_DT_UBF128, ![3] Unsigned octaword -- VAX
DIU$K_DTYPE_P = %BLISS32 (DIX$K_DT_PD8) ! Packed decimal
%BLISS36 (DIX$K_DT_PD9),
!DIU$K_DTYPE_PTR ! Pointer
DIU$K_DTYPE_Q = DIX$K_DT_SBF64, ![3] Signed quadword always VAX
DIU$K_DTYPE_QU = DIX$K_DT_UBF64, ![3] Unsigned quadword -- VAX
DIU$K_DTYPE_T = %BLISS32 (DIX$K_DT_ASCII_8) ! Text
%BLISS36 (DIX$K_DT_ASCII_7),
!DIU$K_DTYPE_Z ! Unspecified
!DIU$K_DTYPE_VT ! Varying string
!DIU$K_DTYPE_VRT ! Virtual field
DIU$K_DTYPE_W = %BLISS32 (DIX$K_DT_SBF16) ! Signed word
%BLISS36 (DIX$K_DT_SBF36),
DIU$K_DTYPE_WU = %BLISS32 (DIX$K_DT_UBF16) ! Unsigned word
%BLISS36 (DIX$K_DT_UBF36);
! Numeric field flags:
literal
DDU$K_UNSPECIFIED = 0,
DDU$K_SIGNED = 1,
DDU$K_UNSIGNED = 2,
DDU$K_ZONED = 3;
! Sign locations:
literal
DDU$K_LEFT_SEPARATE = 1,
DDU$K_LEFT_OVERPNCH = 2,
DDU$K_RIGHT_SEPARATE = 3,
DDU$K_RIGHT_OVERPNCH = 4;
! Macros for datatype sizes and DIGITS values:
! Size of datatype, in bits:
macro size_of (dt) =
BEGIN
local my_dt: data_type_sep, result;
EXTERNAL
dix$adtt_st : dtt_st, ! String datatype table
dix$adtt_fbin : dtt_fbin, ! Fixed-point binary datatype table
dix$adtt_fp : dtt_fp, ! Floating-point datatype table
dix$adtt_dn : dtt_dn, ! Display-numeric datatype table
dix$adtt_pd : dtt_pd; ! Packed decimal datatype table
my_dt = dt;
result = (SELECTONE .my_dt [dt_class_sep] OF
SET
[dt_string] : .dix$adtt_st [.my_dt [dt_code_sep], std$v_byt_siz];
[dt_fbin] : .dix$adtt_fbin [.my_dt [dt_code_sep], fbd$v_siz];
[dt_fp] : .dix$adtt_fp [.my_dt [dt_code_sep], fpd$v_siz];
[dt_dnum] : .dix$adtt_dn [.my_dt [dt_code_sep], dnd$v_byt_siz];
[dt_pdec] : .dix$adtt_pd [.my_dt [dt_code_sep], pdd$v_byt_siz];
[OTHERWISE] : 0;
TES);
.result
END %;
! Default DIGITS (and MAX_DIGITS) for a datatype:
macro digits_of (dt) =
BEGIN
local my_dt: data_type_sep, result;
EXTERNAL
dix$adtt_st : dtt_st, ! String datatype table
dix$adtt_fbin : dtt_fbin, ! Fixed-point binary datatype table
dix$adtt_fp : dtt_fp, ! Floating-point datatype table
dix$adtt_dn : dtt_dn, ! Display-numeric datatype table
dix$adtt_pd : dtt_pd; ! Packed decimal datatype table
my_dt = dt;
result = (CASE .my_dt [dt_class_sep] FROM 1 to DIX$K_MAX_CLASS OF
SET
[dt_string] : 0;
[dt_fbin] : .dix$adtt_fbin [.my_dt [dt_code_sep],
fbd$v_signif_bits];
[dt_fp] : .dix$adtt_fp [.my_dt [dt_code_sep],
fpd$v_mant_bits];
[dt_dnum] : 0;
[dt_pdec] : 0;
TES);
.result
END %;
! Sizes of datatypes:
macro
DIU$K_S_ASCII = size_of (DIU$K_DTYPE_T) %,
DIU$K_S_BYTE = size_of (DIU$K_DTYPE_BU) %,
DIU$K_S_DATE = %BLISS32 (64) %BLISS36 (72) %,
DIU$K_S_D_FLOAT = size_of (DIU$K_DTYPE_D) %,
DIU$K_S_D_COMPLEX = (size_of (DIU$K_DTYPE_DC)* 2) %,
DIU$K_S_F_FLOAT = size_of (DIU$K_DTYPE_F) %,
DIU$K_S_F_COMPLEX = (size_of (DIU$K_DTYPE_FC) * 2) %,
DIU$K_S_G_FLOAT = size_of (DIU$K_DTYPE_G) %,
DIU$K_S_G_COMPLEX = (size_of (DIU$K_DTYPE_GC) * 2) %,
DIU$K_S_H_FLOAT = size_of (DIU$K_DTYPE_H) %,
DIU$K_S_H_COMPLEX = (size_of (DIU$K_DTYPE_HC) * 2) %,
DIU$K_S_LONGWORD = size_of (DIU$K_DTYPE_LU) %,
DIU$K_S_OCTAWORD = size_of (DIU$K_DTYPE_OU) %,
DIU$K_S_PACKED = size_of (DIU$K_DTYPE_P) %,
DIU$K_S_POINTER = %BLISS32 (32) %BLISS36 (36) %,
DIU$K_S_QUADWORD = size_of (DIU$K_DTYPE_QU) %,
DIU$K_S_WORD = size_of (DIU$K_DTYPE_WU) %;
! Offsets for use in the ALIGNED clause, for SYNCHRONIZED, and for
! character strings.
! NOTE: You must have SYS_ORG set to either SYS_8BIT/SYS_PRO or SYS_LCG
! to use these!
macro
DIU$K_O_BIT = (IF .sys_org EQL SYS_8BIT OR .sys_org EQL SYS_PRO
THEN (1)
ELSE (SIZE_OF (DIX$K_DT_UBF36))) %,
DIU$K_O_BYTE = (IF .sys_org EQL SYS_8BIT OR .sys_org EQL SYS_PRO
THEN (SIZE_OF (DIX$K_DT_UBF8))
ELSE (SIZE_OF (DIX$K_DT_UBF36))) %,
DIU$K_O_WORD = (IF .sys_org EQL SYS_8BIT OR .sys_org EQL SYS_PRO
THEN (SIZE_OF (DIX$K_DT_UBF16))
ELSE (SIZE_OF (DIX$K_DT_UBF36))) %,
DIU$K_O_LONGWORD = (IF .sys_org EQL SYS_8BIT OR .sys_org EQL SYS_PRO
THEN (SIZE_OF (DIX$K_DT_UBF32))
ELSE (SIZE_OF (DIX$K_DT_UBF72))) %,
DIU$K_O_QUADWORD = (IF .sys_org EQL SYS_8BIT OR .sys_org EQL SYS_PRO
THEN (SIZE_OF (DIX$K_DT_UBF64))
ELSE (SIZE_OF (DIX$K_DT_UBF36))) %,
DIU$K_O_OCTAWORD = (IF .sys_org EQL SYS_8BIT OR .sys_org EQL SYS_PRO
THEN (SIZE_OF (DIX$K_DT_UBF128))
ELSE (SIZE_OF (DIX$K_DT_UBF36))) %;
! Default DIGITS and MAX_DIGITS for binary datatypes:
macro
DIU$K_D_BYTE_S = digits_of (DIU$K_DTYPE_B) %,
DIU$K_D_BYTE_U = digits_of (DIU$K_DTYPE_BU) %,
DIU$K_D_D_FLOAT = digits_of (DIU$K_DTYPE_D) %,
DIU$K_D_D_COMPLEX = digits_of (DIU$K_DTYPE_DC) %,
DIU$K_D_F_FLOAT = digits_of (DIU$K_DTYPE_F) %,
DIU$K_D_F_COMPLEX = digits_of (DIU$K_DTYPE_FC) %,
DIU$K_D_G_FLOAT = digits_of (DIU$K_DTYPE_G) %,
DIU$K_D_G_COMPLEX = digits_of (DIU$K_DTYPE_GC) %,
DIU$K_D_H_FLOAT = digits_of (DIU$K_DTYPE_H) %,
DIU$K_D_H_COMPLEX = digits_of (DIU$K_DTYPE_HC) %,
DIU$K_D_LONGWORD_S = digits_of (DIU$K_DTYPE_L) %,
DIU$K_D_LONGWORD_U = digits_of (DIU$K_DTYPE_LU) %,
DIU$K_D_OCTAWORD_S = digits_of (DIU$K_DTYPE_O) %,
DIU$K_D_OCTAWORD_U = digits_of (DIU$K_DTYPE_OU) %,
DIU$K_D_QUADWORD_S = digits_of (DIU$K_DTYPE_Q) %,
DIU$K_D_QUADWORD_U = digits_of (DIU$K_DTYPE_QU) %,
DIU$K_D_WORD_S = digits_of (DIU$K_DTYPE_W) %,
DIU$K_D_WORD_U = digits_of (DIU$K_DTYPE_WU) %;
! Flag used in determining a dimension's stride:
literal
DDU$K_ROW_MAJOR = 2,
DDU$K_COLUMN_MAJOR = 3;
! The null pointer:
literal
NULL_PTR = 0;
! Macro to give address containing first byte pointed to by a byte pointer.
MACRO address_of_byte (bptr) =
%IF %BLISS (BLISS32) %THEN
(bptr) ! Clean case
%ELSE
((CH$PLUS ((bptr), 1)) AND %O'77777777') ! Unclean case
%FI
%;
! End of ACTION.REQ