Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

%TITLE 'Routines To Dump Transform / FQN Data Structures'
MODULE DIUDMP(
       IDENT='253'
       %BLISS32 (,
                 ADDRESSING_MODE(EXTERNAL=GENERAL,NONEXTERNAL=LONG_RELATIVE)
                )
       %BLISS36 (,
                 ENTRY (dmpdim, dmpfqn, dmptrs, dmptrd, dmptra)
                )
                          ) = 
BEGIN
!++
!	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.
!
! FACILITY:	DIU    Data Interchange Utility 
!
! ABSTRACT:	Routines to dump out the transform and dims and FQN data
!		structures using $FAO_PUT macro.
!
! AUTHOR:	Sandy Clemens, Creation Date:  25-Oct-84
!
! EDIT HISTORY:
!
!       3	Clean up copyright notice.  Change LIBRARY 'DIUMSG'
!               to 'DIU'.  Remove copying things to 'tmp' LOCAL variable
!               since it wasn't being used anyway.
!               Sandy Clemens	14-Jun-85
!
!       14      Add transform execution code and conversion warnings report
!               code.  FILES:  DIUETR.BLI (NEW), DIUCSR.BLI (NEW), DIUDMP.BLI,
!               DIUABO.B36, INTFAC.BLI, DIUTLB.BLI.
!               Sandy Clemens	15-Jul-85
!
!  236  Change library of DIXLIB to DIUDIX.
!       Sandy Clemens  19-Jun-86
!
!  253  Change libraries to new names.
!       Gregory A. Scott 1-Jul-86
!--

!********************************************************************
!           L I B R A R Y   A N D   R E Q U I R E    F I L E S
!********************************************************************
%IF %BLISS (BLISS32)
%THEN
     LIBRARY 'SYS$LIBRARY:XPORT';       ! XPORT definitions
     UNDECLARE %QUOTE $STRING;
     LIBRARY 'SYS$LIBRARY:STARLET';     ! VMS System Services
     LIBRARY 'DIU$SOURCE_LIB:DIUVMS';	! DIU VMS Specifics
     LIBRARY 'DIU$SOURCE_LIB:DIUMSG';	! DIU MESSAGE Literals
%FI

%IF %BLISS (BLISS36)
%THEN
     LIBRARY 'BLI:XPORT';               ! XPORT definitions
     LIBRARY 'FAOPUT';                  ! Defines $FAO_PUT macro
     LIBRARY 'FAO';
     LIBRARY 'DIU';
%FI

UNDECLARE %QUOTE $DESCRIPTOR;
LIBRARY 'DIUCRX';                       ! CRX data structures
UNDECLARE %QUOTE $DESCRIPTOR;
LIBRARY 'DIUTLB';			! DIU Transform structure
UNDECLARE %QUOTE $DESCRIPTOR;
UNDECLARE %QUOTE STS$K_SEVERE, %QUOTE STS$K_ERROR, %QUOTE STS$K_WARNING,
          %QUOTE STS$K_SUCCESS, %QUOTE SS$_NORMAL, %QUOTE STS$K_INFO;
LIBRARY 'DIUDIX';			! DIX/DIL specific things
LIBRARY 'DIUMLB';			! DIU Mapping routines library

!*****************************************************************
!                 D I U $ D U M P _ D I M S
!*****************************************************************
GLOBAL ROUTINE DIU$DUMP_DIMS (dimlst, depth) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION
!
!	Routine used to dump out the dims list, node by node.
!	Used mainly for debugging.
!
! FORMAL PARAMETERS
!
!	dimlst		Address of the first node in the dims list.
!
!	depth		Used for indentation (for $FAO_PUT macro).
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!--
BEGIN

MAP dimlst : REF dims;

LOCAL status : INITIAL (0),
      tmp : INITIAL (0);

IF .dimlst EQL 0
THEN $FAO_PUT (.depth, 'Empty')
ELSE DO BEGIN
%IF %BLISS(BLISS32)
%THEN
        $FAO_PUT (.depth, 'DIMS node at address: !XL', .dimlst);
%FI
%IF %BLISS(BLISS36)
%THEN
        $FAO_PUT (.depth, 'DIMS node at address: !OL', .dimlst);
%FI
        tmp = .dimlst [dims$b_id];
        IF .tmp EQL DIU$K_DIMSNODE
            THEN $FAO_PUT (.depth, 'DIMS$B_ID:  DIU$K_DIMSNODE')
            ELSE $FAO_PUT (.depth, 'DIMS$B_ID:  ***UNKNOWN***');
        $FAO_PUT (.depth, 'DIMS$B_DIMENSIONS_CNT: !SL',
                  .dimlst [dims$b_dimensions_cnt]);
	$FAO_PUT (.depth, 'DIMS$L_TOT_CELLS: !SL', .dimlst [dims$l_tot_cells]);
%IF %BLISS(BLISS32)
%THEN
	$FAO_PUT (.depth, 'DIMS$A_LIST: !XL', .dimlst [dims$a_list]);
	$FAO_PUT (.depth, 'DIMS$A_PREVIOUS: !XL', .dimlst [dims$a_previous]);
	$FAO_PUT (.depth, 'DIMS$A_NEXT: !XL', .dimlst [dims$a_next]);
%FI
%IF %BLISS(BLISS36)
%THEN
	$FAO_PUT (.depth, 'DIMS$A_LIST: !OL', .dimlst [dims$a_list]);
	$FAO_PUT (.depth, 'DIMS$A_PREVIOUS: !OL', .dimlst [dims$a_previous]);
	$FAO_PUT (.depth, 'DIMS$A_NEXT: !OL', .dimlst [dims$a_next]);
%FI
        $FAO_PUT (.depth, ' ');         ! CRLF for prettier format...
	dimlst = .dimlst [dims$a_next]
	END
     UNTIL .dimlst EQL 0;

END;				! end of routine

!*****************************************************************
!                  D I U $ D U M P _ F Q N
!*****************************************************************
GLOBAL ROUTINE DIU$DUMP_FQN (fqn, depth) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION
!
!	Routine to dump out the fqn stringlist, node by node,
!	and the name strings.  Used mainly for debugging.
!
! FORMAL PARAMETERS
!
!	fqn		Root address of the fqn list.
!
!	depth		Used for indentation (for $FAO_PUT macro).
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!--
BEGIN

MAP fqn : REF crx_stringlist;

LOCAL status : INITIAL (0),
      tmp : INITIAL (0);

IF .fqn EQL 0
 THEN $FAO_PUT (.depth, 'Empty')
 ELSE DO BEGIN
	 $FAO_PUT (.depth, 'FQN node is: ');
         %IF %BLISS(BLISS32)
             %THEN
             $FAO_PUT (.depth, 'CRS$A_PREVIOUS: !XL', .fqn [CRS$A_PREVIOUS]);
             $FAO_PUT (.depth, 'CRS$A_NEXT:     !XL', .fqn [CRS$A_NEXT]);
         %FI
         %IF %BLISS(BLISS36)
             %THEN
             $FAO_PUT (.depth, 'CRS$A_PREVIOUS: !OL', .fqn [CRS$A_PREVIOUS]);
             $FAO_PUT (.depth, 'CRS$A_NEXT:     !OL', .fqn [CRS$A_NEXT]);
         %FI
	 tmp = .fqn [CRS$B_ID];
	 IF .tmp EQL CRX$K_STRINGLIST
	    THEN $FAO_PUT (.depth, 'CRS$B_ID:   CRX$K_STRINGLIST')
	    ELSE $FAO_PUT (.depth, 'CRS$B_ID:   ***UNKNOWN***');

	 $FAO_PUT (.depth, 'FQN NAME : !AD',
                   .fqn [CRS$W_STRING_LENGTH],
                   (.fqn [CRS$A_STRING]));
	 $FAO_PUT (.depth, ' ');        ! for prettier format
	 fqn = .fqn [CRS$A_NEXT]
	 END
      UNTIL .fqn EQL 0;
END;

!*****************************************************************
!            D I U $ D M P _ M E M B E R _ N A M E
!*****************************************************************
ROUTINE DIU$DMP_MEMBER_NAME (member, depth) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION
!
!       Routine to show the name of a member block referred to by a
!       transform node.
!
! FORMAL PARAMETERS
!
!       member          The addresss of the member block.
!
!       depth           Used for indentation (for $FAO_PUT macro).
!
! IMPLICIT PARAMETERS
!
!       None
!
! ROUTINE VALUE
!
!       None
!
!--
BEGIN

MAP member : REF crx_member;

LOCAL status : INITIAL (0);

IF .member EQL 0
THEN $FAO_PUT (.depth, 'Member name: * EMPTY *')
ELSE $FAO_PUT (.depth, 'Member name: !AD', .member [CRM$B_NAME_LENGTH],
               ch$ptr (member [CRM$T_NAME]));

END;

!*****************************************************************
!                  D I U $ D M P _ T R A _ S R C
!*****************************************************************
GLOBAL ROUTINE DIU$DMP_TRA_SRC (trans, depth) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION
!
!	Routine to dump out the source portion of the transform
!       structure.  Used mainly for debugging.
!
! FORMAL PARAMETERS
!
!	trans		Address of the first node in the transform list.
!
!	depth		Used for indentation (for $FAO_PUT macro).
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!--
BEGIN

MAP trans : REF transform_str;

LOCAL status : INITIAL(0),
      tmp : INITIAL (0);

! make sure TRA_ID is correctly set to DIU$K_TRANSFORM
tmp = .trans [tra_id];
IF .tmp NEQ DIU$K_TRANSFORM
THEN $FAO_PUT (.depth, 'TRA_ID :  ***UNKNOWN***');

%IF %BLISS(BLISS32)
%THEN
     $FAO_PUT (.depth, 'TRA_SRC_ADDR : !XL', .trans [tra_src_addr]);
%FI
%IF %BLISS(BLISS36)
%THEN
     $FAO_PUT (.depth, 'TRA_SRC_ADDR : !OL', .trans [tra_src_addr]);
%FI

! display member name
DIU$DMP_MEMBER_NAME (.trans [tra_src_addr], .depth);

! dump source FQN stringlist
%IF %BLISS (BLISS32)
%THEN
     $FAO_PUT (.depth, 'FQN for source at !XL is: ', .trans [tra_src_nam]);
%FI
%IF %BLISS (BLISS36)
%THEN
     $FAO_PUT (.depth, 'FQN for source at !OL is: ', .trans [tra_src_nam]);
%FI
DIU$DUMP_FQN (.trans [tra_src_nam], .depth+1);

! dump source DIMS structure
%IF %BLISS (BLISS32)
%THEN
     $FAO_PUT (.depth, 'DIMS for source at !XL is: ', .trans [tra_src_dims]);
%FI
%IF %BLISS (BLISS36)
%THEN
     $FAO_PUT (.depth, 'DIMS for source at !OL is: ', .trans [tra_src_dims]);
%FI
DIU$DUMP_DIMS (.trans [tra_src_dims], .depth+1);

%IF %BLISS(BLISS32)
%THEN
     $FAO_PUT (.depth, 'TRA_SRC$V_UNIT : !XL', .trans [tra_src$v_unit]);
%FI
%IF %BLISS(BLISS36)
%THEN
     $FAO_PUT (.depth, 'TRA_SRC$V_UNIT : !OL', .trans [tra_src$v_unit]);
%FI

$FAO_PUT (.depth, 'TRA_SRC$V_LENGTH : !ZL', .trans [tra_src$v_length]);
$FAO_PUT (.depth, 'TRA_SRC$V_SCALE : !ZL', .trans [tra_src$v_scale]);
$FAO_PUT (.depth, 'TRA_SRC$V_OFFSET : !ZL', .trans [tra_src$v_offset]);

! data type fields
$FAO_PUT (.depth, 'TRA_SRC$V_TYPE : !ZL', .trans [tra_src$v_type]);
depth = .depth + 1;
  $FAO_PUT (.depth, 'TRA_SRC$V_DT_TYPE : !ZL', .trans [tra_src$v_dt_type]);
  $FAO_PUT (.depth, 'TRA_SRC$V_DT_CLASS : !ZL', .trans [tra_src$v_dt_class]);
depth = .depth - 1;

$FAO_PUT (.depth, 'TRA_SRC$V_ALIGN : !ZL', .trans [tra_src$v_align]);
$FAO_PUT (.depth, 'TRA_SRC$V_SYS_ORIG : !ZL', .trans [tra_src$v_sys_orig]);

END;                                    ! end of routine DIU$DMP_TRA_SRC

!*****************************************************************
!                  D I U $ D M P _ T R A _ D S T
!*****************************************************************
GLOBAL ROUTINE DIU$DMP_TRA_DST (trans, depth) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION
!
!	Routine to dump out the destination portion of the transform
!       structure.  Used mainly for debugging.
!
! FORMAL PARAMETERS
!
!	trans		Address of the first node in the transform list.
!
!	depth		Used for indentation (for $FAO_PUT macro).
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!--
BEGIN

MAP trans : REF transform_str;

LOCAL status : INITIAL(0),
      tmp : INITIAL (0);

! make sure TRA_ID is correctly set to DIU$K_TRANSFORM
tmp = .trans [tra_id];
IF .tmp NEQ DIU$K_TRANSFORM
THEN $FAO_PUT (.depth, 'TRA_ID :  ***UNKNOWN***');

%IF %BLISS(BLISS32)
%THEN
     $FAO_PUT (.depth, 'TRA_DST_ADDR : !XL', .trans [tra_dst_addr]);
%FI
%IF %BLISS(BLISS36)
%THEN
     $FAO_PUT (.depth, 'TRA_DST_ADDR : !OL', .trans [tra_dst_addr]);
%FI

! display member name
DIU$DMP_MEMBER_NAME (.trans [tra_dst_addr], .depth);

! dump destination FQN stringlist
%IF %BLISS (BLISS32)
%THEN
     $FAO_PUT (.depth, 'FQN for destination at !XL is: ', .trans [tra_dst_nam]);
%FI
%IF %BLISS (BLISS36)
%THEN
     $FAO_PUT (.depth, 'FQN for destination at !OL is: ', .trans [tra_dst_nam]);
%FI
DIU$DUMP_FQN (.trans [tra_dst_nam], .depth+1);

! dump destination DIMS structure
%IF %BLISS (BLISS32)
%THEN
     $FAO_PUT (.depth, 'DIMS for destination at !XL is: ', .trans [tra_dst_dims]);
%FI
%IF %BLISS (BLISS36)
%THEN
     $FAO_PUT (.depth, 'DIMS for destination at !OL is: ', .trans [tra_dst_dims]);
%FI
DIU$DUMP_DIMS (.trans [tra_dst_dims], .depth+1);

%IF %BLISS(BLISS32)
%THEN
     $FAO_PUT (.depth, 'TRA_DST$V_UNIT : !XL', .trans [tra_dst$v_unit]);
%FI
%IF %BLISS(BLISS36)
%THEN
     $FAO_PUT (.depth, 'TRA_DST$V_UNIT : !OL', .trans [tra_dst$v_unit]);
%FI

$FAO_PUT (.depth, 'TRA_DST$V_LENGTH] : !ZL', .trans [tra_dst$v_length]);
$FAO_PUT (.depth, 'TRA_DST$V_SCALE] : !ZL', .trans [tra_dst$v_scale]);
$FAO_PUT (.depth, 'TRA_DST$V_OFFSET : !ZL', .trans [tra_dst$v_offset]);

! data type fields
$FAO_PUT (.depth, 'TRA_DST$V_TYPE : !ZL', .trans [tra_dst$v_type]);
depth = .depth + 1;
  $FAO_PUT (.depth, 'TRA_DST$V_DT_TYPE : !ZL', .trans [tra_dst$v_dt_type]);
  $FAO_PUT (.depth, 'TRA_DST$V_DT_CLASS : !ZL', .trans [tra_dst$v_dt_class]);
depth = .depth - 1;

$FAO_PUT (.depth, 'TRA_DST$V_ALIGN : !ZL', .trans [tra_dst$v_align]);
$FAO_PUT (.depth, 'TRA_DST$V_SYS_ORIG : !ZL', .trans [tra_dst$v_sys_orig]);

END;                                    ! end of routine DIU$DMP_TRA_DST

!*****************************************************************
!             D I U $ D U M P _ T R A N S F O R M
!*****************************************************************
GLOBAL ROUTINE DIU$DUMP_TRANSFORM (trans) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION
!
!	Routine to dump out the entire transform structure,
!	node by node.  Used mainly for debugging.
!
!
!                          NOTE
!
!       Due to a BLISS-36 bug, this routine had to be split up so
!       that it would compile.  The compiler kept running out of
!       dynamic memory...  So the routine was split into the two
!       routines DIU$DMP_TRA_SRC and DIU$DMP_TRA_DST.
!
!
! FORMAL PARAMETERS
!
!	trans		Address of the first node in the transform list.
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!--
BEGIN

MAP trans : REF transform_str;

LOCAL status : INITIAL(0);

LOCAL depth : INITIAL (0),
      tmp : INITIAL (0);

IF .trans EQL 0		! Transform is empty if the address is 0.
THEN BEGIN
     ! Tell the user that the transform is empty
     $FAO_PUT (1, '** Empty **');
     END
ELSE
     DO BEGIN
	depth = 0;
	$FAO_PUT (.depth, ' ');	! blank line
	$FAO_PUT (.depth, ' ');	! blank line
	$FAO_PUT (.depth, 'Transform node is as follows: ');
	tmp = .trans [tra_id];

	! make sure TRA_ID is correctly set to DIU$K_TRANSFORM
	IF .tmp EQL DIU$K_TRANSFORM
	   THEN $FAO_PUT (.depth, 'TRA_ID :  DIU$K_TRANSFORM')
	   ELSE $FAO_PUT (.depth, 'TRA_ID :  ***UNKNOWN***');

        ! Call DIU$DMP_TRA_SRC to dump the source portion of the
        ! transform structure.
        DIU$DMP_TRA_SRC (.trans, .depth);

        ! Call DIU$DMP_TRA_SRC to dump the destination portion of
        ! the transform structure.
        DIU$DMP_TRA_DST (.trans, .depth);

        %IF %BLISS (BLISS32)
        %THEN
	$FAO_PUT (.depth, 'TRA_WORST : !XL', .trans [tra_worst]);
	$FAO_PUT (.depth, 'TRA_OPCODE : !XL', .trans [tra_opcode]);
	$FAO_PUT (.depth, 'TRA_NEXT : !XL', .trans [tra_next]);
        %FI

        %IF %BLISS (BLISS36)
        %THEN
	$FAO_PUT (.depth, 'TRA_WORST : !OL', .trans [tra_worst]);
	$FAO_PUT (.depth, 'TRA_OPCODE : !OL', .trans [tra_opcode]);
	$FAO_PUT (.depth, 'TRA_NEXT : !OL', .trans [tra_next]);
        %FI

	! next node...
	trans = .trans [tra_next];

	END ! end of DO loop

UNTIL .trans EQL 0;	! Stop when there are no more transform nodes

END;

END
ELUDOM