Google
 

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