MODULE RUFEXAMPLE (ADDRESSING_MODE (NONEXTERNAL = WORD_RELATIVE, 
    				    EXTERNAL = GENERAL), 
    		   MAIN = RUFEXAMPLE$MAIN) =
BEGIN

LIBRARY 'SYS$LIBRARY:STARLET';

EXTERNAL ROUTINE
    LIB$PUT_OUTPUT,
    LIB$WAIT;


GLOBAL ROUTINE RUFEXAMPLE$MAIN =
!++
!
! Main entry point
!
!--
BEGIN

LITERAL
    KEY_LEN = 9,
    KEY_POS = 0,
    BALANCE_LEN = 4,
    BALANCE_POS = 9,
    FILLER_LEN = 5,
    FILLER_POS = 13,
    REC_LEN = 18;


LOCAL
    STATUS,
    DELAY : INITIAL (5),
    RU_HANDLE,
    OUTPUT_DESC : $BBLOCK [DSC$C_S_BLN],
    MESSAGE_BUF : VECTOR [CH$ALLOCATION (80)],
    CHECKING_FAB : $FAB_DECL,
    CHECKING_RAB : $RAB_DECL,
    SAVINGS_FAB  : $FAB_DECL,
    SAVINGS_RAB  : $RAB_DECL,
    CHECKING_RECORD : VECTOR [CH$ALLOCATION (REC_LEN)],
    SAVINGS_RECORD  : VECTOR [CH$ALLOCATION (REC_LEN)];

BIND 
    CHECKING_BALANCE = CHECKING_RECORD + BALANCE_POS,
    SAVINGS_BALANCE = SAVINGS_RECORD + BALANCE_POS;
!..

! Open the checking account file.

$FAB_INIT (
    FAB = CHECKING_FAB,
    FAC = (GET,PUT,UPD),
    FNM = 'RUF$CHECKING.DAT');

STATUS = $OPEN (FAB = CHECKING_FAB);
IF NOT .STATUS
THEN
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Error opening checking file.');
    SIGNAL_STOP (.CHECKING_FAB [FAB$L_STS], .CHECKING_FAB [FAB$L_STV]);
    END;

! Open the savings account file.

$FAB_INIT (
    FAB = SAVINGS_FAB,
    FAC = (GET,PUT,UPD),
    FNM = 'RUF$SAVINGS.DAT');

STATUS = $OPEN (FAB = SAVINGS_FAB);
IF NOT .STATUS
THEN 
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Error opening savings file.');
    SIGNAL_STOP (.SAVINGS_FAB [FAB$L_STS], .SAVINGS_FAB [FAB$L_STV]);
    END;

! Initialize the checking file to have an account number 1234 with a balance
! of $100. 

$RAB_INIT (
    RAB = CHECKING_RAB,
    FAB = CHECKING_FAB,
    KBF = CHECKING_RECORD,
    KSZ = KEY_LEN,
    RAC = KEY,
    UBF = CHECKING_RECORD,
    USZ = REC_LEN);

CH$MOVE (KEY_LEN, UPLIT ('000001234'), CH$PTR (CHECKING_RECORD, KEY_POS));
CH$MOVE (BALANCE_LEN, UPLIT (100), CH$PTR (CHECKING_RECORD, BALANCE_POS));
CH$FILL (' ', FILLER_LEN, CH$PTR (CHECKING_RECORD, FILLER_POS));

STATUS = $CONNECT (RAB = CHECKING_RAB);
IF NOT .STATUS
THEN 
    SIGNAL_STOP (.CHECKING_RAB [RAB$L_STS], .CHECKING_RAB [RAB$L_STV]);

! Initialize the savings file to have an account number 1234 with a balance
! of $100. 

$RAB_INIT (
    RAB = SAVINGS_RAB,
    FAB = SAVINGS_FAB,
    KBF = SAVINGS_RECORD,
    KSZ = KEY_LEN,
    RAC = KEY,
    UBF = SAVINGS_RECORD,
    USZ = REC_LEN);

CH$MOVE (KEY_LEN, UPLIT ('000001234'), CH$PTR (SAVINGS_RECORD, KEY_POS));
CH$MOVE (BALANCE_LEN, UPLIT (100), CH$PTR (SAVINGS_RECORD, BALANCE_POS));
CH$FILL (' ', FILLER_LEN, CH$PTR (SAVINGS_RECORD, FILLER_POS));

STATUS = $CONNECT (RAB = SAVINGS_RAB);
IF NOT .STATUS
THEN 
    SIGNAL_STOP (.SAVINGS_RAB [RAB$L_STS], .SAVINGS_RAB [RAB$L_STV]);

! Both files are opened. Start a recovery unit.

STATUS = $START_RU (RU_HANDLE = RU_HANDLE);
IF NOT .STATUS
THEN 
    BEGIN
    LIB$PUT_OUTPUT (
        %ASCID 'Cannot start recovery unit to initialize accounts.');
    SIGNAL_STOP (.STATUS);
    END;

CHECKING_RAB [RAB$L_RBF] = CHECKING_RECORD;
CHECKING_RAB [RAB$W_RSZ] = REC_LEN;
STATUS = $PUT (RAB = CHECKING_RAB);
IF NOT .STATUS
THEN 
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Checking account already exists.');
    SIGNAL_STOP (.CHECKING_RAB [RAB$L_STS], .CHECKING_RAB [RAB$L_STV]);
    END;

SAVINGS_RAB [RAB$L_RBF] = SAVINGS_RECORD;
SAVINGS_RAB [RAB$W_RSZ] = REC_LEN;
STATUS = $PUT (RAB = SAVINGS_RAB);
IF NOT .STATUS
THEN 
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Savings account already exists.');
    SIGNAL_STOP (.SAVINGS_RAB [RAB$L_STS], .SAVINGS_RAB [RAB$L_STV]);
    END;

! End the recovery unit

STATUS = $END_RU (RU_HANDLE = RU_HANDLE);
IF NOT .STATUS
THEN 
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Cannot end recovery unit to initialize accounts.');
    SIGNAL_STOP (.STATUS);
    END;

! Transfer $10 from checking to savings. Do this in the context of a recovery
! unit.

STATUS = $START_RU (RU_HANDLE = RU_HANDLE);
IF NOT .STATUS
THEN 
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Cannot start recovery unit to transfer funds.');
    SIGNAL_STOP (.STATUS);
    END;

! Read the savings and the checking records.
    
STATUS = $GET (RAB = CHECKING_RAB);
IF NOT .STATUS
THEN
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Cannot read checking account balance.');
    $ABORT_RU (RU_HANDLE = RU_HANDLE);
    SIGNAL_STOP (.CHECKING_RAB [RAB$L_STS], .CHECKING_RAB [RAB$L_STV]);
    END;

CHECKING_BALANCE = .CHECKING_BALANCE - 10;

STATUS = $UPDATE (RAB = CHECKING_RAB);
IF NOT .STATUS
THEN
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Cannot update checking account balance.');
    $ABORT_RU (RU_HANDLE = RU_HANDLE);
    SIGNAL_STOP (.CHECKING_RAB [RAB$L_STS], .CHECKING_RAB [RAB$L_STV]);
    END;

! Pause for 5 seconds.

LIB$PUT_OUTPUT (%ASCID 'Pausing for 5 seconds.');
LIB$WAIT (DELAY);

STATUS = $GET (RAB = SAVINGS_RAB);
IF NOT .STATUS
THEN
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Cannot read savings account balance.');
    $ABORT_RU (RU_HANDLE = RU_HANDLE);
    SIGNAL_STOP (.SAVINGS_RAB [RAB$L_STS], .SAVINGS_RAB [RAB$L_STV]);
    END;

SAVINGS_BALANCE = .SAVINGS_BALANCE + 10;

STATUS = $UPDATE (RAB = SAVINGS_RAB);
IF NOT .STATUS
THEN
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Cannot update savings account balance.');
    $ABORT_RU (RU_HANDLE = RU_HANDLE);
    SIGNAL_STOP (.SAVINGS_RAB [RAB$L_STS], .SAVINGS_RAB [RAB$L_STV]);
    END;

! End the recovery unit

STATUS = $END_RU (RU_HANDLE = RU_HANDLE);
IF NOT .STATUS
THEN 
    BEGIN
    LIB$PUT_OUTPUT (%ASCID 'Cannot end recovery unit to transfer funds.');
    SIGNAL_STOP (.STATUS);
    END;

! Print new balances.

OUTPUT_DESC [DSC$W_LENGTH] = 80;
OUTPUT_DESC [DSC$B_CLASS] = DSC$K_CLASS_D;
OUTPUT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
OUTPUT_DESC [DSC$A_POINTER] = MESSAGE_BUF;

$FAO (%ASCID 'Checking account balance is $!UL',
      OUTPUT_DESC [DSC$W_LENGTH],
      OUTPUT_DESC,
      .CHECKING_BALANCE);

LIB$PUT_OUTPUT (OUTPUT_DESC);

! Reinitialize the length in the descriptor.

OUTPUT_DESC [DSC$W_LENGTH] = 80;

$FAO (%ASCID 'Savings account balance is $!UL',
      OUTPUT_DESC [DSC$W_LENGTH],
      OUTPUT_DESC,
      .SAVINGS_BALANCE);

LIB$PUT_OUTPUT (OUTPUT_DESC);

! Disconnect and close files.

STATUS = $DISCONNECT (RAB = CHECKING_RAB);
IF NOT .STATUS
THEN 
    SIGNAL_STOP (.CHECKING_RAB [RAB$L_STS], .CHECKING_RAB [RAB$L_STV]);

STATUS = $DISCONNECT (RAB = SAVINGS_RAB);
IF NOT .STATUS
THEN 
    SIGNAL_STOP (.SAVINGS_RAB [RAB$L_STS], .SAVINGS_RAB [RAB$L_STV]);

STATUS = $CLOSE (FAB = CHECKING_FAB);
IF NOT .STATUS
THEN
    SIGNAL_STOP (.CHECKING_FAB [FAB$L_STS], .CHECKING_FAB [FAB$L_STV]);

STATUS = $CLOSE (FAB = SAVINGS_FAB);
IF NOT .STATUS
THEN
    SIGNAL_STOP (.SAVINGS_FAB [FAB$L_STS], .SAVINGS_FAB [FAB$L_STV]);

! Return success.

RETURN 1;

END; ! RUFEXAMPLE$MAIN

END
ELUDOM