drstpl.f

Go to the documentation of this file.

C> @file
C> @brief Search for a specified mnemonic within unexpanded sequences
C> of the internal jump/link table.
C> @author Woollen @date 1994-01-06
 
C> This subroutine is called by subroutine
C> ufbrw() whenever it can't find a mnemonic it wants to write within the
C> current subset buffer. It looks for the mnemonic within any
C> unexpanded "drs" (stack) or "drb" (1-bit delayed replication)
C> sequences inside of the portion of the subset buffer bounded by the
C> indices inv1 and inv2. If found, it expands the applicable "drs" or
C> "drb" sequence to the point where the mnemonic in question now
C> appears in the subset buffer, and in doing so it will also return
C> a new value for inv2.
C>
C> @param[in] INOD - integer: jump/link table index of mnemonic to look for.
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C> @param[in] INV1 - integer: starting index of the portion of the subset
C> buffer currently being processed by ufbrw().
C> @param[inout] INV2 - integer:
C>  - on input, ending index of the portion of the subset buffer currently
C>    being processed by ufbrw().
C>  - on output, if invn = 0 then inv2 is unchanged from its input value.
C>    Otherwise, it contains the redefined ending index of the portion of the subset
C>    buffer currently being processed by ufbrw(), since expanding a delayed
C>    replication sequence will have necessarily increased the size of this buffer.
C> @param[out] INVN - integer: location index of inod within subset buffer.
C>  - 0 not found.
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE drstpl(INOD,LUN,INV1,INV2,INVN)
 
      USE moda_tables
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
1     node = inod
2     node = jmpb(node)
      IF(node.EQ.0) GOTO 100
      IF(typ(node).EQ.'DRS' .OR. typ(node).EQ.'DRB') THEN
         invn = invwin(node,lun,inv1,inv2)
         IF(invn.GT.0) THEN
            CALL usrtpl(lun,invn,1)
            CALL newwin(lun,inv1,inv2)
            invn = invwin(inod,lun,invn,inv2)
            IF(invn.GT.0) GOTO 100
            GOTO 1
         ENDIF
      ENDIF
      GOTO 2
 
C  EXIT
C  ----
 
100   RETURN
      END