C+
C NAME:
C	iSetSymbol
C PURPOSE:
C	Set VMS symbol
C CALLING SEQUENCE:
	function iSetSymbol(cName,cValue,iTable)
C INPUTS:
C	cName		character*(*)
C	cValue		character*(*)
C	iTable		integer		1: Local, 2=Global
C OUTPUTS:
C	iSetSymbol	integer		0: failure; 1=success
C INCLUDE:
	include		'vaxdescr.h'
C CALLS:
C	itrim
C MODIFICATION HISTORY:
C	SEP-1992, Paul Hick (UCSD)
C-
	    character	cName*(*)
	    character	cValue*(*)
	    integer	iTable

	iSetSymbol = itrim(cName)
	if (iSetSymbol .ne. 0) then
	    L = itrim(cValue)
	    if (L .eq. 0) then		! Set symbol value to null string
		call getdescr(cValue,dsc)
		iSetSymbol = LIB$SET_SYMBOL(cName(:iSetSymbol),%ref(dsc),iTable)
	    else
		iSetSymbol = LIB$SET_SYMBOL(cName(:iSetSymbol),cValue(:L),iTable)
	    end if
	    iSetSymbol = mod(iSetSymbol,2)
	end if

	return
	end
C+
C NAME:
C	iGetSymbol
C PURPOSE:
C	Get VMS symbol
C CALLING SEQUENCE:
	function iGetSymbol(cName,cValue)
C INPUTS:
C	cName		character*(*)
C OUTPUTS:
C	cValue		character*(*)
C	iGetSymbol	integer		0: failure; 1=success
C CALLS:
C	itrim
C MODIFICATION HISTORY:
C	SEP-1992, Paul Hick (UCSD)
C-
	    character	cName *(*)
	    character	cValue*(*)

	iGetSymbol = itrim(cName)
	if (iGetSymbol .gt. 0) iGetSymbol = mod(LIB$GET_SYMBOL(cName(:iGetSymbol),cValue),2)

	if (iGetSymbol .eq. 0) then
	    cValue = ' '
	else
	    iGetSymbol = itrim(cValue)
	end if

	return
	end
C+
C NAME:
C	iDeleteSymbol
C PURPOSE:
C	Delete VMS symbol
C CALLING SEQUENCE:
	function iDeleteSymbol(cName,iTable)
C INPUTS:
C	cName		character*(*)
C	iTable		integer		1: Local, 2=Global
C OUTPUTS:
C	iDeleteSymbol	integer		0: failure; 1=success
C CALLS:
C	itrim
C MODIFICATION HISTORY:
C	SEP-1992, Paul Hick (UCSD)
C-
	    character	cName*(*)
	    integer	iTable

	iDeleteSymbol = itrim(cName)
	if (iDeleteSymbol .gt. 0) iDeleteSymbol = mod(LIB$DELETE_SYMBOL(cName(:iDeleteSymbol),iTable),2)

	return
	end
C+
C NAME:
C	iSetLogical
C PURPOSE:
C	(Re)defines a logical
C CALLING SEQUENCE:
	function iSetLogical(cNameIn,cValueIn,cTableIn)
C INPUTS:	(read-only)
C	cName		character*(*)	name of logical
C	cValue		character*(*)	value to be assigned to logical
C	cTable		character*(*)	indicates logical name table
C		If first character is 'j' or 'J' the logical is entered into 
C		the JOB table; otherwise into the PROCESS table.
C OUTPUTS:
C	iSetLogical	integer		0=failure; 1=success
C
C	Logical cName is created or redefined
C CALLS:
C	itrim, uppercase
C PROCEDURE:
C    >  if itrim(cName)=0 or itrim(cValue)=0 then iResult=0 is returned
C    >	The logical is entered in the specified table. Only the first 
C	character of TABLE is tested. If it is not 'J' or 'j' the logical is
C	entered into the process table
C    >	Logical are created in supervisor access mode (which is the default
C	for the DCL assign/define commands)
C    >	See TRNLOG and DELLOG for translating and undefining logicals
C MODIFICATION HISTORY:
C	SEP-1992, Paul Hick (UCSD), modelled on TRNLOG
C-
	    character	cNameIn *(*)
	    character	cValueIn*(*)
	    character	cTableIn*(*)

	character	cName *60
	character	cValue*60
	character	cTable*11
	character	cTables(2)*11	/'LNM$PROCESS','LNM$JOB'/

	iSetLogical = 0

	cName = cNameIn
	nLog  = itrim(cName)
	if (nLog .eq. 0) return		! No logical name specified
	call uppercase(cName(:nLog))

	cValue = cValueIn
	nVal = itrim(cValue)
	if (nVal .eq. 0) return		! No value specified
	call uppercase(cValue(:nVal))

	cTable = cTables(1)
	if (cTableIn(:1) .eq. 'J' .or. cTableIn(:1) .eq. 'j') cTable = cTables(2)
	nTab = itrim(cTable)

	iSetLogical = lib$set_logical(cName(:nLog),cValue(:nVal),cTable(:nTab))
	iSetLogical = mod(iSetLogical,2)

	return
	end
C+
C NAME:
C	iGetLogical
C PURPOSE:
C	Translate a logical
C CALLING SEQUENCE:
	function iGetLogical(cNameIn,cValue)
C INPUTS:	(read-only)
C	cName*(*)	character	name of logical
C OUTPUTS:
C	cValue*(*) 	character	translation of logical (= ' ' if the
C					logical is not defined)
C	iGetLogical	integer		0=Failure, >0=Succes: length cValue
C CALLS:
C	Say, itrim
C INCLUDE:
	include		'($lnmdef)'
	include		'($ssdef)'
C RESTRICTIONS:
C	The subroutine does not translate user_mode logicals. Don't know why.
C SIDE EFFECTS:
C   >	Error status=444 is treated separately: if translation = ' ' the 
C	logical was not defined (and control returns to caller); if translation
C	<> ' ' the length of the translation  string was too small to hold the
C	full translation (cValue = ' ' is returned with iResult=0 after a
C	warning is displayed).
C PROCEDURE:
C	Uses system procedure SYS$TRNLNM
C   >	PROCESS, JOB and SYSTEM tables are searched (in that order)
C   >	If the logical is not defined cValue = ' ' is returned
C MODIFICATION HISTORY:
C	Originally extracted from the SWING package.
C	SEP-1992, Paul Hick (UCSD);
C	- changed cName to read_only argument;
C	- corrected error in definition of ITEM.item_len
C-
	    character	cNameIn*(*)
	    character	cValue*(*)

	character	cName*40
	integer		sys$trnlnm
 	integer		iattr		/lnm$m_case_blind/
	structure /item_list/
	    integer*2	item_len
	    integer*2	item_code	/lnm$_string/
	    integer*4	addr
	    integer*4	ret_addr	/0/
	    integer*4	end_items	/0/
	end structure
	record /item_list/ items
 
	cName = cNameIn
	iGetLogical = itrim(cName)

	if (iGetLogical .gt. 0) then
	    nLog = iGetLogical

	    cValue = ' '		! Necessary !!!!
	    items.item_len = len(cValue)
	    items.addr = %loc(cValue)

	    iGetLogical = sys$trnlnm(iattr,'LNM$PROCESS',cName(:nLog),,items)
	    if (iGetLogical .ne. ss$_normal) iGetLogical = sys$trnlnm(iattr,'LNM$JOB'   ,cName(:nLog),,items)
	    if (iGetLogical .ne. ss$_normal) iGetLogical = sys$trnlnm(iattr,'LNM$SYSTEM',cName(:nLog),,items)

	    if (iGetLogical .eq. 444 .and. cValue .ne. ' ') then
		call Say ('iGetLogical','W','INCTRAN',
     &		    'translation "'//cValue//'" of logical name "'//cName(:nLog)//'" is incomplete')
	    end if

	    iGetLogical = mod(iGetLogical,2)
	end if

	if (iGetLogical .eq. 0) then
	    cValue = ' '
	else
	    iGetLogical = itrim(cValue)
	end if

	return
	end
C+
C NAME:
C	iDeleteLogical
C PURPOSE:
C	Delete a logical from job or process table
C CALLING SEQUENCE:
	function iDeleteLogical(cNameIn)
C INPUTS:	(read-only)
C	cName*(*)	character	name of logical
C OUTPUTS:
C	iDeleteLogical	integer		1=success
C					0=failure (logical didn't exist or
C						   deletion failed)
C CALLS:
C	iGetLogical, itrim, uppercase
C INCLUDE:
	include		'($ssdef)'
C PROCEDURE:
C   >	PROCESS and JOB tables are searched (in that order)
C   >	Deletes logicals with supervisor access mode
C MODIFICATION HISTORY:
C	SEP-1992, Paul Hick (UCSD), modeled on TRNLOG
C-
	    character	cNameIn*(*)

	character	cName  *40
	character	cValue *60

	iDeleteLogical = iGetLogical(cNameIn,cValue)

	if (iDeleteLogical .ne. 0) then
	    cName = cNameIn
	    nLog = itrim(cName)
	    call uppercase(cName(:nLog))
	    iDeleteLogical = lib$delete_logical(cName(:nLog),'LNM$PROCESS')
	    if (iDeleteLogical .ne. ss$_normal) iDeleteLogical = lib$delete_logical(cName(:nlog),'LNM$JOB')
	    iDeleteLogical = mod(iDeleteLogical,2)
	end if

	return
	end
