MODULE UTIL$ITEMLIST (IDENT = 'V00A01'
		) =
BEGIN
!
!			  COPYRIGHT (C) 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	General Utilities
!
! ABSTRACT:
!
!	This module contains routines that make it easy for
!	high-level languages to use itemlists.
!
! ENVIRONMENT:
!
! AUTHOR: Stanley Rabinowitz,	CREATION DATE: 4-Feb-1985.
!
! MODIFIED BY: Stanley Rabinowitz
!
! V00A01	 4-Feb-1985	Stan	Initial version
!--

!+
! Set addressing modes to be used.
!-

SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);

!+
! Declare PSECTs to be used.
!-
PSECT
    CODE = _UTIL$CODE(READ, NOWRITE, EXECUTE, SHARE, PIC, ADDRESSING_MODE (WORD_RELATIVE)),
    PLIT = _UTIL$CODE(READ, NOWRITE, EXECUTE, SHARE, PIC, ADDRESSING_MODE (WORD_RELATIVE)),
    OWN = _UTIL$DATA(READ, WRITE, NOEXECUTE, NOSHARE, PIC, ADDRESSING_MODE (LONG_RELATIVE)),
    GLOBAL = _UTIL$DATA(READ, WRITE, NOEXECUTE, NOSHARE, PIC, ADDRESSING_MODE (LONG_RELATIVE));

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    UTIL$CREATE_ITEMLIST,
    UTIL$ADD_ITEM_TO_ITEMLIST,
    UTIL$ADD_ITEM_TO_ITEMLIST_DX,
    UTIL$DELETE_ITEMLIST,
    UTIL$CLEAR_ITEMLIST;

!
! INCLUDE FILES:
!

LIBRARY 'SYS$LIBRARY:STARLET';

!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!

EXTERNAL LITERAL
    LIB$_INVARG;


GLOBAL ROUTINE UTIL$CREATE_ITEMLIST (		!
	P_MAX_ITEMS, 				!
	P_ITEMLIST_ADDR) =
    BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Creates a new (empty) itemlist, capable of handling
!	a specified number of items (maximum).
!
! CALLING PROCEDURE:
!
!	STATUS.wl.v=UTIL$CREATE_ITEMLIST(MAX-ITEMS.rl.r,ITEMLIST-ADDR.wl.r)
!
! FORMAL PARAMETERS:
!
!	MAX-ITEMS.rl.r		Maximum number of items the itemlist
!				is to be able to handle.
!
!	ITEMLIST-ADDR.wl.r	Address of longword to receive the address
!				of the newly created itemlist.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	Routine completed successfully
!
!	LIB$_INVARG	MAX-ITEMS too large (more than 256).
!
!	LIB$_xyz	any error returned by LIB$GET_VM
!
! SIDE EFFECTS:
!
!	Virtual memory gets allocated.
!	Note that additional memory is allocated before the address
!	of the beginning of the itemlist.  This memory is to be used
!	ONLY by these routines; so the caller should never know about
!	them or muck with them.  The caller must not return this VA
!	to the freelist himself, but must ALWAYS call UTIL$DELETE_ITEMLIST
!	to free this memory.
!
!--

    BIND
	MAX_ITEMS = .P_MAX_ITEMS,
	ITEMLIST = .P_ITEMLIST_ADDR : REF VECTOR;

    LOCAL
	STATUS;

    BUILTIN
	ACTUALCOUNT;

    EXTERNAL ROUTINE
	LIB$GET_VM;

    IF ACTUALCOUNT () LSSU 2 OR .MAX_ITEMS GTRU 256 THEN RETURN LIB$_INVARG;

!+
! Allocate virtual memory to hold the itemlist.
! Allocate 3 longwords before the itemlist.
!	LIST[-1] will hold the current number of entries.
!	LIST[-2] will hold the maximum number of entries.
!	LIST[-3] will hold a structure ident, used for validity checking.
!-
    STATUS = LIB$GET_VM (%REF (.MAX_ITEMS*ITM$S_ITEM + 16), ITEMLIST);

    IF NOT .STATUS THEN RETURN .STATUS;

    ITEMLIST = .ITEMLIST + 12;			! 12=3*4 (3 overhead longwords)
    ITEMLIST [-3] = 'STAN';
    ITEMLIST [-2] = .MAX_ITEMS;
    ITEMLIST [-1] = 0;
    ITEMLIST [0] = 0;
    RETURN SS$_NORMAL
    END;


GLOBAL ROUTINE UTIL$CLEAR_ITEMLIST (P_ITEMLIST_ADDR) =
    BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Clears an exisiting itemlist.  That is, it empties it
!	so that it can be used again.
!
! CALLING PROCEDURE:
!
!	STATUS.wl.v=UTIL$CLEAR_ITEMLIST(ITEMLIST-ADDR.rl.r)
!
! FORMAL PARAMETERS:
!
!	ITEMLIST-ADDR.rl.r	Address of longword to containing the address
!				of the itemlist to be cleared.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	Routine completed successfully
!
!	LIB$_INVARG	Argument was not the address of an itemlist
!			created by UTIL$CREATE_ITEMLIST.
!
! SIDE EFFECTS:
!
!	NONE
!--

    BIND
	ITEMLIST = .P_ITEMLIST_ADDR : REF VECTOR;

    IF .ITEMLIST [-3] NEQ 'STAN' THEN RETURN LIB$_INVARG;

    ITEMLIST [0] = 0;
    ITEMLIST [-1] = 0;
    RETURN SS$_NORMAL
    END;


GLOBAL ROUTINE UTIL$DELETE_ITEMLIST (P_ITEMLIST_ADDR) =
    BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Deletes an itemlist, returning all allocated memory to freespace.
!
! CALLING PROCEDURE:
!
!	STATUS.wl.v=UTIL$DELETE_ITEMLIST(ITEMLIST-ADDR.rl.r)
!
! FORMAL PARAMETERS:
!
!	ITEMLIST-ADDR.rl.r	Address of longword to containing the address
!				of the itemlist to be deleted.
!
! IMPLICIT INPUTS:
!
!	Data in 3 longwords preceding itemlist contains information
!	about size of itemlist.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	Routine completed successfully
!
!	LIB$_xyz	any error returned by LIB$FREE_VM.
!
!	LIB$_INVARG	Arguemnt was not address of valid itemlist.
!
! SIDE EFFECTS:
!
!	NONE
!--

    EXTERNAL ROUTINE
	LIB$FREE_VM;

    BIND
	ITEMLIST = .P_ITEMLIST_ADDR : REF VECTOR;

    LOCAL
	STATUS;

    IF .ITEMLIST [-3] NEQ 'STAN' THEN RETURN LIB$_INVARG;

    ITEMLIST [-3] = 0;
    RETURN LIB$FREE_VM (%REF (.ITEMLIST [-2]*ITM$S_ITEM + 16), 	!
	%REF (ITEMLIST [-3]))
    END;


GLOBAL ROUTINE UTIL$ADD_ITEM_TO_ITEMLIST (		!
	P_ITEMLIST_ADDR, 				!
	P_BUFSIZ, 					!
	P_ITMCOD, 					!
	BUFADR, 					!
	RETLEN) =
    BEGIN

!++
! FUNCTIONAL DESCRIPTION:
!
!	Adds a new item to an existing itemlist.
!
! CALLING PROCEDURE:
!
!	STATUS.wl.v=UTIL$ADD_ITEM_TO_ITEMLIST(ITEMLIST-ADDR.rl.r,
!			BUFSIZ.rl.r,ITMCOD.rl.r,BUFADR.rl.r [,RETLEN.rl.r] )
!
! FORMAL PARAMETERS:
!
!	ITEMLIST-ADDR.wl.r	Address of longword containing the address
!				of the itemlist.
!
!	BUFSIZ.rl.r		Size of buffer to receive result.
!				Must be specified.  If result is to
!				fit in a longword, then specify a 4 here.
!
!	ITMCOD.rl.r		Code for item to be retrieved.
!
!	BUFADR.rl.r		(Address of) buffer to receive result.
!
!	[RETLEN.rl.r]		(Address of a) WORD to receive actual length
!				of returned data (in bytes). If omittted,
!				then this length is not returned.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	Routine completed successfully
!
!	LIB$_INVARG	Invalid itemlist specified.
!
! SIDE EFFECTS:
!
!	NONE
!--

    BIND
	ITMCOD = .P_ITMCOD,
	BUFSIZ = .P_BUFSIZ,
	ITEMLIST = .P_ITEMLIST_ADDR : REF VECTOR,
	ITEM = ITEMLIST [3*.ITEMLIST [-1]] : $BBLOCK;

    BUILTIN
	NULLPARAMETER;

    IF .ITEMLIST [-3] NEQ 'STAN' THEN RETURN LIB$_INVARG;

!+
! Make sure itemlist is not full.
!-

    IF .ITEMLIST [-1] EQL .ITEMLIST [-2] THEN RETURN LIB$_INVARG;

    ITEM [ITM$W_BUFSIZ] = .BUFSIZ;
    ITEM [ITM$W_ITMCOD] = .ITMCOD;
    ITEM [ITM$L_BUFADR] = .BUFADR;

    IF NULLPARAMETER (RETLEN) 
    THEN 
	ITEM [ITM$L_RETLEN] = 0 
    ELSE 
	ITEM [ITM$L_RETLEN] = .RETLEN;

!+
! Note that there is now one more item in this itemlist.
!-
    ITEMLIST [-1] = .ITEMLIST [-1] + 1;
!+
! Zero the next longword.
!-
    ITEMLIST [3*.ITEMLIST [-1]] = 0;
    RETURN SS$_NORMAL
    END;


GLOBAL ROUTINE UTIL$ADD_ITEM_TO_ITEMLIST_DX (		!
	P_ITEMLIST_ADDR, 				!
	P_BUFFER_DESC, 					!
	P_ITMCOD, 					!
	RETLEN) =
    BEGIN

!++
! FUNCTIONAL DESCRIPTION:
!
!	Adds a new item to an existing itemlist, using a descriptor
!	to specify the address of the buffer.
!
! CALLING PROCEDURE:
!
!	STATUS.wl.v=UTIL$ADD_ITEM_TO_ITEMLIST(ITEMLIST-ADDR.rl.r,
!			BUFFER.rt.dx,ITMCOD.rl.r, [,RETLEN.rl.r] )
!
! FORMAL PARAMETERS:
!
!	ITEMLIST-ADDR.wl.r	Address of longword containing the address
!				of the itemlist.
!
!	BUFFER.rt.dx		Descriptor for buffer to hold result.
!				The length of this descriptor determines
!				the size of the buffer.  This length is not
!				modified in the descriptor, even if it is
!				a dynamic descriptor.
!
!	ITMCOD.rl.r		Code for item to be retrieved.
!
!	[RETLEN.rl.r]		(Address of a) WORD to receive actual length
!				of returned data (in bytes). If omittted,
!				then this length is not returned.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	Routine completed successfully
!
!	LIB$_INVARG	Invalid itemlist specified.
!
! SIDE EFFECTS:
!
!	NONE
!--

    BIND
	ITMCOD = .P_ITMCOD,
	BUFFER_DESC = .P_BUFFER_DESC,
	ITEMLIST = .P_ITEMLIST_ADDR : REF VECTOR,
	ITEM = ITEMLIST [3*.ITEMLIST [-1]] : $BBLOCK;

    LOCAL
	STATUS,
	BUFLEN : WORD,
	BUFADR;

    BUILTIN
	NULLPARAMETER;

    EXTERNAL ROUTINE
	LIB$ANALYZE_SDESC;

    IF .ITEMLIST [-3] NEQ 'STAN' THEN RETURN LIB$_INVARG;

!+
! Make sure itemlist is not full.
!-

    IF .ITEMLIST [-1] EQL .ITEMLIST [-2] THEN RETURN LIB$_INVARG;

    STATUS = LIB$ANALYZE_SDESC (BUFFER_DESC, BUFLEN, BUFADR);

    IF NOT .STATUS THEN RETURN .STATUS;

    ITEM [ITM$W_BUFSIZ] = .BUFLEN;
    ITEM [ITM$W_ITMCOD] = .ITMCOD;
    ITEM [ITM$L_BUFADR] = .BUFADR;

    IF NULLPARAMETER (RETLEN) 
    THEN 
	ITEM [ITM$L_RETLEN] = 0 
    ELSE 
	ITEM [ITM$L_RETLEN] = .RETLEN;

!+
! Note that there is now one more item in this itemlist.
!-
    ITEMLIST [-1] = .ITEMLIST [-1] + 1;
!+
! Zero the next longword.
!-
    ITEMLIST [3*.ITEMLIST [-1]] = 0;
    RETURN SS$_NORMAL
    END;

END

ELUDOM