C
C This program assumes that the files DECDTM$EXAMPLE1.FILE_1 and
C DECDTM$EXAMPLE1.FILE_2 are created and marked for recovery unit
C journaling using the command file SYS$EXAMPLES:DECDTM$EXAMPLE1.COM
C
C To run this example, enter the following:
C   $ FORTRAN SYS$EXAMPLES:DECDTM$EXAMPLE1
C   $ LINK DECDTM$EXAMPLE1
C   $ @SYS$EXAMPLES:DECDTM$EXAMPLE1
C   $ RUN DECDTM$EXAMPLE1
C
C
C SYS$EXAMPLES also contains an example C application, DECDTM$EXAMPLE2.C
C The C application performs the same operations as this Fortran example.
C
        IMPLICIT    NONE

        INCLUDE     '($SSDEF)'
        INCLUDE     '($FORIOSDEF)'

        CHARACTER*12 STRING
        INTEGER*2   IOSB(4)
        INTEGER*4   STATUS,COUNT,TID(4)
        INTEGER*4   SYS$START_TRANSW,SYS$END_TRANSW,SYS$ABORT_TRANSW
        EXTERNAL    SYS$START_TRANSW,SYS$END_TRANSW,SYS$ABORT_TRANSW
        EXTERNAL    JOURNAL_OPEN
C
C Open the two files
C
(1)        OPEN (UNIT = 10, FILE = 'DECDTM$EXAMPLE1.FILE_1', STATUS = 'OLD',
        1     ACCESS = 'DIRECT', RECL = 3, USEROPEN = JOURNAL_OPEN)
        OPEN (UNIT = 11, FILE = 'DECDTM$EXAMPLE1.FILE_2', STATUS = 'OLD',
        1     ACCESS = 'DIRECT', RECL = 3, USEROPEN = JOURNAL_OPEN)

        COUNT = 0

        TYPE *, 'Running DECdtm example program'
        TYPE *, 'Press CTRL-Y to interrupt'
C
C Loop forever, updating both files under transaction control
C
        DO WHILE (.TRUE.)
C
C Update the count and convert it to ASCII
C
(2)          COUNT = COUNT + 1
          ENCODE (12,8000,STRING) COUNT
8000      FORMAT (I12)
C
C Start the transaction
C
(3)          STATUS = SYS$START_TRANSW (%VAL(1),,IOSB,,,TID)
          IF (STATUS .NE. SS$_NORMAL .OR. IOSB(1) .NE. SS$_NORMAL) GO TO 9040
C
C Update the record in each file
C
(4)          WRITE (UNIT = 10, REC = 1, ERR = 9000, IOSTAT = STATUS) STRING
          WRITE (UNIT = 11, REC = 1, ERR = 9010, IOSTAT = STATUS) STRING
C
C Attempt to commit the transaction
C
(5)          STATUS = SYS$END_TRANSW (%VAL(1),,IOSB,,,TID)
          IF (STATUS .NE. SS$_NORMAL .OR. IOSB(1) .NE. SS$_NORMAL) GO TO 9050

        END DO
C
C Errors that should cause the transaction to abort
C
(6)
9000    TYPE *, 'Failed to update DECDTM$EXAMPLE1.FILE_1'
        GO TO 9020

9010    TYPE *, 'Failed to update DECDTM$EXAMPLE1.FILE_2'
9020    STATUS = SYS$ABORT_TRANSW (%VAL(1),,IOSB,,,TID)
        IF (STATUS .NE. SS$_NORMAL .OR. IOSB(1) .NE. SS$_NORMAL) GO TO 9060
        STOP
C
C Errors from DECdtm system services
C
9040    TYPE *, 'Unable to start a transaction'
        GO TO 9070
9050    TYPE *, 'Failed to commit the transaction'
        GO TO 9070
9060    TYPE *, 'Failed to abort the transaction'
9070    TYPE *, 'Status = ', STATUS, ' IOSB = ', IOSB(1)
        END
C
C Switch off TRUNCATE access and PUT with truncate on OPEN for RU Journaling
C
        INTEGER FUNCTION JOURNAL_OPEN (FAB, RAB, LUN)

        INCLUDE '($FABDEF)'
        INCLUDE '($RABDEF)'
        INCLUDE '($SYSSRVNAM)'

        RECORD  /FABDEF/ FAB, /RABDEF/ RAB

        FAB.FAB$B_FAC = FAB.FAB$B_FAC .AND. .NOT. FAB$M_TRN
        RAB.RAB$L_ROP = RAB.RAB$L_ROP .AND. .NOT. RAB$M_TPT

        JOURNAL_OPEN = SYS$OPEN (FAB)
        IF (.NOT. JOURNAL_OPEN) RETURN
        JOURNAL_OPEN = SYS$CONNECT (RAB)

        RETURN
        END

    #include <ddtmdef.h>
    #include <ddtmmsgdef.h>
    #include <descrip.h>
    #include <dtidef.h>
    #include <iosbdef.h>
    #include <ssdef.h>
    #include <starlet.h>
    #include <stsdef.h>

struct taos {
    uint    tmLogId[4];    /* transaction manager log ID */
    uint    efn;                 /* event flag for TAOS operations */
    uint    rmId;                       /* resource manager ID */

    struct dsc$descriptor_s  resNameDsc;  /* resource name */
    char        resName[24];      /* "TAOS____" + array ID */
};

int taos_Open(...) {


    int     status;
    IOSB    iosb;
    BOOL    declaredRm = FALSE;

    status = sys$declare_rmw(pTaos->efn, 0, &iosb, NULL, 0, &pTaos->rmId,
                         &HandleEvent, &pTaos->resNameDsc, NULL,
                         0, pTaos->tmLogId, 0);

            if (SUCCESS(status))
                status = iosb.iosb$w_status;
            if (SUCCESS(status))
                declaredRm = TRUE;

    return status;
}

int taos_Write(.., uint pTid[4]) {

    int     status;

    /* get transaction ID */
    if (pTid != NULL)
                CopyUid(tid, pTid);
    else {
                status = sys$get_default_trans(tid);
        if (FAILURE(status))
                    return status;
        }

    /* if this is a new transaction, join it */
    if (GetParticipantData(pTaos, tid, &pPart)) {

        status = sys$join_rmw(pTaos->efn, 0, &iosb, NULL, 0,
                               pTaos->rmId, tid, NULL, pPart);
        if (SUCCESS(status))
                    status = iosb.iosb$w_status;
                if (FAILURE(status))
                    return status;
    }
}

static int HandleEvent(DDTM$R_REPORTDEF *pReport) {

    struct taos         *pTaos;


    switch (pReport->ddtm$l_event_type) {


    case DDTM$K_PREPARE:
                Prepare(pReport);
                break;

    case DDTM$K_ABORT:
                Abort(pReport);
                break;

    case DDTM$K_ONE_PHASE_COMMIT:
                OnePhaseCommit(pReport);
                break;

    case DDTM$K_COMMIT:
                Commit(pReport);
                break;

    return SS$_NORMAL;
}

/* Abort the transaction */

static void Abort(DDTM$R_REPORTDEF *pReport) {


    struct part    *pPart = (struct part *) pReport->ddtm$l_rm_context;

    /* Undo the transaction here, using the list of resources
     * attached to the part structure.
     */

    /* DECdtm can forget the transaction */
    sys$ack_event(0, pReport->ddtm$l_report_id, SS$_FORGET);
}

/* Prepare transaction (phase 1 commit) */

static void Prepare(DDTM$R_REPORTDEF *pReport) {

    int     status = SS$_NORMAL;
    BOOL    updates = FALSE;

    /* Save updates on disk, using the list of resources attached to
     * the part structure. Set updates if there are any. Set status
     * on error;

    /* vote on transaction */

    if (FAILURE(status))
                status = SS$_VETO;     /* can't prepare, so abort tran */
    else if (!updates)
                status = SS$_FORGET;   /* read-only transaction */
    else
                status = SS$_PREPARED;  /* ready to commit or abort */

    sys$ack_event(0, pReport->ddtm$l_report_id, status);
}

/* Commit transaction (phase 2) */

static void Commit(DDTM$R_REPORTDEF *pReport) {

    int     status = SS$_NORMAL;

    /* Make updates permanent and visible to other users here.
     * Set status on error.
     */

    if (SUCCESS(status))
        status = SS$_FORGET;        /* DECdtm can forget transaction */
    else {
        /* We can't commit the transaction yet. We must ask DECdtm to
         * remember the transaction, and we must terminate operations
         * until a successful recovery is performed.
         */
                pTaos->status = status;
                status = SS$_REMEMBER;
    }

    /* acknowledge event */
    sys$ack_event(0, pReport->ddtm$l_report_id, status);
}

/* Prepare and commit transaction in a single phase */

static void OnePhaseCommit(DDTM$R_REPORTDEF *pReport) {

    int     status = SS$_NORMAL;

    /* Combine operations from Prepare() and Commit() here.
     * Set status on error.
     */

    /* report outcome to DECdtm */
    if (FAILURE(status))
        status = SS$_VETO;    /* aborted */
    else
        status = SS$_NORMAL;  /* committed */
        status = SS$_NORMAL;  /* committed */

    sys$ack_event(0, pReport->ddtm$l_report_id, status);
}

/* Recover the state of a prepared resource after a failure */

RecoverString(...) {


    int     status;
    IOSB    iosb;
    uint    context = 0;      /* context from $GETDTI */
    int     retlen;
    Int     state;          /* transaction state */

    DTIRECDEF  dti;

    ITMLST3_DECL (search, 1);
    ITMLST3_ITEM (search, 0, DTI$_SEARCH_RESOLVED_STATE,
                  DTI$S_TRANSACTION_INFORMATION, &dti, 0);
                  DTI$S_TRANSACTION_INFORMATION, &dti, 0);
    ITMLST3_END (search);

    ITMLST3_DECL (result, 1);
    ITMLST3_ITEM (result, 0, DTI$_TRANSACTION_INFORMATION,
                  DTI$S_TRANSACTION_INFORMATION, &dti, &retlen);
    ITMLST3_END (result);

    /* get final state of transaction */
    dti.dti$b_part_name_len = 0;        /* no RM name specified */
            CopyUid((uint *) dti.dti$t_tid, pTaos->stringBuf.tid);
    status = sys$getdtiw(pTaos->efn, DDTM$M_FULL_STATE, &iosb, NULL, 0,
                                 pTaos->tmLogId, &context, &search, &result);
    if (SUCCESS(status))
                status = iosb.iosb$w_status;
            if (SUCCESS(status))
                state = dti.dti$b_state;

    /* treat forgotten TID as presumed abort */
    if (status == SS$_NOSUCHTID) {
                state = DTI$K_ABORTED;
                status = SS$_NORMAL;
    }

    if (SUCCESS(status)) {
                switch (state) {
        case DTI$K_COMMITTED:
                    /* Make update permanent and visible here.
             * Set status on error. */
                    break;

                case DTI$K_ABORTED:
                    /* Undo the update here. Set status on error. */
                    break;
        }
    }
    if (SUCCESS(status)) {
        /* allow DECdtm to remove this RM from the transaction */
        status = sys$setdtiw(pTaos->efn, 0, &iosb, NULL, 0, &context
                               DTI$K_DELETE_RM_NAME, &result);
    }
}

MODULE RECOVER_TRANSACTION (MAIN=MAIN)=
BEGIN

    LIBRARY'SYS$LIBRARY:STARLET';

    FORWARD ROUTINE
        MAIN,
        AST_COMPLETION_ROUTINE : NOVALUE;

    ROUTINE MAIN =
    BEGIN
        OWN
            STATUS
                : LONG UNSIGNED,
            IOSB
                : VECTOR [4,WORD],
            SEARCH_CONTEXT
                : LONG UNSIGNED
                    INITIAL (0),
            PART_LOG_ID
                : $BBLOCK [DTI$S_PART_LOG_ID]
                    INITIAL (REP DTI$S_PART_LOG_ID OF BYTE (0)),
            TM_LOG_ID
                : $BBLOCK [DTI$S_PART_LOG_ID]
                    INITIAL (REP DTI$S_PART_LOG_ID OF BYTE (0)),
            TID
                : $BBLOCK [DTI$S_TID]
                    INITIAL (REP DTI$S_TID OF BYTE (0)),
            SEARCH_LIST
                : $ITMLST_DECL (ITEMS=2),
            ITEM_LIST
                : $ITMLST_DECL (ITEMS=1),
            TRANS_INFO
                : $BBLOCK [DTI$S_TRANSACTION_INFORMATION];
        BIND
            SEARCH_NODE_NAME = UPLIT (%ASCII'MYNODE'),
            RESOURCE_MANAGER = UPLIT (%ASCII'FRED');
        LITERAL
            SEARCH_NODE_NAME_LENGTH = %CHARCOUNT ('MYNODE'),
            RESOURCE_MANAGER_LENGTH = %CHARCOUNT ('FRED');

        ! Resource manager opens recovery log and reads first resolved
        ! recovery record. The information in the recovery record
        ! should contain the transaction identifier, resource manager
        ! log identifier and transaction manager log identifier. This
        ! information is written into the transaction information
        ! record.

        CH$MOVE (DTI$S_TID,
                 TID,
                 TRANS_INFO [DTI$T_TID]);
        CH$MOVE (DTI$S_PART_LOG_ID,
                 PART_LOG_ID,
                 TRANS_INFO [DTI$T_PART_LOG_ID]);
        CH$MOVE (RESOURCE_MANAGER_LENGTH,
                 .RESOURCE_MANAGER,
                 TRANS_INFO [DTI$T_PART_NAME]);
        TRANS_INFO [DTI$B_PART_NAME_LEN] = RESOURCE_MANAGER_LENGTH;

        ! The search item list is initialized with a node
        ! name and transaction information record.

        $ITMLST_INIT (ITMLST=SEARCH_LIST,
                      (ITMCOD=DTI$_SEARCH_AS_NODE,
                       BUFADR=.SEARCH_NODE_NAME,
                       BUFSIZ=SEARCH_NODE_NAME_LENGTH),
                      (ITMCOD=DTI$_SEARCH_RESOLVED_STATE,
                       BUFADR=TRANS_INFO,
                       BUFSIZ=DTI$S_TRANSACTION_INFORMATION));

        ! The item list is initialized to return a transaction
        ! information record containing the resolved state of the
        ! transaction.
        ! transaction.

        $ITMLST_INIT (ITMLST=ITEM_LIST,
                      (ITMCOD=DTI$_TRANSACTION_INFORMATION,
                       BUFADR=TRANS_INFO,
                       BUFSIZ=DTI$S_TRANSACTION_INFORMATION));

        ! A $GETDTI is now performed to return the state of the
        ! transaction and the node name.

        STATUS = $GETDTIW (EFN=10,
                           FLAGS=DDTM$M_FULL_STATE,
                           IOSB=IOSB,
                           ASTADR=AST_COMPLETION_ROUTINE,
                           ASTPRM=0,
                           CONTXT=SEARCH_CONTEXT,
                           LOG_ID=TM_LOG_ID,
                           SEARCH=SEARCH_LIST,
                           ITMLST=ITEM_LIST);

        ! If the transaction was committed then perform resource manager
        ! recovery and then delete the resource manager from the
        ! transaction.

        IF .TRANS_INFO [DTI$B_STATE] EQLU DTI$K_COMMITTED THEN
            STATUS = $SETDTIW (EFN=10,
                               FLAGS=0,
                               IOSB=IOSB,
                               ASTADR=AST_COMPLETION_ROUTINE,
                               ASTPRM=0,
                               CONTXT=SEARCH_CONTEXT,
                               FUNC=DTI$K_DELETE_RM_NAME,
                               ITMLST=ITEM_LIST);

        RETURN .STATUS
    END;

    ROUTINE AST_COMPLETION_ROUTINE (ASTPRM : LONG UNSIGNED) : NOVALUE =
    BEGIN
        RETURN;
    END;
END
ELUDOM