| Document revision date: 15 July 2002 | |
![]() |
|
|
|
| Previous | Contents | Index |
Example 12-2 illustrates the insertion of a module into a library from a Compaq Pascal program. The program is summarized in the following steps:
| Example 12-2 Inserting a Module into a Library Using Compaq Pascal | |||
|---|---|---|---|
PROGRAM insertmod(INPUT,OUTPUT);
(*This program inserts a module into 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 inserts key in index*)
FUNCTION LBR$INSERT_KEY (library_index: UNSIGNED;
key_name:[CLASS_S] PACKED ARRAY [l..u:INTEGER] OF
CHAR;
txtrfa: Rfa_Ptr):
INTEGER; EXTERN;
(*Function that writes data records*)
|
FUNCTION LBR$PUT_RECORD (library_index: UNSIGNED; (*to modules*)
textline:[CLASS_S] PACKED ARRAY [l..u:INTEGER] OF
CHAR;
txtrfa: Rfa_Ptr):
INTEGER; EXTERN;
(*Function that marks end of a module*)
FUNCTION LBR$PUT_END (library_index: UNSIGNED):
INTEGER; EXTERN;
(*Function that closes library*)
FUNCTION LBR$CLOSE (library_index: UNSIGNED):
INTEGER; EXTERN;
BEGIN (* *************** DECLARATIONS COMPLETE *************************
*************** MAIN PROGRAM BEGINS HERE ********************** *)
(*Prompt for library name and
module to insert*)
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 (*Is module already in the library?*)
status := LBR$LOOKUP_KEY (lib_index_ptr, (2)
Module_Name,
txtrfa_ptr);
IF ODD(status) THEN (*Check status. Should not be odd*)
WRITELN('Lookup key was successful.',
'The module is already in the library.')
ELSE (*Did lookup key fail because key not found?*)
IF status = IADDRESS(LBR$_KEYNOTFND) THEN (3)
Key_Not_Found := TRUE
END
END;
|
(******If LBR$LOOKUP_KEY failed because the key was not found
(as expected), we can open the file containing the new module,
and write the module's records to the library file*******)
IF Key_Not_Found THEN
BEGIN
OPEN(Textin,Module_Name,old);
RESET(Textin);
WHILE NOT EOF(Textin) DO (*Repeat until end of file*)
BEGIN (4)
READ(Textin,Text_Data_Record); (*Read record from
external file*)
status := LBR$PUT_RECORD (lib_index_ptr, (*Write*)
Text_Data_Record, (*record to*)
txtrfa_ptr); (*library*)
IF NOT ODD(status) THEN
WRITELN('Put Record Routine Not Successful')
END; (*of WHILE statement*)
IF ODD(status) THEN (*True if all the records have been
successfully written into the library*)
BEGIN
status := LBR$PUT_END (lib_index_ptr); (*Write end of
module record*)
IF NOT ODD(status) THEN
WRITELN('Put End Routine Not Successful')
ELSE (*Insert key for new module*)
BEGIN (5)
status := LBR$INSERT_KEY (lib_index_ptr,
Module_Name,
txtrfa_ptr);
IF NOT ODD(status) THEN
WRITELN('Insert Key Not Successful')
END
END
END;
status := LBR$CLOSE(lib_index_ptr);
IF NOT ODD(status) THEN
WRITELN('Close Not Successful')
END. (*of program insertmod*)
|
Each item in the following list corresponds to a number highlighted in Example 12-2:
Example 12-3 illustrates the extraction of a library module from a Compaq Pascal program. The program is summarized in the following steps:
| Example 12-3 Extracting a Module from a Library Using Compaq Pascal | |||
|---|---|---|---|
PROGRAM extractmod(INPUT,OUTPUT,Textout);
(*This program extracts 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*)
RMS$_EOF : [EXTERNAL] INTEGER; (*RMS return status; defined in
$RMSDEF macro*)
Lib_Name : VARYING [128] OF CHAR; (*Name of library receiving module*)
Module_Name : VARYING [31] OF CHAR; (*Name of module to insert*)
Extracted_File : VARYING [31] OF CHAR; (*Name of file to hold
extracted module*)
Outtext : PACKED ARRAY [1..255] OF CHAR; (*Extracted mod put here,*)
Outtext2 : VARYING [255] OF CHAR; (* then moved to here*)
i : INTEGER; (*For loop control*)
Textout : FILE OF VARYING [255] OF CHAR; (*File containing extracted
module*)
nullstring : CHAR; (*nullstring, pos, and len used to*)
pos, len : INTEGER; (*find string in extracted file recd*)
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*)
(*-*-*-*-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 an 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 retrieves records from modules*)
FUNCTION LBR$GET_RECORD (library_index: UNSIGNED;
var textline:[CLASS_S] PACKED ARRAY [l..u:INTEGER] OF
CHAR):
INTEGER;
EXTERN;
(*Function that closes library*)
FUNCTION LBR$CLOSE (library_index: UNSIGNED):
INTEGER; EXTERN;
BEGIN (* *************** DECLARATIONS COMPLETE *************************
*************** MAIN PROGRAM BEGINS HERE ********************** *)
(* Get Library Name, Module To Extract, And File To Hold Extracted Module *)
WRITE('Library Name: '); READLN(Lib_Name);
WRITE('Module Name: '); READLN(Module_Name);
WRITE('Extract Into File: '); READLN(Extracted_File);
status := LBR$INI_CONTROL (lib_index_ptr, (1)
IADDRESS(LBR$C_UPDATE),
IADDRESS(LBR$C_TYP_TXT));
IF NOT ODD(status) THEN
WRITELN('Initialization Failed')
ELSE
BEGIN
status := LBR$OPEN (lib_index_ptr,
Lib_Name);
IF NOT ODD(status) THEN
WRITELN('Open Not Successful')
ELSE
BEGIN (2)
status := LBR$LOOKUP_KEY (lib_index_ptr,
Module_Name,
txtrfa_ptr);
IF NOT ODD(status) THEN
WRITELN('Lookup Key Not Successful')
ELSE
BEGIN (3)
OPEN(Textout,Extracted_File,new);
REWRITE(Textout)
END
END
END;
WHILE ODD(status) DO
BEGIN
nullstring := ''(0);
FOR i := 1 TO 255 DO (4)
Outtext[i] := nullstring;
status := LBR$GET_RECORD (lib_index_ptr,
Outtext);
IF NOT ODD(status) THEN
BEGIN (5)
IF status = IADDRESS(RMS$_EOF) THEN
WRITELN(' RMS end of file')
END
|
ELSE
BEGIN (6)
pos := INDEX(Outtext, nullstring); (*find first null
in Outtext*)
len := pos - 1; (*length of Outtext to first null*)
IF len >= 1 THEN
BEGIN
Outtext2 := SUBSTR(Outtext,1,LEN);
WRITE(Textout,Outtext2)
END
END
END; (*of WHILE*)
status := LBR$CLOSE(lib_index_ptr);
IF NOT ODD(status) THEN
WRITELN('Close Not Successful')
END. (*of program extractmod*)
|
Each item in the following list corresponds to a number highlighted in Example 12-3:
Example 12-4 illustrates the deletion of library module from a Compaq Pascal program. The program is summarized in the following steps:
| Example 12-4 Deleting a Module from a Library Using Compaq 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*)
|
| Previous | Next | Contents | Index |
|
| privacy and legal statement | ||
| 4493PRO_026.HTML | ||