-- $Source: /commtar/monoBANK/RTS/tKtxnsf.ada,v $ -- $Revision: 1.2 $ $Date: 88/06/28 15:58:48 $ $Author: stt $ package RTS_CICS_Transaction_Start_Finish_Pkg is --| Overview --| This package provides a general means for --| queuing up actions to be performed at start --| and finish of a transaction. Start_Transaction --| actions are performed after elaboration, but --| before executing the main subprogram. --| Finish_Transaction actions are executed after --| exiting the main subprogram, before returning --| to CICS or chaining to a new transaction. --| Start_Transaction actions are executed in order --| of request; Finish_Transactions actions are executed --| in reverse order of request. --| NOTE: The generic packages should ONLY be instantiated --| from library-unit packages. generic with procedure Action; package Start_Transaction_Action is --| Instantiate this package to queue up a start-txn action end Start_Transaction_Action; generic with procedure Action; package Finish_Transaction_Action is --| Instantiate this package to queue up a finish-txn action end Finish_Transaction_Action; procedure Do_Start_Actions; pragma Link_Name(Do_Start_Actions, "TXN$STRT"); --| This procedure is called just prior to calling --| the main subprogram for each transaction procedure Do_Finish_Actions; pragma Link_Name(Do_Finish_Actions, "TXN$FINI"); --| This procedure is called just after calling --| the main subprogram for each transaction end RTS_CICS_Transaction_Start_Finish_Pkg; with System; with Unchecked_Conversion; package body RTS_CICS_Transaction_Start_Finish_Pkg is type Action_Record; type Action_Ptr is access Action_Record; type Action_Record is record --| Type of record used for list of actions Addr : System.Address; Next : Action_Ptr; end record; function To_Action_Ptr is new Unchecked_Conversion( System.Address, Action_Ptr ); First_Start_Action, Last_Start_Action : Action_Ptr; --| List header for start actions First_Finish_Action : Action_Ptr; --| List header for finish actions package body Start_Transaction_Action is The_Action : Action_Record; begin The_Action.Addr := Action'ADDRESS; -- Link into start-action chain declare The_Action_Ptr : constant Action_Ptr := To_Action_Ptr(The_Action'ADDRESS); begin if Last_Start_Action /= null then -- Add to end of list Last_Start_Action.next := The_Action_Ptr; else -- Add to front of list First_Start_Action := The_Action_Ptr; end if; Last_Start_Action := The_Action_Ptr; end; -- declare end Start_Transaction_Action; package body Finish_Transaction_Action is The_Action : Action_Record; begin The_Action.Addr := Action'ADDRESS; -- Link into front of finish-action chain The_Action.Next := First_Finish_Action; First_Finish_Action := To_Action_Ptr(The_Action'ADDRESS); end Finish_Transaction_Action; procedure Call_Ada(Addr : System.Address); pragma Interface(AIE_Assembler, Call_Ada); pragma Link_Name(Call_Ada, "ADA@ADA"); --| This procedure calls an Ada procedure, given its address procedure Do_Start_Actions is --| This procedure is called just prior to calling --| the main subprogram for each transaction --| It invokes each action on the Start_Action list Ptr : Action_Ptr := First_Start_Action; begin while Ptr /= null loop Call_Ada(Ptr.Addr); Ptr := Ptr.next; end loop; end Do_Start_Actions; procedure Do_Finish_Actions is --| This procedure is called just after calling --| the main subprogram for each transaction --| It invokes each action on the Finish_Action list Ptr : Action_Ptr := First_Finish_Action; begin while Ptr /= null loop Call_Ada(Ptr.Addr); Ptr := Ptr.next; end loop; end Do_Finish_Actions; end RTS_CICS_Transaction_Start_Finish_Pkg; -- $Cprt start$ -- -- Copyright (C) 1988 by Intermetrics, Inc. -- -- This material may be used duplicated or disclosed by or for the -- U.S. Government pursuant to the copyright license under DAR clause -- 7-104.9(a) (May 1981). -- -- This project was spnsored by the STARS Foundation -- Naval Research Laboratory, Washington DC -- -- $Cprt end$