Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/diu/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