!++			     MODULE libutil
!
!--

!++
! FACILITY:
!   LIBUTIL - Demonstration of using the TPU callable interface to access
! text libraries.
!
! ABSTRACT:
!   This module calls TPU and provides routines for accessing text libraries.
!
! ENVIRONMENT:
!   VAX/VMS
!
! AUTHOR: Barry Tannenbaum, CREATION DATE: November 19, 1985
!
! MODIFIED BY:
!
!--

MODULE libutil
	(
	ADDRESSING_MODE (EXTERNAL = GENERAL),
	IDENT = '1.0',
	MAIN = libutil_main
	) =

BEGIN

!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
    libutil_close,			! End access to a library entry
    libutil_fileio,			! Routine called by TPU to perform I/O
    libutil_get_record,			! Read a record from a library entry
    libutil_open,			! Access a library entry
    libutil_put_record;			! Write a record to a library entry

!
! INCLUDE FILES:
!
LIBRARY
    'sys$library:starlet';		! System macros and literals

LIBRARY
    'sys$library:xport';		! XPORT data structure macros

!
! Macros
!
MACRO
    init_dyndesc (d) =
	BEGIN
	LOCAL $d$: REF BLOCK [, BYTE];
	$d$ = d;
	$d$ [dsc$w_length] = 0;
	$d$ [dsc$b_class] = dsc$k_class_d;
	$d$ [dsc$b_dtype] = dsc$k_dtype_t;
	$d$ [dsc$a_pointer] = 0;
	END % ;

!
! Data structure declarations
!
$FIELD stream_fields =
    SET
    stream_file_id =	[$INTEGER],
    stream_allocation =	[$SHORT_INTEGER],
    stream_rat =	[$BYTE],
    stream_rfm =	[$BYTE],
    stream_file_name =	[$DESCRIPTOR (DYNAMIC)]
    TES;

LITERAL
    stream_bytes = $FIELD_SET_SIZE * %UPVAL,
    stream_size = $FIELD_SET_SIZE;

MACRO
    stream_block =
	BLOCK [stream_size]
	FIELD (stream_fields) % ;

$FIELD item_fields =
    SET
    item_length =	[$SHORT_INTEGER],
    item_code =		[$SHORT_INTEGER],
    item_buffer_addr =	[$ADDRESS],
    item_return_addr =	[$ADDRESS]
    TES;

LITERAL
    item_bytes = $FIELD_SET_SIZE * %UPVAL,
    item_size = $FIELD_SET_SIZE;

MACRO
    item_block =
	BLOCK [item_size]
	FIELD (item_fields) % ;

$FIELD library_data_fields =
    SET
    library_index =		[$INTEGER],
    library_old_rfa =		[$BYTES (8)],
    library_text_rfa =		[$BYTES (8)],
    library_access =		[$INTEGER],
    library_file_name =		[$DESCRIPTOR (DYNAMIC)],
    library_entry_name =	[$DESCRIPTOR (DYNAMIC)],
    library_lookup_status =	[$INTEGER]
    TES;

LITERAL
    library_data_bytes = $FIELD_SET_SIZE * %UPVAL,
    library_data_size = $FIELD_SET_SIZE;

MACRO
    library_data_block =
	BLOCK [library_data_size]
	FIELD (library_data_fields) % ;

!
! OWN STORAGE:
!
OWN
    library_id_vector:
	VECTOR [512]
	INITIAL (REP 512 OF (0));
!
! EXTERNAL REFERENCES:
!
EXTERNAL LITERAL
    tpu$k_access,			! Item code for access type
    tpu$k_close,			! Code to perform a close operation
    tpu$k_close_delete,			! Code to perform a close and delete operation
    tpu$k_filename,			! Item code for file name
    tpu$k_fileio,			! File I/O routine specified
    tpu$k_get,				! Code to perform a get operation
    tpu$k_input,			! Code for input file processing
    tpu$k_open,				! Code to perform an open operation
    tpu$k_options,			! TPU command line qualifiers present
    tpu$k_put,				! Code to perform a put operation
    tpu$k_sectionfile,			! Section file name specified
    tpu$m_section,			! Mask for section file present
    tpu$m_display,			! Mask for use display
    tpu$_failure,			! Invalid I/O code
    tpu$_success;			! Success status

EXTERNAL ROUTINE
    lbr$close,				! End access to library
    lbr$delete_data,			! Delete library entry
    lbr$get_record,			! Read record from library entry
    lbr$ini_control,			! Initialize librarian
    lbr$lookup_key,			! Position librarian to entry
    lbr$open,				! Access a library file
    lbr$put_end,			! Write an EOR for an entry
    lbr$put_record,			! Write a record to a library entry
    lbr$replace_key,			! Replace entry key
    lib$free_vm,			! Deallocate dynamic_memory,
    str$free1_dx,			! Deallocate dynamic string
    lib$get_vm,				! Allocate dynamic memory
    lib$scopy_r_dx,			! Copy a string to a descriptor
    tpu$cleanup,			! Run down TPU
    tpu$control,			! Run the editor
    tpu$execute_inifile,
    tpu$fileio,				! TPU's file I/O routines
    tpu$handler,			! TPU's signal handler
    tpu$initialize;			! Initialize TPU

%SBTTL 'INIT_CALLBACK - TPU initialization callback routine'

ROUTINE init_callback =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called by TPU to provide an itemlist of initialization
!   information.
!
! IMPLICIT INPUTS:
!
!	LIBUTIL_FILEIO - Routine to handle file I/O and redirect it to
!   a text library.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	The address of the initialization item list is returned.
!
!--

    BEGIN

    OWN
	io_routine_bpv:
	    VECTOR [2]
	    INITIAL (libutil_fileio, 0),
	item_list:
	    BLOCK [item_size * 3],
	end_of_list:			! Must come immediately after item list
	    INITIAL (0),
	options;

    KEYWORDMACRO
	item_init (item,
		   length = 4,
		   code,
		   buffer_addr = 0,
		   return_addr = 0) =
	    BEGIN

	    LOCAL
		$item$:
		    REF item_block;
	    $item$ = item;
	    $item$ [item_length] = length;
	    $item$ [item_code] = code;
	    $item$ [item_buffer_addr] = buffer_addr;
	    $item$ [item_return_addr] = return_addr;
	    END % ;
!
! Set up the item list
!
    item_init (ITEM = item_list,
	       CODE = tpu$k_options,
	       BUFFER_ADDR = options);
    item_init (ITEM = item_list + item_bytes,
	       CODE = tpu$k_sectionfile,
	       BUFFER_ADDR = UPLIT (%ASCII 'tpu$section'),
	       LENGTH = 11);
    item_init (ITEM = item_list + item_bytes * 2,
	       CODE = tpu$k_fileio,
	       BUFFER_ADDR = io_routine_bpv);

    options = tpu$m_section OR tpu$m_display;

    RETURN item_list;

    END;					! Routine init_callback

%SBTTL 'LIBUTIL_CLOSE - End access to a library entry'

ROUTINE libutil_close (stream, data) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine ends access to a library entry.
!
! FORMAL PARAMETERS:
!
!	STREAM - The file control block for the file we're dealing with.
!   Passed by reference.
!	DATA - The I/O operation dependent data.  For a CLOSE operation, this
!   parameter is not used.  Passed by reference.
!
! IMPLICIT INPUTS:
!
!	LIBRARY_ID_VECTOR - Vector that holds the address of the library data
!   block for the library entry being processed.
!
! SUBROUTINES CALLED:
!
!	LIB$FREE_VM (bytes, address) - Deallocates dynamic memory.
!	LBR$CLOSE (library_index) - Closes an open library.
!	LBR$DELETE_DATA (library_index, old_rfa) - Deletes a module from
!   a library
!	LBR$REPLACE_KEY (library_index, entry_name, old_rfa, new_rfa) -
!   Changes the key for a module.
!	LBR$PUT_END (library_index) - Writes an end-of-entry in a library
!   module.
!	STR$FREE1_DX (desc) - Frees the storage allocated in a dynamic
!   string descriptor.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	Any error codes returned by the librarian routines called may be
!   returned by this routine.
!
!--

    BEGIN

    LOCAL
	library_data:
	    REF library_data_block,
	status;

    MAP
	stream:
	    REF stream_block;
!
! Access the library data based on the file id
!
    library_data = .library_id_vector [.stream [stream_file_id]];
!
! If we were writing to the library, 
!
    IF .library_data [library_access] NEQ tpu$k_input
    THEN
	BEGIN
	status = lbr$put_end (library_data [library_index]);
	IF NOT .status
	THEN
	    RETURN .status;
	status = lbr$replace_key (library_data [library_index],
				  library_data [library_entry_name],
				  library_data [library_old_rfa],
				  library_data [library_text_rfa]);
	IF NOT .status
	THEN
	    RETURN .status;
	IF .library_data [library_lookup_status]
	THEN
	    BEGIN
	    status = lbr$delete_data (library_data [library_index],
				      library_data [library_old_rfa]);
	    IF NOT .status
	    THEN
		RETURN .status;
	    END;
	END;
!
! End access to the library entry
!
    status = lbr$close (library_data [library_index]);
!
! Free the library data
!
    IF .status
    THEN
	BEGIN
	str$free1_dx (library_data [library_file_name]);
	str$free1_dx (library_data [library_entry_name]);
	lib$free_vm (UPLIT (library_data_bytes), library_data);
	library_id_vector [.stream [stream_file_id]] = 0;
	END;
!
! All done
!
    RETURN .status;

    END;					! Routine libutil_close

%SBTTL 'LIBUTIL_GET_RECORD - Get a record from the library entry'

ROUTINE libutil_get_record (stream, data) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine reads one record from the library entry.
!
! FORMAL PARAMETERS:
!
!	STREAM - The file control block for the file we're dealing with.
!   Passed by reference.
!	DATA - The I/O operation dependent data.  For a GET operation, this
!   is the descriptor that will receive a record from the text library.  Passed
!   by reference.
!
! IMPLICIT INPUTS:
!
!	LIBRARY_ID_VECTOR - Vector that holds the address of the library data
!   block for the library entry being processed.
!
! SUBROUTINES CALLED:
!
!	LBR$GET_RECORD (library_index, inbufdes [, outbufdes]) - Returns
!   next text record associated with a key.
!	LIB$SCOPY_R_DX (src_desc, dest_desc) - Copies a source string specified
!   by its length and buffer address to a destination string specified by a
!   descriptor.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	Any error codes returned by the librarian routines called may be
!   returned by this routine.
!
!--

    BEGIN

    OWN
	text_buffer:			! Receives record text
	    VECTOR [132, BYTE],
	text_desc:			! Describes text buffer
	    BLOCK [8, BYTE]
	    PRESET (
		[dsc$w_length] = 132,
		[dsc$b_class] = dsc$k_class_s,
		[dsc$b_dtype] = dsc$k_dtype_t,
		[dsc$a_pointer] = text_buffer);

    LOCAL
	library_data:
	    REF library_data_block,
	res_desc:
	    BLOCK [8, BYTE],
	status;

    MAP
	stream:
	    REF stream_block;
!
! Access the library data based on the file id
!
    library_data = .library_id_vector [.stream [stream_file_id]];
!
! Ask for next record
!
    status = lbr$get_record (library_data [library_index], text_desc, res_desc);
!
! If we got it, give it to TPU
!
    IF .status
    THEN
	lib$scopy_r_dx (%REF (.res_desc [dsc$w_length]),
			.res_desc [dsc$a_pointer],
			.data);

    RETURN .status;

    END;					! Routine libutil_get_record

%SBTTL 'LIBUTIL_FILEIO - I/O routine for use by VAXTPU'

ROUTINE libutil_fileio (code, stream, data) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called by VAXTPU to perform file I/O.
!
! FORMAL PARAMETERS:
!
!	CODE - Indicated the type of I/O operation that is to be performed.
!   Passed by reference.
!	STREAM - The file control block for the file we're dealing with.
!   Passed by reference.
!	DATA - The I/O operation dependent data.  Passed by reference.
!
! SUBROUTINES CALLED:
!
!	libutil_close (stream, data) - Routine to end access to a library entry.
!	libutil_get (stream, data) - Routine to read a record from a library
!   entry.
!	libutil_open (stream, data) - Routine to access a library entry.
!	libutil_put (stream, data) - Routine to write a record to a library
!   entry.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	Any of the codes returned by the libutil routines called by
!   this routine will be returned.
!
!--

    BEGIN

    LOCAL
	status;

    MAP
	stream:
	    REF stream_block;
!
! Is this one of ours, or do we pass it to TPU's file I/O routines?
!
    IF (..code NEQ tpu$k_open) AND (.stream [stream_file_id] GTR 511)
    THEN
	RETURN tpu$fileio (.code, .stream, .data);
!
! Either we're opening the file, or we know it's one of ours
!
    SELECTONE ..code OF
	SET

	[tpu$k_open]:
	    status = libutil_open (.stream, .data);

	[tpu$k_close, tpu$k_close_delete]:
	    status = libutil_close (.stream, .data);

	[tpu$k_get]:
	    status = libutil_get_record (.stream, .data);

	[tpu$k_put]:
	    status = libutil_put_record (.stream, .data);

	[OTHERWISE]:
	    status = tpu$_failure;

	TES;

    RETURN .status;

    END;					! Routine libutil_fileio

%SBTTL 'LIBUTIL_MAIN - Main procedure'

ROUTINE libutil_main =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This is the main entry point for the library editing utility.
!
! IMPLICIT INPUTS:
!
!	INIT_CALLBACK - The routine that is to be specified as the
!   initialization callback routine.
!
! SUBROUTINES CALLED:
!
!	TPU$CLEANUP () - Make TPU cleanup after itself.
!	TPU$CONTROL () - Pass control to TPU.
!	TPU$EXECUTE_INIFILE () - Cause TPU to execute the section file
!  initialization procedure and the command file, if specified.
!	TPU$FILEIO (code, stream, data) - TPU routine to perform file I/O
!	TPU$INITIALIZE (initialize_arg) - Initialize TPU.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	Any error codes returned by the TPU routines called may be
!   returned by this routine.
!
!--

    BEGIN

    LOCAL
	initialize_arg:
	    VECTOR [2],
	status;
!
! Set up the TPU condition handler
!
    ENABLE
	tpu$handler;
!
! Initialize the editor
!
    initialize_arg [0] = init_callback;
    initialize_arg [1] = 0;
    IF NOT (status = tpu$initialize (initialize_arg))
    THEN
	RETURN .status;
!
! Execute the command file
!
    IF NOT (status = tpu$execute_inifile())
    THEN
	RETURN .status;
!
! Let TPU do its thing
!
    IF NOT (status = tpu$control ())
    THEN
	RETURN .status;
!
! We're done
!
    tpu$cleanup ();
!
! Bye-bye
!
    RETURN tpu$_success;

    END;					! Routine libutil_main

%SBTTL 'LIBUTIL_OPEN - Access a text library'

ROUTINE libutil_open (stream, data) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine initializes access to a library entry.  If the library
!   specified does not exist, it will be created.
!
! FORMAL PARAMETERS:
!
!	STREAM - The file control block for the file we're dealing with.
!   Passed by reference.
!	DATA - The I/O operation dependent data.  For an OPEN operation, this
!   parameter is an item list of information about the file (library) to be
!   accessed.  Passed by reference.
!
! IMPLICIT INPUTS:
!
!	LIBRARY_ID_VECTOR - Vector that holds the address of the library data
!   block for the library entry being processed.
!
! SUBROUTINES CALLED:
!
!	LIB$FREE_VM (bytes, address) - Deallocates dynamic memory.
!	LIB$GET_VM (bytes, address) - Allocates dynamic memory.
!	LIB$SCOPY_R_DX (src_desc, dest_desc) - Copies a source string specified
!   by its length and buffer address to a destination string specified by a
!   descriptor.
!	LBR$INI_CONTROL (library_index, library_function, library_type) -
!   Initializes the librarian for our access.
!	LBR$LOOKUP_KEY (library_index, entry_name, old_rfa) - Position the
!   librarian to the proper module.
!	LBR$OPEN (library_index, library_name, create_options, default_name) -
!   Opens the library.
!	STR$FREE1_DX (desc) - Frees the storage allocated in a dynamic
!   string descriptor.
!	TPU$FILEIO (code, stream, data) - TPU routine to perform file I/O
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	Any error codes returned by the librarian routines called may be
!   returned by this routine.
!
!--

    BEGIN

    LOCAL
	create_options:
	    BLOCK [cre$c_length, BYTE]
	    PRESET (
		[cre$l_type] = lbr$c_typ_txt,
		[cre$l_keylen] = 31,
		[cre$l_alloc] = 100,
		[cre$l_idxmax] = 1,
		[cre$l_uhdmax] = 0,
		[cre$l_entall] = 100,
		[cre$l_luhmax] = 0,
		[cre$l_vertyp] = cre$c_vmsv3,
		[cre$l_idxopt] = cre$c_mactxtcas),
	entry_name_length,
	file_id,
	file_name_length,
	item:
	    REF item_block,
	library_data:
	    REF library_data_block,
	library_function,
	slash_ptr,
	status;

    MACRO
	abort_library_open =
	    BEGIN
	    str$free1_dx (library_data [library_file_name]);
	    str$free1_dx (library_data [library_entry_name]);
	    lib$free_vm (UPLIT (library_data_bytes), library_data);
	    library_id_vector [.file_id] = 0;
	    END % ;

    MAP
	stream:
	    REF stream_block;
!
! Allocate a file id and space for the library data block
!
    file_id = 0;
    INCR i FROM 0 TO 511 DO
	IF .library_id_vector [.file_id] EQL 0
	THEN
	    BEGIN
	    file_id = .i;
	    EXITLOOP;
	    END;

    stream [stream_file_id] = .file_id;
!
! Initialize the library data
!
    lib$get_vm (UPLIT (library_data_bytes), library_data);
    library_data [library_access] = tpu$k_input;
    init_dyndesc (library_data [library_file_name]);
    init_dyndesc (library_data [library_entry_name]);

    library_id_vector [.file_id] = .library_data;
!
! Process each of the data items passed in the data parameter.  Only look at
!   the items we care about.  Ignore all others.
!
    item = .data;

    WHILE (.item [item_code] NEQ 0) AND (.item [item_length] NEQ 0) DO
	BEGIN

	SELECTONE .item [item_code] OF
	    SET
	    [tpu$k_access]:
		library_data [library_access] = .item [item_buffer_addr];

	    [tpu$k_filename]:
		BEGIN
		slash_ptr = CH$FIND_CH (.item [item_length],
					.item [item_buffer_addr],
					%C'\');
		IF CH$FAIL (.slash_ptr)
		THEN
		    BEGIN
		    abort_library_open;
		    RETURN tpu$fileio (%REF (tpu$k_open), .stream, .data);
		    END;

		file_name_length = .slash_ptr - .item [item_buffer_addr];
		lib$scopy_r_dx (file_name_length,
				.item [item_buffer_addr],
				library_data [library_file_name]);
		lib$scopy_r_dx (%REF (.item [item_length] - .file_name_length
									 - 1),
			       .item [item_buffer_addr] + .file_name_length + 1,
			       library_data [library_entry_name]);
		END;

	    TES;
	item = .item + item_bytes;		! Point to next item
	END;
!
! Initialize the librarian for this entry
!
    IF .library_data [library_access] EQL tpu$k_input
    THEN
	library_function = lbr$c_read
    ELSE
	library_function = lbr$c_update;

    status = lbr$ini_control (library_data [library_index],
			      library_function,
			      UPLIT (lbr$c_typ_txt));
    IF NOT .status
    THEN
	BEGIN
	abort_library_open;
	RETURN .status;
	END;
!
! Try to open the library
!
    status = lbr$open (library_data [library_index],
		       library_data [library_file_name],
		       create_options,
		       %ASCID '.TLB');
!
! If the status is a failure, and we're trying to write, try to create
!   the library file
!
    IF NOT .status and (.library_data [library_access] NEQ tpu$k_input)
    THEN
	BEGIN
	library_function = lbr$c_create;
	status = lbr$ini_control (library_data [library_index],
				  library_function,
				  UPLIT (lbr$c_typ_txt));
	IF NOT .status
	THEN
	    BEGIN
	    abort_library_open;
	    RETURN .status;
	    END;

	status = lbr$open (library_data [library_index],
			   library_data [library_file_name],
			   create_options,
			   %ASCID '.TLB');
	END;
!
! Was the open successful?
!
    IF NOT .status
    THEN
	BEGIN
	abort_library_open;
	RETURN .status;
	END;
!
! Access the entry
!
    status = lbr$lookup_key (library_data [library_index],
			     library_data [library_entry_name],
			     library_data [library_old_rfa]);

    library_data [library_lookup_status] = .status;
!
! All done
!
    RETURN tpu$_success;

    END;					! Routine libutil_open

%SBTTL 'LIBUTIL_PUT_RECORD - Write a record to the library'

ROUTINE libutil_put_record (stream, data) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine writes a record to a text library entry.
!
! FORMAL PARAMETERS:
!
!	STREAM - The file control block for the file we're dealing with.
!   Passed by reference.
!	DATA - The I/O operation dependent data.  For a PUT operation, this
!   is the descriptor that contains a record to be written to the text library
!   entry.  Passed by reference.
!
! IMPLICIT INPUTS:
!
!	LIBRARY_ID_VECTOR - Vector that holds the address of the library data
!   block for the library entry being processed.
!
! SUBROUTINES CALLED:
!
!	LBR$PUT_RECORD (library_index, text, text_rfa) - Write a record to
!   a library module.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	Any error codes returned by the librarian routines called may be
!   returned by this routine.
!
!--

    BEGIN

    LOCAL
	library_data:
	    REF library_data_block;

    MAP
	stream:
	    REF stream_block;
!
! Access the library data based on the file id
!
    library_data = .library_id_vector [.stream [stream_file_id]];

    RETURN lbr$put_record (library_data [library_index], .data,
			   library_data [library_text_rfa]);

    END;					! Routine libutil_put_record

END						! Module libutil

ELUDOM