Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/diucle.bli
There are 4 other files named diucle.bli in the archive. Click here to see a list.
%TITLE 'Clean Up Tranform'
MODULE DIUCLE(
       IDENT='253'
       %BLISS32 (,
                 ADDRESSING_MODE(EXTERNAL=GENERAL,NONEXTERNAL=LONG_RELATIVE)
                )
       %BLISS36 (,
                 ENTRY (deldim, deltra, deltnd, cletra)
                )
                      ) = 
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 "clean up" the DIU transform structure.
!		This means, delete any node which has source information,
!		but no corresponding destination information.
!
! AUTHOR:	Sandy Clemens, Creation Date:  25-Oct-84
!
! EDIT HISTORY:
!
!  253  Change libraries to new names.
!       Gregory A. Scott 1-Jul-86
!
!  236  Change library of DIXLIB to DIUDIX.
!       Sandy Clemens  19-Jun-86
!
!       3	Clean up copyright notice.  Change LIBRARY 'DIUMSG'
!               to 'DIU'.  Clean up condition handling.
!               Sandy Clemens	14-Jun-85
!--
!********************************************************************
!           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';
     LIBRARY 'DIUACTION';
%FI

UNDECLARE %QUOTE $DESCRIPTOR;
LIBRARY 'DIUCRX';                       ! CRX data structures
UNDECLARE %QUOTE $DESCRIPTOR;
LIBRARY 'DIUTLB';			! DIU Transform structure
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

EXTERNAL ROUTINE free_stringlist;
!******************************************************************
!                   D I U $ D E L _ D I M S
!******************************************************************
GLOBAL ROUTINE DIU$DEL_DIMS (dimlst) : NOVALUE =
!++
!
! FUNCTIONAL DESCRIPTION
!	
!	This routine releases the memory used by a dims list
!	structure.  Used as part of the procedure for transform
!	node clean up.
!
! FORMAL PARAMETERS
!
!	dimlst		Address of the dims structure.
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!
!--
BEGIN

LOCAL dims_loc : REF dims,
      next_dims : INITIAL (0);

dims_loc = .dimlst;

IF .dims_loc NEQ 0
THEN DO BEGIN
        next_dims = .dims_loc [dims$a_next];
        $XPO_FREE_MEM (BINARY_DATA = (dims$k_size, .dims_loc, FULLWORDS));
        dims_loc = .next_dims;          ! next node
        END
     UNTIL .dims_loc EQL 0;

END;
!******************************************************************
!               D I U $ D E L _ T R A N S _ N O D E
!******************************************************************
GLOBAL ROUTINE DIU$DEL_TRANS_NODE (tnode) : NOVALUE =
!++
!
! FUNCTIONAL DESCRIPTION
!	
!	This routine releases the memory used by a single transform
!       node.   NOTE:  This routine releases memory used for
!	any fully qualified name structures and DIMS structures
!       who's addresses are stored in the transform node.
!
! FORMAL PARAMETERS
!
!	tnode		Address of the transform node.
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!
!--
BEGIN

LOCAL tra_loc : REF transform_str,
      status : INITIAL (0);

tra_loc = .tnode;

IF .tra_loc NEQ 0
THEN BEGIN
     IF .tra_loc [tra_id] NEQ DIU$K_TRANSFORM
     THEN SIGNAL (DIU$_BUG);
     IF .tra_loc [tra_src_nam] NEQ 0    ! delete src fqn stringlist
     THEN FREE_STRINGLIST (.tra_loc [tra_src_nam]);
     IF .tra_loc [tra_dst_nam] NEQ 0    ! delete dst fqn stringlist
     THEN FREE_STRINGLIST (.tra_loc [tra_dst_nam]);
     DIU$DEL_DIMS (.tra_loc [tra_src_dims]);    ! del src dims structure
     DIU$DEL_DIMS (.tra_loc [tra_dst_dims]);    ! del dst dims structure
     ! delete the transform_str node
     $XPO_FREE_MEM (BINARY_DATA = (tra_size, .tra_loc, FULLWORDS));
     END

END;
!******************************************************************
!               D I U $ D E L _ T R A N S _ L I S T
!******************************************************************
GLOBAL ROUTINE DIU$DEL_TRANS_LIST (trans) : NOVALUE =
!++
!
! FUNCTIONAL DESCRIPTION
!	
!	This routine releases the memory used by a transform list
!	structure.  NOTE:  This routine releases memory used for
!	any fully qualified name structures and DIMS structures
!       who's addresses are stored in the transform.
!
! FORMAL PARAMETERS
!
!	trans		Address of the transform list.
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	None
!
!--
BEGIN

LOCAL tra_loc : REF transform_str,
      next_tra : INITIAL (0),
      status : INITIAL (0);

tra_loc = .trans;

IF .tra_loc NEQ 0
THEN DO BEGIN
	IF .tra_loc [tra_id] NEQ DIU$K_TRANSFORM
	THEN SIGNAL (DIU$_BUG);
	next_tra = .tra_loc [tra_next];
        DIU$DEL_TRANS_NODE (.tra_loc);
	tra_loc = .next_tra
	END
     UNTIL .tra_loc EQL 0;

END;
!******************************************************************
!                   D I U $ C L E A N _ T R A N S
!******************************************************************
GLOBAL ROUTINE DIU$CLEAN_TRANS (trans) =
!++
! FUNCTIONAL DESCRIPTION
!	
!	This routine cleans up the DIU transform by removing the
!	transform nodes which have source information but for which
!	there was no matching destination field.
!
! FORMAL PARAMETERS
!
!	trans		Address of the transform list;  will be altered
!			only if the first transform node gets deleted.
!
! IMPLICIT PARAMETERS
!
!	None
!
! ROUTINE VALUE
!
!	Address of the transform list.
!
!--

BEGIN

MAP trans : REF transform_str;

LOCAL prev : REF transform_str,         ! Previous transform node processed
      tmp : REF transform_str,          ! Temporary pointer to transform node
      ret_addr : REF transform_str,     ! Addr of first trans node, to return
      status : INITIAL (0);

ret_addr = .trans;		! The return address will be the address
				! passed, unless the first node is deleted.
prev = 0;			! Set PREV to 0, since there was no previous
				! node at this point.

DO BEGIN
   ! First see if the address passed actually is the address of
   ! a transform list...
   IF .trans [tra_id] NEQ DIU$K_TRANSFORM
   THEN SIGNAL (DIU$_BUG);

   !++
   ! If no name was assigned to the destination name field in the transform
   ! then the destination was not filled in, and therefore there was NOT a
   ! match found for the source field (ie, no matching field found in the
   ! destination).  Therefore, delete this transform node.
   !--

   IF .trans [tra_dst_nam] EQL 0	! If no name was assigned to dst name
   THEN BEGIN				! then remove the node

	tmp = .trans [tra_next];        ! save NEXT address to set TRANS to!

        DIU$DEL_TRANS_NODE (.trans);    ! delete unwanted transform node

	!++
	! If PREV is not 0, then this node is not the 1st node in the transform
	! list, so make PREV point to the new NEXT node...  If PREV is equal to
	! 0, then this node is the first node in the transform, so make ADDR
	! reflect a new starting node, and leave PREV equal to 0, since there
	! is still not a "previous" node assigned!
	!--
	IF .prev NEQ 0
	THEN
	     prev [tra_next] = .tmp
	ELSE
	     ret_addr = .tmp;

	! Reset trans so that it now points at the next node to look at.
	trans = .tmp

	END
   ELSE
	!++
	! If the destination transform name is filled in then simply go look
	! at the next node by setting PREV to the current node and setting
	! trans to the next node to process.
	!--
	BEGIN
	prev = .trans;
	trans = .trans[tra_next]
	END
   END
UNTIL .trans EQL 0;		! Process nodes until there are no more!

.ret_addr			! Return address of the first transform node

END;

END
ELUDOM