 |
OpenVMS Programming Concepts Manual
3.2.1.2 Creating Temporary and Permanent Mailboxes
By default, a mailbox is deleted when no I/O channel is assigned to it.
Such a mailbox is called a temporary mailbox. If you have PRMMBX
privilege, you can create a permanent mailbox (specify the
prmflg argument as 1 when you invoke SYS$CREMBX). A
permanent mailbox is not deleted until it is marked for deletion with
the SYS$DELMBX system service (requires PRMMBX). Once a permanent
mailbox is marked for deletion, it is like a temporary mailbox; when
the last I/O channel to the mailbox is deassigned, the mailbox is
deleted.
The following statement creates a mailbox named MAIL_BOX. The I/O
channel assigned to the mailbox is returned in MBX_CHAN.
! I/O channel
INTEGER*2 MBX_CHAN
! Mailbox name
CHARACTER*(*) MBX_NAME
PARAMETER (MBX_NAME = 'MAIL_BOX')
STATUS = SYS$CREMBX (,
2 MBX_CHAN, ! I/O channel
2 ,,,,
2 MBX_NAME) ! Mailbox name
|
Note
If you use MAIL as the logical name for a mailbox, then the system will
not execute the proper image in response to the DCL command MAIL.
|
The following program segment creates a permanent mailbox, then creates
a subprocess that marks that mailbox for deletion:
INTEGER STATUS,
2 SYS$CREMBX
INTEGER*2 MBX_CHAN
! Create permanent mailbox
STATUS = SYS$CREMBX (%VAL(1), ! Permanence flag
2 MBX_CHAN, ! Channel
2 ,,,,
2 'MAIL_BOX') ! Logical name
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Create subprocess to delete it
STATUS = LIB$SPAWN ('RUN DELETE_MBX')
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
END
|
The following program segment executes in the subprocess. Notice that
the subprocess must assign a channel to the mailbox and then use that
channel to delete the mailbox. Any process that deletes a permanent
mailbox, unless it is the creating process, must use this technique.
(Use SYS$ASSIGN to assign the channel to the mailbox to ensure that the
mailbox already exists. SYS$CREMBX system service assigns a channel to
a mailbox; however, SYS$CREMBX also creates the mailbox if it does not
already exist.)
INTEGER STATUS,
2 SYS$DELMBX,
2 SYS$ASSIGN
INTEGER*2 MBX_CHAN
! Assign channel to mailbox
STATUS = SYS$ASSIGN ('MAIL_BOX',
2 MBX_CHAN,,)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Delete the mailbox
STATUS = SYS$DELMBX (%VAL(MBX_CHAN))
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
END
|
3.2.1.3 Assigning an I/O Channel Along with a Mailbox
A mailbox is a virtual device used for communication between processes.
A channel is the communication path that a process uses to perform I/O
operations to a particular device. The LIB$ASN_WTH_MBX routine assigns
a channel to a device and associates a mailbox with the device.
Normally, a process calls the SYS$CREMBX system service to create a
mailbox and assign a channel and logical name to it. In the case of a
temporary mailbox, this service places the logical name corresponding
to the mailbox in the job logical name table. This implies that any
process running in the same job and using the same logical name uses
the same mailbox.
Sometimes it is not desirable to have more than one process use the
same mailbox. For example, when a program connects explicitly with
another process across a network, the program uses a mailbox both to
obtain the data confirming the connection and to store the asynchronous
messages from the other process. If that mailbox is shared with other
processes in the same group, there is no way to determine which
messages are intended for which processes; the processes read each
other's messages, and the original program does not receive the correct
information from the cooperating process across the network link.
The LIB$ASN_WTH_MBX routine avoids this situation by associating the
physical mailbox name with the channel assigned to the device. To
create a temporary mailbox for itself and other processes cooperating
with it, your program calls LIB$ASN_WTH_MBX. The run-time library
routine assigns the channel and creates the temporary mailbox by using
the system services $GETDVI, $ASSIGN, and $CREMBX. Instead of a logical
name, the mailbox is identified by a physical device name of the form
MBcu. The elements that make up this device name are as
follows:
|
MB
|
indicates that the device is a mailbox.
|
|
c
|
is the controller.
|
|
u
|
is the unit number.
|
The routine returns this device name to the calling program, which then
must pass the mailbox channel to the other programs with which it
cooperates. In this way, the cooperating processes access the mailbox
by its physical name instead of by its jobwide logical name.
The calling program passes the routine a device name, which specifies
the device to which the channel is to be assigned. For this argument
(called dev-nam), you can use a logical name. If you
do so, the routine attempts one level of logical name translation.
The privilege restrictions and process quotas required for using this
routine are those required by the $GETDVI, $CREMBX, and $ASSIGN system
services.
3.2.1.4 Reading and Writing Data to a Mailbox
The following list describes the three ways you can read and write to a
mailbox:
- Synchronous I/O---Reads or writes to a mailbox and then waits for
the cooperating image to perform the other operation. Use I/O
statements for your programming language. This is the recommended
method of addressing a mailbox.
- Immediate I/O---Queues a read or write operation to a mailbox and
continues program execution after the operation completes. To do this,
use the SYS$QIOW system service.
- Asynchronous I/O---Queues a read or write operation to a mailbox
and continues program execution while the request executes. To do this,
use the SYS$QIO system service. When the read or write operation
completes, the I/O status block (if specified) is filled, the event
flag (if specified) is set, and the AST routine (if specified) is
executed.
Chapter 23 describes the SYS$QIO and SYS$QIOW system services and
provides further discussion of mailbox I/O. See the OpenVMS System Services Reference Manual for
more information. Compaq recommends that you supply the optional I/O
status block parameter when you use these two system services. The
contents of the status block varies depending on the QIO function code;
refer to the function code descriptions in the OpenVMS I/O User's Reference Manual for a
description of the appropriate status block.
3.2.1.5 Using Synchronous Mailbox I/O
Use synchronous I/O when you read or write information to another image
and cannot continue until that image responds.
The program segment shown in Example 3-2 opens a mailbox for the
first time. To open a mailbox for Fortran I/O, use the OPEN statement
with the following specifiers: UNIT, FILE, CARRIAGECONTROL, and STATUS.
The value for the keyword FILE should be the logical name of a mailbox
(SYS$CREMBX allows you to associate a logical name with a mailbox when
the mailbox is created). The value for the keyword CARRIAGECONTROL
should be 'LIST'. The value for the keyword STATUS should be 'NEW' for
the first OPEN statement and 'OLD' for subsequent OPEN statements.
| Example 3-2 Opening a Mailbox |
! Status variable and values
INTEGER STATUS
! Logical unit and name for mailbox
INTEGER MBX_LUN
CHARACTER(*) MBX_NAME
PARAMETER (MBX_NAME = MAIL_BOX)
! Create mailbox
STATUS = SYS$CREMBX (,
2 MBX_CHAN, ! Channel
2 ,,,,
2 MBX_NAME) ! Logical name
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Get logical unit for mailbox and open mailbox
STATUS = LIB$GET_LUN (MBX_LUN)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
OPEN (UNIT = MBX_LUN,
2 FILE = MBX_NAME,
2 CARRIAGECONTROL = 'LIST',
2 STATUS = 'NEW')
|
In Example 3-3, one image passes device names to a second image. The
second image returns the process name and the terminal associated with
the process that allocated each device. A WRITE statement in the first
image does not complete until the cooperating process issues a READ
statement. (The variable declarations are not shown in the second
program because they are very similar to those in the first program.)
| Example 3-3 Synchronous I/O Using a
Mailbox |
! DEVICE.FOR
PROGRAM PROCESS_DEVICE
! Status variable
INTEGER STATUS
! Name and I/O channel for mailbox
CHARACTER*(*) MBX_NAME
PARAMETER (MBX_NAME = 'MAIL_BOX')
INTEGER*2 MBX_CHAN
! Logical unit number for FORTRAN I/O
INTEGER MBX_LUN
! Character string format
CHARACTER*(*) CHAR_FMT
PARAMETER (CHAR_FMT = '(A50)')
! Mailbox message
CHARACTER*50 MBX_MESSAGE
.
.
.
! Create the mailbox
STATUS = SYS$CREMBX (,
2 MBX_CHAN, ! Channel
2 ,,,,
2 MBX_NAME) ! Logical name
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Get logical unit for mailbox and open mailbox
STATUS = LIB$GET_LUN (MBX_LUN)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
OPEN (UNIT = MBX_LUN,
2 FILE = MBX_NAME,
2 CARRIAGECONTROL = 'LIST',
2 STATUS = 'NEW')
! Create subprocess to execute GETDEVINF.EXE
STATUS = SYS$CREPRC (,
2 'GETDEVINF', ! Image
2 ,,,,,
2 'GET_DEVICE', ! Process name
2 %VAL(4),,,) ! Priority
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Pass device names to GETDEFINF
WRITE (UNIT=MBX_LUN,
2 FMT=CHAR_FMT) 'SYS$DRIVE0'
! Read device information from GETDEFINF
READ (UNIT=MBX_LUN,
2 FMT=CHAR_FMT) MBX_MESSAGE
.
.
.
END
|
GETDEVINF.FOR
.
.
.
! Create mailbox
STATUS = SYS$CREMBX (,
2 MBX_CHAN, ! I/O channel
2 ,,,,
2 MBX_NAME) ! Mailbox name
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Get logical unit for mailbox and open mailbox
STATUS = LIB$GET_LUN (MBX_LUN)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
OPEN (UNIT=MBX_LUN,
2 FILE=MBX_NAME,
2 CARRIAGECONTROL='LIST',
2 STATUS = 'OLD')
! Read device names from mailbox
READ (UNIT=MBX_LUN,
2 FMT=CHAR_FMT) MBX_MESSAGE
! Use SYS$GETJPI to find process and terminal
! Process name: PROC_NAME (1:P_LEN)
! Terminal name: TERM (1:T_LEN)
.
.
.
MBX_MESSAGE = MBX_MESSAGE//' '//
2 PROC_NAME(1:P_LEN)//' '//
2 TERM(1:T_LEN)
! Write device information to DEVICE
WRITE (UNIT=MBX_LUN,
2 FMT=CHAR_FMT) MBX_MESSAGE
END
|
3.2.1.6 Using Immediate Mailbox I/O
Use immediate I/O to read or write to another image without waiting for
a response from that image. To ensure that the other process receives
the information that you write, either do not exit until the other
process has a channel to the mailbox, or use a permanent mailbox.
Queueing an Immmediate I/O Request
To queue an immediate I/O request, invoke the SYS$QIOW system service.
See the OpenVMS System Services Reference Manual for more information.
Reading Data from the Mailbox
Since immediate I/O is asynchronous, a mailbox may contain more than
one message or no message when it is read. If the mailbox contains more
than one message, the read operation retrieves the messages one at a
time in the order in which they were written. If the mailbox contains
no message, the read operation generates an end-of-file error.
To allow a cooperating program to differentiate between an empty
mailbox and the end of the data being transferred, the process writing
the messages should use the IO$_WRITEOF function code to write an
end-of-file message to the mailbox as the last piece of data. When the
cooperating program reads an empty mailbox, the end-of-file message is
returned and the second longword of the I/O status block is 0. When the
cooperating program reads an end-of-file message explicitly written to
the mailbox, the end-of-file message is returned and the second
longword of the I/O status block contains the process identification
number of the process that wrote the message to the mailbox.
In Example 3-4, the first program creates a mailbox named MAIL_BOX,
writes data to it, and then indicates the end of the data by writing an
end-of-file message. The second program creates a mailbox with the same
logical name, reads the messages from the mailbox into an array, and
stops the read operations when a read operation generates an
end-of-file message and the second longword of the I/O status block is
nonzero, confirming that the writing process sent the end-of-file
message. The processes use common event flag 64 to ensure that SEND.FOR
does not exit until RECEIVE.FOR has established a channel to the
mailbox. (If RECEIVE.FOR executes first, an error occurs because
SYS$ASSIGN cannot find the mailbox.)
| Example 3-4 Immediate I/O Using a Mailbox |
!SEND.FOR
.
.
.
INTEGER*4 STATUS
! Name and channel number for mailbox
CHARACTER*(*) MBX_NAME
PARAMETER (MBX_NAME = 'MAIL_BOX')
INTEGER*2 MBX_CHAN
! Mailbox message
CHARACTER*80 MBX_MESSAGE
INTEGER LEN
CHARACTER*80 MESSAGES (255)
INTEGER MESSAGE_LEN (255)
INTEGER MAX_MESSAGE
PARAMETER (MAX_MESSAGE = 255)
! I/O function codes and status block
INCLUDE '($IODEF)'
INTEGER*4 WRITE_CODE
STRUCTURE /STATUS_BLOCK/
INTEGER*2 IOSTAT,
2 MSG_LEN
INTEGER*4 READER_PID
END STRUCTURE
RECORD /STATUS_BLOCK/ IOSTATUS
! System routines
INTEGER SYS$CREMBX,
2 SYS$ASCEFC,
2 SYS$WAITFR,
2 SYS$QIOW
! Create the mailbox
STATUS = SYS$CREMBX (,
2 MBX_CHAN,
2 ,,,,
2 MBX_NAME)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Fill MESSAGES array
.
.
.
! Write the messages
DO I = 1, MAX_MESSAGE
WRITE_CODE = IO$_WRITEVBLK .OR. IO$M_NOW
MBX_MESSAGE = MESSAGES(I)
LEN = MESSAGE_LEN(I)
STATUS = SYS$QIOW (,
2 %VAL(MBX_CHAN), ! Channel
2 %VAL(WRITE_CODE), ! I/O code
2 IOSTATUS, ! Status block
2 ,,
2 %REF(MBX_MESSAGE), ! P1
2 %VAL(LEN),,,,) ! P2
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
IF (.NOT. IOSTATUS.IOSTAT)
2 CALL LIB$SIGNAL (%VAL(IOSTATUS.STATUS))
END DO
! Write end-of-file
WRITE_CODE = IO$_WRITEOF .OR. IO$M_NOW
STATUS = SYS$QIOW (,
2 %VAL(MBX_CHAN), ! Channel
2 %VAL(WRITE_CODE), ! End-of-file code
2 IOSTATUS, ! Status block
2 ,,,,,,,)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
IF (.NOT. IOSTATUS.IOSTAT)
2 CALL LIB$SIGNAL (%VAL(IOSTATUS.IOSTAT))
.
.
.
! Make sure cooperating process can read the information
! by waiting for it to assign a channel to the mailbox
STATUS = SYS$ASCEFC (%VAL(64),
2 'CLUSTER',,)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
STATUS = SYS$WAITFR (%VAL(64))
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
END
|
RECEIVE.FOR
INTEGER STATUS
INCLUDE '($IODEF)'
INCLUDE '($SSDEF)'
! Name and channel number for mailbox
CHARACTER*(*) MBX_NAME
PARAMETER (MBX_NAME = 'MAIL_BOX')
INTEGER*2 MBX_CHAN
! QIO function code
INTEGER READ_CODE
! Mailbox message
CHARACTER*80 MBX_MESSAGE
INTEGER*4 LEN
! Message arrays
CHARACTER*80 MESSAGES (255)
INTEGER*4 MESSAGE_LEN (255)
! I/O status block
STRUCTURE /STATUS_BLOCK/
INTEGER*2 IOSTAT,
2 MSG_LEN
INTEGER*4 READER_PID
END STRUCTURE
RECORD /STATUS_BLOCK/ IOSTATUS
! System routines
INTEGER SYS$ASSIGN,
2 SYS$ASCEFC,
2 SYS$SETEF,
2 SYS$QIOW
! Create the mailbox and let the other process know
STATUS = SYS$ASSIGN (MBX_NAME,
2 MBX_CHAN,,,)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
STATUS = SYS$ASCEFC (%VAL(64),
2 'CLUSTER',,)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
STATUS = SYS$SETEF (%VAL(64))
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Read first message
READ_CODE = IO$_READVBLK .OR. IO$M_NOW
LEN = 80
STATUS = SYS$QIOW (,
2 %VAL(MBX_CHAN), ! Channel
2 %VAL(READ_CODE), ! Function code
2 IOSTATUS, ! Status block
2 ,,
2 %REF(MBX_MESSAGE), ! P1
2 %VAL(LEN),,,,) ! P2
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
IF ((.NOT. IOSTATUS.IOSTAT) .AND.
2 (IOSTATUS.IOSTAT .NE. SS$_ENDOFFILE)) THEN
CALL LIB$SIGNAL (%VAL(IOSTATUS.IOSTAT))
ELSE IF (IOSTATUS.IOSTAT .NE. SS$_ENDOFFILE) THEN
I = 1
MESSAGES(I) = MBX_MESSAGE
MESSAGE_LEN(I) = IOSTATUS.MSG_LEN
END IF
! Read messages until cooperating process writes end-of-file
DO WHILE (.NOT. ((IOSTATUS.IOSTAT .EQ. SS$_ENDOFFILE) .AND.
2 (IOSTATUS.READER_PID .NE. 0)))
STATUS = SYS$QIOW (,
2 %VAL(MBX_CHAN), ! Channel
2 %VAL(READ_CODE), ! Function code
2 IOSTATUS, ! Status block
2 ,,
2 %REF(MBX_MESSAGE), ! P1
2 %VAL(LEN),,,,) ! P2
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
IF ((.NOT. IOSTATUS.IOSTAT) .AND.
2 (IOSTATUS.IOSTAT .NE. SS$_ENDOFFILE)) THEN
CALL LIB$SIGNAL (%VAL(IOSTATUS.IOSTAT))
ELSE IF (IOSTATUS.IOSTAT .NE. SS$_ENDOFFILE) THEN
I = I + 1
MESSAGES(I) = MBX_MESSAGE
MESSAGE_LEN(I) = IOSTATUS.MSG_LEN
END IF
END DO
.
.
.
|
3.2.1.7 Using Asynchronous Mailbox I/O
Use asynchronous I/O to queue a read or write request to a mailbox. To
ensure that the other process receives the information you write,
either do not exit the other process until the other process has a
channel to the mailbox, or use a permanent mailbox.
To queue an asynchronous I/O request, invoke the SYS$QIO system
service; however, when specifying the function codes, do not specify
the IO$M_NOW modifier. The SYS$QIO system service allows you to specify
either an AST to be executed or an event flag to be set when the I/O
operation completes.
Example 3-5 calculates gross income and taxes and then uses the
results to calculate net income. INCOME.FOR uses SYS$CREPRC, specifying
a termination mailbox, to create a subprocess to calculate taxes
(CALC_TAXES) while INCOME calculates gross income. INCOME issues an
asynchronous read to the termination mailbox, specifying an event flag
to be set when the read completes. (The read completes when CALC_TAXES
completes, terminating the created process and causing the system to
write to the termination mailbox.) After finishing its own gross income
calculations, INCOME.FOR waits for the flag that indicates CALC_TAXES
has completed and then figures net income.
CALC_TAXES.FOR passes the tax information to INCOME.FOR using the
installed common block created from INSTALLED.FOR.
| Example 3-5 Asynchronous I/O Using a
Mailbox |
!INSTALLED.FOR
! Installed common block to be linked with INCOME.FOR and
! CALC_TAXES.FOR.
! Unless the shareable image created from this file is
! in SYS$SHARE, you must define a group logical name
! INSTALLED and equivalence it to the full file specification
! of the shareable image.
INTEGER*4 INCOME (200),
2 TAXES (200),
2 NET (200)
COMMON /CALC/ INCOME,
2 TAXES,
2 NET
END
|
!INCOME.FOR
! Status and system routines
.
.
.
INCLUDE '($SSDEF)'
INCLUDE '($IODEF)'
INTEGER STATUS,
2 LIB$GET_LUN,
2 LIB$GET_EF,
2 SYS$CLREF,
2 SYS$CREMBX,
2 SYS$CREPRC,
2 SYS$GETDVIW,
2 SYS$QIO,
2 SYS$WAITFR
! Set up for SYS$GETDVI
! Define itmlst structure
STRUCTURE /ITMLST/
UNION
MAP
INTEGER*2 BUFLEN
INTEGER*2 CODE
INTEGER*4 BUFADR
INTEGER*4 RETLENADR
END MAP
MAP
INTEGER*4 END_LIST
END MAP
END UNION
END STRUCTURE
! Declare itmlst
RECORD /ITMLST/ DVILIST (2)
INTEGER*4 UNIT_BUF,
2 UNIT_LEN
EXTERNAL DVI$_UNIT
! Name and I/O channel for mailbox
CHARACTER*(*) MBX_NAME
PARAMETER (MBX_NAME = 'MAIL_BOX')
INTEGER*2 MBX_CHAN
INTEGER*4 MBX_LUN ! Logical unit number for I/O
CHARACTER*84 MBX_MESSAGE ! Mailbox message
INTEGER*4 READ_CODE,
2 LENGTH
! I/O status block
STRUCTURE /STATUS_BLOCK/
INTEGER*2 IOSTAT,
2 MSG_LEN
INTEGER*4 READER_PID
END STRUCTURE
RECORD /STATUS_BLOCK/ IOSTATUS
! Declare calculation variables in installed common
INTEGER*4 INCOME (200),
2 TAXES (200),
2 NET (200)
COMMON /CALC/ INCOME,
2 TAXES,
2 NET
! Flag to indicate taxes calculated
INTEGER*4 TAX_DONE
! Get and clear an event flag
STATUS = LIB$GET_EF (TAX_DONE)
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
STATUS = SYS$CLREF (%VAL(TAX_DONE))
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
! Create the mailbox
STATUS = SYS$CREMBX (,
2 MBX_CHAN,
2 ,,,,
2 MBX_NAME)
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
! Get unit number of the mailbox
DVILIST(1).BUFLEN = 4
DVILIST(1).CODE = %LOC(DVI$_UNIT)
DVILIST(1).BUFADR = %LOC(UNIT_BUF)
DVILIST(1).RETLENADR = %LOC(UNIT_LEN)
DVILIST(2).END_LIST = 0
STATUS = SYS$GETDVIW (,
2 %VAL(MBX_CHAN), ! Channel
2 MBX_NAME, ! Device
2 DVILIST, ! Item list
2 ,,,)
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
! Create subprocess to calculate taxes
STATUS = SYS$CREPRC (,
2 'CALC_TAXES', ! Image
2 ,,,,,
2 'CALC_TAXES', ! Process name
2 %VAL(4), ! Priority
2 ,
2 %VAL(UNIT_BUF),)
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
! Asynchronous read to termination mailbox
! sets flag when tax calculations complete
READ_CODE = IO$_READVBLK
LENGTH = 84
STATUS = SYS$QIO (%VAL(TAX_DONE), ! Indicates read complete
2 %VAL(MBX_CHAN), ! Channel
2 %VAL(READ_CODE), ! Function code
2 IOSTATUS,,, ! Status block
2 %REF(MBX_MESSAGE),! P1
2 %VAL(LENGTH),,,,) ! P2
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
! Calculate incomes
.
.
.
! Wait until taxes are calculated
STATUS = SYS$WAITFR (%VAL(TAX_DONE))
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
! Check mailbox I/O
IF (.NOT. IOSTATUS.IOSTAT)
2 CALL LIB$SIGNAL (%VAL(IOSTATUS.IOSTAT))
! Calculate net income after taxes
.
.
.
END
|
CALC_TAXES.FOR
! Declare calculation variables in installed common
INTEGER*4 INCOME (200),
2 TAXES (200),
2 NET (200)
COMMON /CALC/ INCOME,
2 TAXES,
2 NET
! Calculate taxes
.
.
.
END
|
|
