 |
OpenVMS Programming Concepts Manual
24.4.2 Allocating Event Flag Numbers
The LIB$GET_EF and LIB$FREE_EF routines operate in a similar way to
LIB$GET_LUN and LIB$FREE_LUN. They cause local event flags to be
allocated and deallocated at run time, so that your routine remains
independent of other routines executing in the same process.
Local event flags numbered 32 to 63 are available to your program.
These event flags allow routines to communicate and synchronize their
operations. If you use a specific event flag in your routine, another
routine may attempt to use the same flag, and the flag will no longer
function as expected. Therefore, you should call LIB$GET_EF to obtain
the next arbitrary event flag and LIB$FREE_EF to return it to the
storage pool. You can obtain a specific event flag number by calling
LIB$RESERVE_EF. This routine takes as its argument the event flag
number to be allocated.
For information about using event flags, see Chapter 3 and
Chapter 6.
24.5 Performance Measurement Routines
The run-time library timing facility consists of four routines to store
count and timing information, display the requested information, and
deallocate the storage. Table 24-9 lists these routines and their
functions.
Table 24-9 Performance Measurement Routines
| Entry Point |
Function |
|
LIB$INIT_TIMER
|
Stores the values of the specified times and counts in units of static
or heap storage, depending on the value of the routine's argument
|
|
LIB$SHOW_TIMER
|
Obtains and formats for output the specified times and counts that are
accumulated since the last call to LIB$INIT_TIMER
|
|
LIB$STAT_TIMER
|
Obtains one of the times and counts since the last call to
LIB$INIT_TIMER and returns it as an unsigned quadword or longword
|
|
LIB$FREE_TIMER
|
Frees the storage allocated by LIB$INIT_TIMER
|
Using these routines, you can access the following statistics:
- Elapsed time
- CPU time
- Buffered I/O count
- Direct I/O count
- Page faults
The LIB$SHOW_TIMER and LIB$STAT_TIMER routine are relatively simple
tools for testing the performance of a new application. To obtain more
detailed information, use the system services SYS$GETTIM (Get Time) and
SYS$GETJPI (Get Job/Process Information).
The simplest way to use the run-time library routines is to call
LIB$INIT_TIMER with no arguments at the beginning of the portion of
code to be monitored. This causes the statistics to be placed in OWN
storage. To get the statistics from OWN storage, call LIB$SHOW_TIMER
(with no arguments) at the end of the portion of code to be monitored.
If you want a particular statistic, you must include a
code argument with a call to LIB$SHOW_TIMER or
LIB$STAT_TIMER. LIB$SHOW_TIMER returns the specified statistic(s) in
formatted form and sends them to SYS$OUTPUT. On each call,
LIB$STAT_TIMER returns one statistic to the calling program as an
unsigned longword or quadword value.
Table 24-10 shows the code argument in
LIB$SHOW_TIMER or LIB$STAT_TIMER.
Table 24-10 The Code Argument in LIB$SHOW_TIMER and LIB$STAT_TIMER
| Argument Value |
Meaning |
LIB$SHOW_TIMER Format |
LIB$STAT_TIMER Format |
|
1
|
Elapsed real time
|
dddd hh:mm:ss.cc
|
Quadword, in system time format
|
|
2
|
Elapsed CPU time
|
hhhh:mm:ss.cc
|
Longword, in 10-millisecond increments
|
|
3
|
Number of buffered I/O operations
|
nnnn
|
Longword
|
|
4
|
Number of direct I/O operations
|
nnnn
|
Longword
|
|
5
|
Number of page faults
|
nnnn
|
Longword
|
When you call LIB$INIT_TIMER, you must use the optional
handler argument only if you want to keep several sets
of statistics simultaneously. This argument points to a block in heap
storage where the statistics are to be stored. You need to call
LIB$FREE_TIMER only if you have specified handler in
LIB$INIT_TIMER and you want to deallocate all heap storage resources.
In most cases, the implicit deallocation when the image exits is
sufficient.
The LIB$STAT_TIMER routine returns only one of the five statistics for
each call, and it returns that statistic in the form of an unsigned
quadword or longword. LIB$SHOW_TIMER returns the virtual address of the
stored information, which BASIC cannot directly access. Therefore, a
BASIC program must call LIB$STAT_TIMER and format the returned
statistics, as the following example demonstrates.
Example
The following BASIC example uses the run-time library performance
analysis routines to obtain timing statistics. It then calls the
$ASCTIM system service to translate the 64-bit binary value returned by
LIB$STAT_TIMER into an ASCII text string.
100 EXTERNAL INTEGER FUNCTION LIB$INIT_TIMER
EXTERNAL INTEGER FUNCTION LIB$STAT_TIMER
EXTERNAL INTEGER FUNCTION LIB$FREE_TIMER
EXTERNAL INTEGER CONSTANT SS$_NORMAL
200 DECLARE LONG COND_VALUE, RANDOM_SLEEP
DECLARE LONG CODE, HANDLE
DECLARE STRING TIME_BUFFER
HANDLE = 0
TIME_BUFFER = SPACE$(50%)
300 MAP (TIMER) LONG ELAPSED_TIME, FILL
MAP (TIMER) LONG CPU_TIME
MAP (TIMER) LONG BUFIO
MAP (TIMER) LONG DIRIO
MAP (TIMER) LONG PAGE_FAULTS
400 PRINT "This program returns information about:"
PRINT "Elapsed time (1)"
PRINT "CPU time (2)"
PRINT "Buffered I/O (3)"
PRINT "Direct I/O (4)"
PRINT "Page faults (5)"
PRINT "Enter zero to exit program"
PRINT "Enter a number from one to"
PRINT "five for performance information"
INPUT "One, two, three, four, or five"; CODE
PRINT
450 GOTO 32766 IF CODE = 0
500 COND_VALUE = LIB$INIT_TIMER( HANDLE )
550 IF (COND_VALUE <> SS$_NORMAL) THEN PRINT @
"Error in initialization"
GOTO 32767
650 A = 0 !
FOR I = 1 to 100000 ! This code merely uses some CPU time
A = A + 1 !
NEXT I !
700 COND_VALUE = LIB$STAT_TIMER( CODE, ELAPSED_TIME, HANDLE )
750 IF (COND_VALUE <> SS$_NORMAL) THEN PRINT @
"Error in statistics routine"
GOTO 32767
800 GOTO 810 IF CODE <> 1%
CALL SYS$ASCTIM ( , TIME_BUFFER, ELAPSED_TIME, 1% BY VALUE)
PRINT "Elapsed time: "; TIME_BUFFER
810 PRINT "CPU time in seconds: "; .01 * CPU_TIME IF CODE = 2%
PRINT "Buffered I/O: ";BUFIO IF CODE = 3%
PRINT "Direct I/O: ";DIRIO IF CODE = 4%
PRINT "Page faults: ";PAGE_FAULTS IF CODE = 5%
PRINT
900 GOTO 400
32765 COND_VALUE = LIB$FREE_TIMER( HANDLE )
32766 IF (COND_VALUE <> SS$_NORMAL) THEN PRINT @
"Error in LIB$FREE_TIMER"
GOTO 32767
32767 END
|
For information about using system time, see Chapter 27.
24.6 Output Formatting Control Routines
Table 24-11 lists the run-time library routines that customize
output.
Table 24-11 Routines for Customizing Output
| Entry Point |
Function |
|
LIB$CURRENCY
|
Defines the default currency symbol for process
|
|
LIB$DIGIT_SEP
|
Defines the default digit separator for process
|
|
LIB$LP_LINES
|
Defines the process default size for a printed page
|
|
LIB$RADIX_POINT
|
Defines the process default radix point character
|
The LIB$CURRENCY, LIB$DIGIT_SEP, LIB$LP_LINES, and LIB$RADIX_POINT
routines allow you to customize output. Using them, you can define the
logical names SYS$CURRENCY, SYS$DIGIT_SEP, SYS$LP_LINES, and
SYS$RADIX_POINT to specify your own currency symbol, digit separator,
radix point, or number of lines per printed page. Each routine works by
attempting to translate the associated logical name as a process,
group, or system logical name. If you have redefined a logical name for
a specific local application, then the translation succeeds, and the
routine returns the value that corresponds to the option you have
chosen. If the translation fails, the routine returns a default value
provided by the run-time library, as follows:
|
$
|
SYS$CURRENCY
|
|
,
|
SYS$DIGIT_SEP
|
|
.
|
SYS$RADIX_POINT
|
|
66
|
SYS$LP_LINES
|
For example, if you want to use the British pound sign (£) as the
currency symbol within your process, but you want to leave the dollar
sign ($) as the system default, define SYS$CURRENCY to be in your
process logical name table. Then, any calls to LIB$CURRENCY within your
process return "£", while any calls outside your
process return "$".
You can use LIB$LP_LINES to monitor the current default length of the
line printer page. You can also supply your own default length for the
current process. United States standard paper size permits 66 lines on
each physical page.
If you are writing programs for a utility that formats a listing file
to be printed on a line printer, you can use LIB$LP_LINES to make your
utility independent of the default page length. Your program can use
LIB$LP_LINES to obtain the current length of the page. It can then
calculate the number of lines of text per page by subtracting the lines
used for margins and headings.
The following is one suggested format:
- Three lines for the top margin
- Three lines for the bottom margin
- Three lines for listing heading information, consisting of:
- Language-processor identification line
- Source program identification line
- One blank line
24.7 Miscellaneous Interface Routines
There are several other RTL routines that permit high-level access to
components of the operating system. Table 24-12 lists these routines
and their functions. The sections that follow give further details
about some of these routines.
Table 24-12 Miscellaneous Interface Routines
| Entry Point |
Function |
|
LIB$AST_IN_PROG
|
Indicates whether an asynchronous system trap is in progress
|
|
LIB$ASN_WTH_MBX
|
Assigns an I/O channel and associates it with a mailbox
|
|
LIB$CREATE_DIR
|
Creates a directory or subdirectory
|
|
LIB$FIND_IMAGE_SYMBOL
|
Reads a global symbol from the shareable image file and dynamically
activates a shareable image into the P0 address space of a process
|
|
LIB$ADDX
|
Performs addition on signed two's complement integers of arbitrary
length (multiple-precision addition)
|
|
LIB$SUBX
|
Performs subtraction on signed two's complement integers of arbitrary
length (multiple-precision subtraction)
|
|
LIB$FILE_SCAN
|
Finds file names given OpenVMS RMS file access block (FAB)
|
|
LIB$FILE_SCAN_END
|
Specifies end-of-file scan
|
|
LIB$FIND_FILE
|
Finds file names given string
|
|
LIB$FIND_FILE_END
|
Specifies the end-of-find file
|
|
LIB$INSERT_TREE
|
Inserts an element in a binary tree
|
|
LIB$LOOKUP_TREE
|
Finds an element in a binary tree
|
|
LIB$TRAVERSE_TREE
|
Traverses a binary tree
|
|
LIB$GET_COMMON
|
Gets a record from the process's COMMON storage area
|
|
LIB$PUT_COMMON
|
Puts a record to the process's COMMON storage area
|
24.7.1 Indicating Asynchronous System Trap in Progress
An asynchronous system trap (AST) is a mechanism for providing a
software interrupt when an external event occurs, such as when a user
presses the Ctrl/C key sequence. When an external event occurs, the
operating system interrupts the execution of the current process and
calls a routine that you supply. While that routine is active, the AST
is said to be in progress, and the process is said to be executing at
AST level. When your AST routine returns control to the original
process, the AST is no longer active and execution continues where it
left off.
The LIB$AST_IN_PROG routine indicates to the calling program whether an
AST is currently in progress. Your program can call LIB$AST_IN_PROG to
determine whether it is executing at AST level, and then take
appropriate action. This routine is useful if you are writing
AST-reentrant code.
For information about using ASTs, see Chapter 8.
24.7.2 Create a Directory or Subdirectory
The LIB$CREATE_DIR routine creates a directory or a subdirectory. The
calling program must specify the directory specification in standard
OpenVMS RMS format. This directory specification may also contain a
disk specification.
In addition to the required directory specification argument,
LIB$CREATE_DIR takes the following five optional arguments:
- The user identification code (UIC) of the owner of the created
directory or subdirectory
- The protection enable mask
- The protection value mask
- The maximum number of versions allowed for files created in this
directory or subdirectory
- The relative volume number within the volume set on which the
directory or subdirectory is created
See the OpenVMS RTL Library (LIB$) Manual for a complete description of LIB$CREATE_DIR.
24.7.3 File Searching Routines
The run-time library provides two routines that your program can call
to search for a file and two routines that your program can call to end
a search sequence:
- When you call LIB$FILE_SCAN with a wildcard file specification and
an action routine, the routine calls the action routine for each file
or error, or both, found in the wildcard sequence. LIB$FILE_SCAN allows
the search sequence to continue even though certain errors are present.
- When you call LIB$FIND_FILE with a wildcard file specification, it
finds the next file specification that matches the wildcard
specification.
In addition to the wildcard file specification, which is a required
argument, LIB$FIND_FILE takes the following four optional arguments:
- The default specification.
- The related specification.
- The OpenVMS RMS secondary status value from a failing RMS operation.
- A longword containing two flag bits. If bit 1 is set, LIB$FIND_FILE
performs temporary defaulting for multiple input files and the related
specification argument is ignored. See the OpenVMS RTL Library (LIB$) Manual for a complete
description of LIB$FIND_FILE in template format.
The LIB$FIND_FILE_END routine is called once after each call to
LIB$FIND_FILE in interactive use. LIB$FIND_FILE_END prevents the
temporary default values retained by the previous call to LIB$FIND_FILE
from affecting the next file specification.
The LIB$FILE_SCAN routine uses an optional context argument to perform
temporary defaulting for multiple input files. For example, a command
such as the following would specify A, B, and C in successive calls,
retaining context, so that portions of one file specification would
affect the next file specification:
The LIB$FILE_SCAN_END routine is called once after each sequence of
calls to LIB$FILE_SCAN. LIB$FILE_SCAN_END performs a parse of the null
string to deallocate saved OpenVMS RMS context and to prevent the
temporary default values retained by the previous call to LIB$FILE_SCAN
from affecting the next file specification. For instance, in the
previous example, LIB$FILE_SCAN_END should be called after the C file
specification is parsed, so that specifications from the $COPY files do
not affect file specifications in subsequent commands.
The following BLISS example illustrates the use of LIB$FIND_FILE. It
prompts for a file specification and default specification. The default
specification indicates the default information for the file for which
you are searching. Once the routine has searched for one file, the
resulting file specification determines both the related file
specification and the default file specification for the next search.
LIB$FIND_FILE_END is called at the end of the following BLISS program
to deallocate the virtual memory used by LIB$FIND_FILE.
%TITLE 'FILE_EXAMPLE1 - Sample program using LIB$FIND_FILE'
MODULE FILE_EXAMPLE1( ! Sample program using LIB$FIND_FILE
IDENT = '1-001',
MAIN = EXAMPLE_START
) =
BEGIN
%SBTTL 'Declarations'
!+
! SWITCHES:
!-
SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);
!+
! TABLE OF CONTENTS:
!-
FORWARD ROUTINE
EXAMPLE_START; ! Main program
!+
! INCLUDE FILES:
!-
LIBRARY 'SYS$LIBRARY:STARLET.L32'; ! System symbols
!+
! Define facility-specific messages from shared system messages.
!-
$SHR_MSGDEF(CLI,3,LOCAL,
(PARSEFAIL,WARNING));
!+
! EXTERNAL REFERENCES:
!-
EXTERNAL ROUTINE
LIB$GET_INPUT, ! Read from SYS$INPUT
LIB$FIND_FILE, ! Wildcard scanning routine
LIB$FIND_FILE_END, ! End find file
LIB$PUT_OUTPUT, ! Write to SYS$OUTPUT
STR$COPY_DX; ! String copier
LITERAL
TRUE = 1, ! Success
FALSE = 0; ! Failure
%SBTTL 'EXAMPLE_START - Sample program main routine';
ROUTINE EXAMPLE_START =
BEGIN
!+
! This program reads a file specification and default file
! specification from SYS$INPUT. It then prints all the files that
! match that specification and prompts for another file specification.
! After the first file specification no default specification is requested,
! and the previous resulting file specification becomes the related
! file specification.
!-
LOCAL
LINEDESC : $BBLOCK[DSC$C_S_BLN], ! String desc. for input line
RESULT_DESC : $BBLOCK[DSC$C_S_BLN], ! String desc. for result file
CONTEXT, ! LIB$FIND_FILE context pointer
DEFAULT_DESC : $BBLOCK[DSC$C_S_BLN], ! String desc. for default spec
RELATED_DESC : $BBLOCK[DSC$C_S_BLN], ! String desc. for related spec
HAVE_DEFAULT,
STATUS;
!+
! Make all string descriptors dynamic.
!-
CH$FILL(0,DSC$C_S_BLN,LINEDESC);
LINEDESC[DSC$B_CLASS] = DSC$K_CLASS_D;
CH$MOVE(DSC$C_S_BLN,LINEDESC,RESULT_DESC);
CH$MOVE(DSC$C_S_BLN,LINEDESC,DEFAULT_DESC);
CH$MOVE(DSC$C_S_BLN,LINEDESC,RELATED_DESC);
HAVE_DEFAULT = FALSE;
CONTEXT = 0;
!+
! Read file specification, default file specification, and
! related file specification.
!-
WHILE (STATUS = LIB$GET_INPUT(LINEDESC,
$DESCRIPTOR('FILE SPECIFICATION: '))) NEQ RMS$_EOF
DO BEGIN
IF NOT .STATUS
THEN SIGNAL_STOP(.STATUS);
!+
! If default file specification was not obtained, do so now.
!-
IF NOT .HAVE_DEFAULT
THEN BEGIN
STATUS = LIB$GET_INPUT(DEFAULT_DESC,
$DESCRIPTOR('DEFAULT FILE SPECIFICATION: '));
IF NOT .STATUS
THEN SIGNAL_STOP(.STATUS);
HAVE_DEFAULT = TRUE;
END;
!+
! CALL LIB$FIND_FILE until RMS$_NMF (no more files) is returned.
! If an error other than RMS$_NMF is returned, it is signaled.
! Print out the file specification if the call is successful.
!-
WHILE (STATUS = LIB$FIND_FILE(LINEDESC,RESULT_DESC,CONTEXT,
DEFAULT_DESC,RELATED_DESC)) NEQ RMS$_NMF
DO IF NOT .STATUS
THEN SIGNAL(CLI$_PARSEFAIL,1,RESULT_DESC,.STATUS)
ELSE LIB$PUT_OUTPUT(RESULT_DESC);
!+
! Make this resultant file specification the related file
! specification for next file.
!-
STR$COPY_DX(RELATED_DESC,LINEDESC);
END; ! End of loop
! reading file specification
!+
! Call LIB$FIND_FILE_END to deallocate the virtual memory used by LIB$FIND_FILE.
! Note that we do this outside of the loop. Since the MULTIPLE bit of the
! optional user flags argument to LIB$FIND_FILE wasn't used, it is not
! necessary to call LIB$FIND_FILE_END after each call to LIB$FIND_FILE.
! (The MULTIPLE bit would have caused temporary defaulting for multiple input
! files.)
!-
STATUS = LIB$FIND_FILE_END (CONTEXT);
IF NOT .STATUS
THEN SIGNAL_STOP (.STATUS);
RETURN TRUE
END; ! End of main program
END ! End of module
ELUDOM
|
The following BLISS example illustrates the use of LIB$FILE_SCAN and
LIB$FILE_SCAN_END.
%TITLE 'FILE_EXAMPLE2 - Sample program using LIB$FILE_SCAN'
MODULE FILE_EXAMPLE1( ! Sample program using LIB$FILE_SCAN
IDENT = '1-001',
MAIN = EXAMPLE_START
) =
BEGIN
%SBTTL 'Declarations'
!+
! SWITCHES:
!-
SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL,
NONEXTERNAL = WORD_RELATIVE);
!+
! TABLE OF CONTENTS:
!-
FORWARD ROUTINE
EXAMPLE_START, ! Main program
SUCCESS_RTN, ! Success action routine
ERROR_RTN; ! Error action routine
!+
! INCLUDE FILES:
!-
LIBRARY 'SYS$LIBRARY:STARLET.L32'; ! System symbols
!+
! Define VMS block structures (BLOCK[,BYTE]).
!-
STRUCTURE
BBLOCK [O, P, S, E; N] =
[N]
(BBLOCK + O) <P, S, E>;
!+
! EXTERNAL REFERENCES:
!-
EXTERNAL ROUTINE
LIB$GET_INPUT, ! Read from SYS$INPUT
LIB$FILE_SCAN, ! Wildcard scanning routine
LIB$FILE_SCAN_END, ! End of file scan
LIB$PUT_OUTPUT; ! Write to SYS$OUTPUT
%SBTTL 'EXAMPLE_START - Sample program main routine';
ROUTINE EXAMPLE_START =
BEGIN
!+
! This program reads the file specification, default file specification,
! and related file specification from SYS$INPUT and then displays on
! SYS$OUTPUT all files which match the specification.
!-
LOCAL
RESULT_BUFFER : VECTOR[NAM$C_MAXRSS,BYTE], !Buffer for resultant
! name string
EXPAND_BUFFER : VECTOR[NAM$C_MAXRSS,BYTE], !Buffer for expanded
! name string
LINEDESC : BBLOCK[DSC$C_S_BLN], !String descriptor
! for input line
RESULT_DESC : BBLOCK[DSC$C_S_BLN], !String descriptor
! for result file
DEFAULT_DESC : BBLOCK[DSC$C_S_BLN], !String descriptor
! for default specification
RELATED_DESC : BBLOCK[DSC$C_S_BLN], !String descriptor
! for related specification
IFAB : $FAB_DECL, !FAB for file_scan
INAM : $NAM_DECL, ! and a NAM block
RELNAM : $NAM_DECL, ! and a related NAM block
STATUS;
!+
! Make all descriptors dynamic.
!-
CH$FILL(0,DSC$C_S_BLN,LINEDESC);
LINEDESC[DSC$B_CLASS] = DSC$K_CLASS_D;
CH$MOVE(DSC$C_S_BLN,LINEDESC,RESULT_DESC);
CH$MOVE(DSC$C_S_BLN,LINEDESC,DEFAULT_DESC);
CH$MOVE(DSC$C_S_BLN,LINEDESC,RELATED_DESC);
!+
! Read file specification, default file specification, and related
! file specification
!-
STATUS = LIB$GET_INPUT(LINEDESC,
$DESCRIPTOR('File specification: '));
IF NOT .STATUS
THEN SIGNAL_STOP(.STATUS);
STATUS = LIB$GET_INPUT(DEFAULT_DESC,
$DESCRIPTOR('Default file specification: '));
IF NOT .STATUS
THEN SIGNAL_STOP(.STATUS);
STATUS = LIB$GET_INPUT(RELATED_DESC,
$DESCRIPTOR('Related file specification: '));
IF NOT .STATUS
THEN SIGNAL_STOP(.STATUS);
!+
! Initialize the FAB, NAM, and related NAM blocks.
!-
$FAB_INIT(FAB=IFAB,
FNS=.LINEDESC[DSC$W_LENGTH],
FNA=.LINEDESC[DSC$A_POINTER],
DNS=.DEFAULT_DESC[DSC$W_LENGTH],
DNA=.DEFAULT_DESC[DSC$A_POINTER],
NAM=INAM);
$NAM_INIT(NAM=INAM,
RSS=NAM$C_MAXRSS,
RSA=RESULT_BUFFER,
ESS=NAM$C_MAXRSS,
ESA=EXPAND_BUFFER,
RLF=RELNAM);
$NAM_INIT(NAM=RELNAM);
RELNAM[NAM$B_RSL] = .RELATED_DESC[DSC$W_LENGTH];
RELNAM[NAM$L_RSA] = .RELATED_DESC[DSC$A_POINTER];
!+
! Call LIB$FILE_SCAN. Note that errors need not be checked
! here because LIB$FILE_SCAN calls error_rtn for all errors.
!-
LIB$FILE_SCAN(IFAB,SUCCESS_RTN,ERROR_RTN);
!+
! Call LIB$FILE_SCAN_END to deallocate virtual memory used for
! file scan structures.
!-
STATUS = LIB$FILE_SCAN_END (IFAB);
IF NOT .STATUS
THEN SIGNAL_STOP (.STATUS);
RETURN 1
END; ! End of main program
ROUTINE SUCCESS_RTN (IFAB : REF BBLOCK) =
BEGIN
!+
! This routine is called by LIB$FILE_SCAN for each file that it
! successfully finds in the search sequence.
!
! Inputs:
!
! IFAB Address of a fab
!
! Outputs:
!
! file specification printed on SYS$OUTPUT
!-
LOCAL
DESC : BBLOCK[DSC$C_S_BLN]; ! A local string descriptor
BIND
INAM = .IFAB[FAB$L_NAM] : BBLOCK; ! Find NAM block
! from pointer in FAB
CH$FILL(0,DSC$C_S_BLN,DESC); ! Make static
! string descriptor
DESC[DSC$W_LENGTH] = .INAM[NAM$B_RSL]; ! Get string length
! from NAM block
DESC[DSC$A_POINTER] = .INAM[NAM$L_RSA]; ! Get pointer to the string
RETURN LIB$PUT_OUTPUT(DESC) ! Print name on SYS$OUTPUT
! and return
END;
ROUTINE ERROR_RTN (IFAB : REF BBLOCK) =
BEGIN
!+
! This routine is called by LIB$FILE_SCAN for each file specification that
! produces an error.
!
! Inputs:
!
! ifab Address of a fab
!
! Outputs:
!
! Error message is signaled
!-
LOCAL
DESC : BBLOCK[DSC$C_S_BLN]; ! A local string descriptor
BIND
INAM = .IFAB[FAB$L_NAM] : BBLOCK; ! Get NAM block pointer
! from FAB
CH$FILL(0,DSC$C_S_BLN,DESC); ! Create static
! string descriptor
DESC[DSC$W_LENGTH] = .INAM[NAM$B_RSL];
DESC[DSC$A_POINTER] = .INAM[NAM$L_RSA];
!+
! Signal the error using the shared message PARSEFAIL
! and the CLI facility code. The second part of the SIGNAL
! is the RMS STS and STV error codes.
!-
RETURN SIGNAL((SHR$_PARSEFAIL+3^16),1,DESC,
.IFAB[FAB$L_STS],.IFAB[FAB$L_STV])
END;
END ! End of module
ELUDOM
|
|
