|
HP OpenVMS Utility Routines Manual
Each item in the following list corresponds to a number highlighted in
Example 13-3:
- Call LBR$INI_CONTROL, specifying that the
function to be performed is update and that the library type is text.
- Call LBR$LOOKUP_KEY to find the key that
points to the module you want to extract.
- Open an output file to receive the extracted
module.
- Initialize the variable that is to receive
the extracted records to null characters.
- Call LBR$GET_RECORD to see if there are more
records in the file (module). A failure indicates that the end of the
file has been reached.
- Write the extracted record data to the output
file. This record should consist only of the data up to the first null
character.
13.2.4 Deleting a Module
Example 13-4 illustrates the deletion of library module from a HP
Pascal program. The program is summarized in the following steps:
- Call LBR$LOOKUP_KEY, and specify the name of the module as the
second argument. LBR$LOOKUP_KEY returns the RFA of the module as the
third argument; do not alter this value.
- Call LBR$DELETE_KEY to delete the module key. Specify the name of
the module as the second argument.
- Call LBR$DELETE_DATA to delete the module itself. Specify the RFA
of the module obtained in Step 1 as the second argument.
Example 13-4 Deleting a Module from a Library
Using HP Pascal |
PROGRAM deletemod(INPUT,OUTPUT);
(*This program deletes a module from a library*)
TYPE
Rfa_Ptr = ARRAY [0..1] OF INTEGER; (*Data type of RFA of module*)
VAR
LBR$C_UPDATE, (*Constants for LBR$INI_CONTROL*)
LBR$C_TYP_TXT, (*Defined in $LBRDEF macro*)
LBR$_KEYNOTFND : [EXTERNAL] INTEGER;(*Error code for LBR$LOOKUP_KEY*)
Lib_Name : VARYING [128] OF CHAR; (*Name of library receiving module*)
Module_Name : VARYING [31] OF CHAR; (*Name of module to insert*)
Text_Data_Record : VARYING [255] OF CHAR; (*Record in new module*)
Textin : FILE OF VARYING [255] OF CHAR; (*File containing new module*)
lib_index_ptr : UNSIGNED; (*Value returned in library init*)
status : UNSIGNED; (*Return status for function calls*)
txtrfa_ptr : Rfa_Ptr; (*For key lookup and insertion*)
Key_Not_Found : BOOLEAN := FALSE; (*True if new mod not already in lib*)
(*-*-*-*-Function Definitions-*-*-*-*)
(*Function that returns library
control index used by Librarian*)
FUNCTION LBR$INI_CONTROL (VAR library_index: UNSIGNED;
func: UNSIGNED;
typ: UNSIGNED;
VAR namblk: ARRAY[l..u:INTEGER]
OF INTEGER := %IMMED 0):
INTEGER; EXTERN;
(*Function that creates/opens library*)
FUNCTION LBR$OPEN (library_index: UNSIGNED;
fns: [class_s]PACKED ARRAY[l..u:INTEGER] OF CHAR;
create_options: ARRAY [l2..u2:INTEGER] OF INTEGER :=
%IMMED 0;
dns: [CLASS_S] PACKED ARRAY [l3..u3:INTEGER] OF CHAR
:= %IMMED 0;
rlfna: ARRAY [l4..u4:INTEGER] OF INTEGER := %IMMED 0;
rns: [CLASS_S] PACKED ARRAY [l5..u5:INTEGER] OF CHAR :=
%IMMED 0;
VAR rnslen: INTEGER := %IMMED 0):
INTEGER; EXTERN;
(*Function that finds a key in index*)
FUNCTION LBR$LOOKUP_KEY (library_index: UNSIGNED;
key_name:[CLASS_S] PACKED ARRAY [l..u:INTEGER] OF
CHAR;
VAR txtrfa: Rfa_Ptr):
INTEGER; EXTERN;
(*Function that removes a key from an index*)
FUNCTION LBR$DELETE_KEY (library_index: UNSIGNED;
key_name:[CLASS_S] PACKED ARRAY [l..u:INTEGER] OF
CHAR):
INTEGER;
EXTERN;
|
(*Function that deletes all the records
associated with a module*)
FUNCTION LBR$DELETE_DATA (library_index: UNSIGNED;
txtrfa: Rfa_Ptr):
INTEGER;
EXTERN;
(*Function that closes library*)
FUNCTION LBR$CLOSE (library_index: UNSIGNED):
INTEGER; EXTERN;
BEGIN (* *************** DECLARATIONS COMPLETE *************************
*************** MAIN PROGRAM BEGINS HERE ********************** *)
(* Get Library Name and Module to Delete *)
WRITE('Library Name: '); READLN(Lib_Name);
WRITE('Module Name: '); READLN(Module_Name);
(*Initialize lib for update access*)
status := LBR$INI_CONTROL (lib_index_ptr, (1)
IADDRESS(LBR$C_UPDATE), (*Update access*)
IADDRESS(LBR$C_TYP_TXT)); (*Text library*)
IF NOT ODD(status) THEN (*Check error status*)
WRITELN('Initialization Failed')
ELSE (*Initialization was successful*)
BEGIN
status := LBR$OPEN (lib_index_ptr, (*Open the library*)
Lib_Name);
IF NOT ODD(status) THEN (*Check error status*)
WRITELN('Open Not Successful')
ELSE (*Open was successful*)
BEGIN (2) (*Is module in the library?*)
status := LBR$LOOKUP_KEY (lib_index_ptr,
Module_Name,
txtrfa_ptr);
IF NOT ODD(status) THEN (*Check status*)
WRITELN('Lookup Key Not Successful')
END
END;
IF ODD(status) THEN (*Key was found; delete it*)
BEGIN
status := LBR$DELETE_KEY (lib_index_ptr, (3)
Module_Name);
IF NOT ODD(status) THEN
WRITELN('Delete Key Routine Not Successful')
ELSE (*Delete key was successful*)
BEGIN (*Now delete module's data records*)
status := LBR$DELETE_DATA (lib_index_ptr, (4)
txtrfa_ptr);
IF NOT ODD(status) THEN
WRITELN('Delete Data Routine Not Successful')
END
END;
status := LBR$CLOSE(lib_index_ptr); (*Close the library*)
IF NOT ODD(status) THEN
WRITELN('Close Not Successful');
END. (*of program deletemod*)
|
Each item in the following list corresponds to a number highlighted in
Example 13-4:
- Call LBR$INI_CONTROL, specifying that the
function to be performed is update and the library type is text.
- Call LBR$LOOKUP_KEY to find the key
associated with the module you want to delete.
- Call LBR$DELETE_KEY to delete the key
associated with the module you want to delete. If more than one key
points to the module, you need to call LBR$LOOKUP_KEY and
LBR$DELETE_KEY for each key.
- Call LBR$DELETE_DATA to delete the module
(the module header and data) from the library.
13.2.5 Using Multiple Keys and Multiple Indexes
You can point to the same module with more than one key. The keys can
be in the primary index (index 1) or alternate indexes (indexes 2
through 10). The best method is to reserve the primary index for module
names. In system-defined object libraries, index 2 contains the global
symbols defined by the various modules.
Example 13-5 illustrates the way that keys can be associated with
modules.
Example 13-5 Associating Keys with
Modules |
SUBROUTINE ALIAS (INDEX)
! Catalogs modules by alias
INTEGER STATUS, ! Return status
INDEX, ! Library index
TXTRFA (2) ! RFA of module
CHARACTER*31 MODNAME, ! Name of module
ALIASNAME ! Name of alias
INTEGER MODNAME_LEN ! Length of module name
INTEGER ALIASNAME_LEN ! Length of alias name
! VMS library procedures
INTEGER LBR$LOOKUP_KEY,
LBR$SET_INDEX,
LBR$INSERT_KEY,
LIB$GET_INPUT,
LIB$GET_VALUE
LIB$LOCC
! Return codes
EXTERNAL LBR$_KEYNOTFND, ! Key not found
LBR$_DUPKEY, ! Duplicate key
RMS$_EOF, ! End of text in module
DOLIB_NOMOD ! No such module
! Get module name from /ALIAS on command line
CALL CLI$GET_VALUE ('ALIAS', MODNAME)
! Calculate length of module name
MODNAME_LEN = LIB$LOCC (' ', MODNAME) - 1
! Look up module name in library index
STATUS = LBR$LOOKUP_KEY (INDEX,
MODNAME (1:MODNAME_LEN),
TXTRFA)
END IF
! Insert aliases if module exists
IF (STATUS) THEN
! Set to index 2
STATUS = LBR$SET_INDEX (INDEX, 2)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Get alias name from /ALIAS on command line
STATUS = CLI$GET_VALUE ('ALIAS', ALIASNAME)
! Insert aliases in index 2 until bad return status
! which indicates end of qualifier values
DO WHILE (STATUS)
! Calculate length of alias name
ALIASNAME_LEN = LIB$LOCC (' ', ALIASNAME) - 1
! Put alias name in index
STATUS = LBR$INSERT_KEY (INDEX,
ALIASNAME (1:ALIASNAME_LEN),
TXTRFA)
IF ((.NOT. STATUS) .AND.
(STATUS .NE. %LOC (LBR$_DUPKEY)) THEN
CALL LIB$SIGNAL (%VAL (STATUS))
END IF
! Get another alias
STATUS = CLI$GET_VALUE ('ALIAS', ALIASNAME)
END DO
! Issue warning if module does not exist
ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN
CALL LIB$SIGNAL (DOLIB_NOMOD,
%VAL (1),
MODNAME (1:MODNAME_LEN))
ELSE
CALL LIB$SIGNAL (%VAL (STATUS))
END IF
! Exit
END
|
You can look up a module using any of the keys associated with it. The
following code fragment checks index 2 for a key if the lookup in the
primary index fails:
STATUS = LBR$SET_INDEX (INDEX, 1)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
STATUS = LBR$LOOKUP_KEY (INDEX,
MODNAME (1:MODNAME_LEN),
TXTRFA)
IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN
STATUS = LBR$SET_INDEX (INDEX, 2)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
STATUS = LBR$LOOKUP_KEY (INDEX,
MODNAME (1:MODNAME_LEN),
TXTRFA)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
END IF
|
There are two ways to identify the keys associated with a module:
- Use the LBR$LOOKUP_KEY routine to look up the module using one of
the keys.
- Use LBR$SEARCH to search applicable indexes for the keys.
LBR$SEARCH calls a user-written routine each time it retrieves a key.
The routine must be an integer function defined as external that
returns a success (odd number) or failure (even number) status.
LBR$SEARCH stops processing on a return status of failure.
The subroutine in Example 13-6 lists the names of keys in index 2 (the
aliases) that point to a module identified on the command line by the
module's name in the primary index.
Example 13-6 Listing Keys Associated with a
Module |
.
.
.
SUBROUTINE SHOWAL (INDEX)
! Lists aliases for a module
INTEGER STATUS, ! Return status
INDEX, ! Library index
TXTRFA (2) ! RFA for module text
CHARACTER*31 MODNAME ! Name of module
INTEGER MODNAME_LEN ! Length of module name
! VMS library procedures
INTEGER LBR$LOOKUP_KEY,
LBR$SEARCH,
LIB$LOCC
! Return codes
EXTERNAL LBR$_KEYNOTFND, ! Key not found
DOLIB_NOMOD ! No such module
! Search routine
EXTERNAL SEARCH
INTEGER SEARCH
! Get module name and calculate length
CALL CLI$GET_VALUE ('SHOWALIAS', MODNAME)
MODNAME_LEN = LIB$LOCC (' ', MODNAME) - 1
! Look up module in index 1
STATUS = LBR$LOOKUP_KEY (INDEX,
MODNAME (1:MODNAME_LEN),
TXTRFA)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Search for alias names in index 2
STATUS = LBR$SEARCH (INDEX,
2,
TXTRFA,
SEARCH)
END
INTEGER FUNCTION SEARCH (ALIASNAME, RFA)
! Function called for each alias name pointing to MODNAME
! Displays the alias name
INTEGER STATUS_OK, ! Good return status
RFA (2) ! RFA of module
PARAMETER (STATUS_OK = 1) ! Odd number
CHARACTER*(*) ALIASNAME ! Name of module
! Display module name
TYPE *, MODNAME
! Exit
SEARCH = STATUS_OK
END
|
13.2.6 Accessing Module Headers
You can store user information in the header of each module up to the
total size of the header specified at library creation time in the
CRE$L_UHDMAX option. The total size of each header in bytes is the
value of MHD$B_USRDAT plus the value assigned to the CRE$L_UHDMAX
option. The value of MHD$B_USRDAT is defined by the macro $MHDDEF; the
default value is 16 bytes.
To put user data into a module header, first locate the module with
LBR$LOOKUP_KEY; then move the data to the module header by invoking
LBR$SET_MODULE, specifying the first argument (index value returned by
LBR$INI_CONTROL), the second argument (RFA returned by LBR$LOOKUP_KEY),
and the fifth argument (character string containing the user data).
To read user data from a module header, first locate the module with
LBR$LOOKUP_KEY; then, retrieve the entire module header by invoking
LBR$SET_MODULE, specifying the first, second, third (character string
to receive the contents of the module header), and fourth (length of
the module header) arguments. The user data starts at the byte offset
defined by MHD$B_USRDAT. Convert this value to a character string
subscript by adding 1.
Example 13-7 displays the user data portion of module headers on
SYS$OUTPUT and applies updates from SYS$INPUT.
Example 13-7 Displaying the Module Header |
.
.
.
SUBROUTINE MODHEAD (INDEX)
! Modifies module headers
INTEGER STATUS, ! Return status
INDEX, ! Library index
TXTRFA (2) ! RFA of module
CHARACTER*31 MODNAME ! Name of module
INTEGER MODNAME_LEN ! Length of module name
CHARACTER*80 HEADER ! Module header
INTEGER HEADER_LEN ! Length of module header
INTEGER USER_START ! Start of user data in header
CHARACTER*64 USERDATA ! User data part of header
INTEGER*2 USERDATA_LEN ! Length of user data
! VMS library procedures
INTEGER LBR$LOOKUP_KEY,
LBR$SET_MODULE,
LIB$GET_INPUT,
LIB$PUT_OUTPUT,
CLI$GET_VALUE,
LIB$LOCC
! Offset to user data --- defined in $MHDDEF
EXTERNAL MHD$B_USRDAT
! Return codes
EXTERNAL LBR$_KEYNOTFND, ! Key not found
DOLIB_NOMOD ! No such module
! Calculate start of user data in header
USER_START = %LOC (MHD$B_USRDAT) + 1
! Get module name from /MODHEAD on command line
STATUS = CLI$GET_VALUE ('MODHEAD', MODNAME)
! Get module headers until bad return status
! which indicates end of qualifier values
DO WHILE (STATUS)
! Calculate length of module name
MODNAME_LEN = LIB$LOCC (' ', MODNAME) - 1
! Look up module name in library index
STATUS = LBR$LOOKUP_KEY (INDEX,
MODNAME (1:MODNAME_LEN),
TXTRFA)
! Get header if module exists
IF (STATUS) THEN
STATUS = LBR$SET_MODULE (INDEX,
TXTRFA,
HEADER,
HEADER_LEN)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Display header and solicit replacement
STATUS = LIB$PUT_OUTPUT
('User data for module '//MODNAME (1:MODNAME_LEN)//':')
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
STATUS = LIB$PUT_OUTPUT
(HEADER (USER_START:HEADER_LEN))
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
STATUS = LIB$PUT_OUTPUT
('Enter replacement text below or just hit return:')
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
STATUS = LIB$GET_INPUT (USERDATA,, USERDATA_LEN)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Replace user data
IF (USERDATA_LEN .GT. 0) THEN
STATUS = LBR$SET_MODULE (INDEX,
TXTRFA,,,
USERDATA (1:USERDATA_LEN))
END IF
! Issue warning if module does not exist
ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN
CALL LIB$SIGNAL (DOLIB_NOMOD,
%VAL (1),
MODNAME (1:MODNAME_LEN))
ELSE
CALL LIB$SIGNAL (%VAL (STATUS))
END IF
! Get another module name
STATUS = CLI$GET_VALUE ('MODHEAD', MODNAME)
END DO
! Exit
END
|
13.2.7 Reading Library Headers
Call LBR$GET_HEADER to obtain general information concerning the
library. Pass the value returned by LBR$INI_CONTROL as the first
argument. LBR$GET_HEADER returns the information to the second
argument, which must be an array of 128 longwords. The LHI symbols
identify the significant longwords of the array by their byte offsets
into the array. Convert these values to subscripts by dividing by 4 and
adding 1.
Example 13-8 reads the library header and displays some information
from it.
Example 13-8 Reading Library Headers |
.
.
.
SUBROUTINE TYPEINFO (INDEX)
! Types the type, major ID, and minor ID
! of a library to SYS$OUTPUT
INTEGER STATUS ! Return status
INDEX, ! Library index
HEADER (128), ! Structure for header information
TYPE, ! Subscripts for header structure
MAJOR_ID,
MINOR_ID
CHARACTER*8 MAJOR_ID_TEXT, ! Display info in character format
MINOR_ID_TEXT
! VMS library procedures
INTEGER LBR$GET_HEADER,
LIB$PUT_OUTPUT
! Offsets for header --- defined in $LHIDEF
EXTERNAL LHI$L_TYPE,
LHI$L_MAJORID,
LHI$L_MINORID
! Library type values --- defined in $LBRDEF
EXTERNAL LBR$C_TYP_OBJ,
LBR$C_TYP_MLB,
LBR$C_TYP_HLP,
LBR$C_TYP_TXT
! Get header information
STATUS = LBR$GET_HEADER (INDEX, HEADER)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Calculate subscripts for header structure
TYPE = %LOC (LHI$L_TYPE) / 4 + 1
MAJOR_ID = %LOC (LHI$L_MAJORID) / 4 + 1
MINOR_ID = %LOC (LHI$L_MINORID) / 4 + 1
! Display library type
IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_OBJ)) THEN
STATUS = LIB$PUT_OUTPUT ('Library type: object')
ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_MLB)) THEN
STATUS = LIB$PUT_OUTPUT ('Library type: macro')
ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_HLP)) THEN
STATUS = LIB$PUT_OUTPUT ('Library type: help')
ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_TXT)) THEN
STATUS = LIB$PUT_OUTPUT ('Library type: text')
ELSE
STATUS = LIB$PUT_OUTPUT ('Library type: unknown')
END IF
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Convert and display major ID
WRITE (UNIT=MAJOR_ID_TEXT,
FMT='(I)') HEADER (MAJOR_ID)
STATUS = LIB$PUT_OUTPUT ('Major ID: '//MAJOR_ID_TEXT)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Convert and display minor ID
WRITE (UNIT=MINOR_ID_TEXT,
FMT='(I)') HEADER (MINOR_ID)
STATUS = LIB$PUT_OUTPUT ('Minor ID: '//MINOR_ID_TEXT)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Exit
END
|
13.2.8 Displaying Help Text
You can display text from a help library by calling the LBR$OUTPUT_HELP
routine and specifying the output routine, the keywords, and the name
of the library. You must also specify the input routine if the
prompting mode flag is set or if the flags argument is
omitted.
Note
If you specify subprograms in an argument list, they must be declared
as external.
|
You can use the LIB$PUT_OUTPUT and LIB$GET_INPUT routines to specify
the output routine and the input routine. (If you use your own
routines, make sure the argument lists are the same as for
LIB$PUT_OUTPUT and LIB$GET_INPUT.) Do not call LBR$INI_CONTROL and
LBR$OPEN before calling LBR$OUTPUT_HELP.
Example 13-9 solicits keywords from SYS$INPUT and displays the text
associated with those keywords on SYS$OUTPUT, thus inhibiting the
prompting facility.
Example 13-9 Displaying Text from a Help
Library |
PROGRAM GET_HELP
! Prints help text from a help library
CHARACTER*31 LIBSPEC ! Library name
CHARACTER*15 KEYWORD ! Keyword in help library
INTEGER*2 LIBSPEC_LEN, ! Length of name
KEYWORD_LEN ! Length of keyword
INTEGER FLAGS, ! Help flags
STATUS ! Return status
! VMS library procedures
INTEGER LBR$OUTPUT_HELP,
LIB$GET_INPUT,
LIB$PUT_OUTPUT
EXTERNAL LIB$GET_INPUT,
LIB$PUT_OUTPUT
! Error codes
EXTERNAL RMS$_EOF, ! End-of-file
LIB$_INPSTRTRU ! Input string truncated
! Flag values --- defined in $HLPDEF
EXTERNAL HLP$M_PROMPT,
HLP$M_PROCESS,
HLP$M_GROUP,
HLP$M_SYSTEM,
HLP$M_LIBLIST,
HLP$M_HELP
! Get library name
STATUS = LIB$GET_INPUT (LIBSPEC,
'Library: ',
LIBSPEC_LEN)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
IF (LIBSPEC_LEN .EQ. 0) THEN
LIBSPEC = 'HELPLIB'
LIBSPEC_LEN = 7
END IF
! Set flags for no prompting
FLAGS = %LOC (HLP$_PROCESS) +
%LOC (HLP$_GROUP) +
%LOC (HLP$_SYSTEM)
! Get first keyword
STATUS = LIB$GET_INPUT (KEYWORD,
'Keyword or Ctrl/Z: ',
KEYWORD_LEN)
IF ((.NOT. STATUS) .AND.
(STATUS .NE. %LOC (LIB$_INPSTRTRU)) .AND.
(STATUS .NE. %LOC (RMS$_EOF))) THEN
CALL LIB$SIGNAL (%VAL (STATUS))
END IF
! Display text until end-of-file
DO WHILE (STATUS .NE. %LOC (RMS$_EOF))
STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT,,
KEYWORD (1:KEYWORD_LEN),
LIBSPEC (1:LIBSPEC_LEN),
FLAGS,
LIB$GET_INPUT)
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
! Get another keyword
STATUS = LIB$GET_INPUT (KEYWORD,
'Keyword or Ctrl/Z: ',
KEYWORD_LEN)
IF ((.NOT. STATUS) .AND.
(STATUS .NE. %LOC (LIB$_INPSTRTRU)) .AND.
(STATUS .NE. %LOC (RMS$_EOF))) THEN
CALL LIB$SIGNAL (%VAL (STATUS))
END IF
END DO
! Exit
END
|
|