OpenVMS Source Code Demos

WCSM_SET_SYMBOL_OR_LOGICAL.FUN

	!==========================================================================================
	! Title  : wcsm_set_symbol_or_logical.fun
	! Author : Neil Rieck (this program is the reverse of Dave McNeil's "wcsm_get_symbol")
	! History:
	! ver  who when   what
	! ---- --- ------ -------------------------------------------------------------------------
	!    1 NSR 110407 1. original effort
	!      NSR 110414 2. more work
	!==========================================================================================
	! Maximum Sizes From OpenVMS Docs:
	!
	! OpenVMS-7.3		DCL Symbol Name/Data	: 255/1024 
	!			Logical Name/Data	: 255/ 255
	!
	! OpenVMS-7.3-2		DCL Symbol Name/Data	: 255/8192 
	!			Logical Name/Data	: 255/ 255
	!==========================================================================================
	!	Prototype:
	!		function long wcsm_set_symbol_or_logical(string symbol_name$, symbol_data$)
	!	Arguments:
	!		string	symbol_name$
	!			symbol_data$
	!	Returns:
	!		rc% = 1 (or some error code)
	!       Purpose:
	!		writes function writes one symbol or multi-line logicals 
	!==========================================================================================
	function long	wcsm_set_symbol_or_logical(string symbol_name$, symbol_data$)
	option type=explicit							!
	!
	%include "lib$routines" %from %library "sys$library:basic$starlet"	! lib$
        %include "$lnmdef"      %from %library "sys$library:basic$starlet"      ! logical name definitions
	%include "$libclidef"   %from %library "sys$library:basic$starlet"      ! lib$k_cli_global_sym
!~~~	%include "$libdtdef"    %from %library "sys$library:basic$starlet"	x lib$k
	!
	external basic$quadword function wcsm_peek_quad( long by value )	!
	!
	declare long	rc%, i%, j%, k%, ptr%, max_index%			!
	declare word	result_length%						!
	declare string	table$, temp$						!
	!
	declare long constant max_logical_size% = 255				! OpenVMS-7.3 and higher
	!
	!	create a new "data type" for use in a parameter list further down
	!
	record ItemRec								! structure of an item record
	    variant								! yikes, what's this? :-)
		case								!
		    group one							! here's one way to look at it
			word    BuffLen						!
			word    ItemCode					!
			long    BuffAddr					!
			long    RtnLenAdr					!
		    end group one						!
		case								!
		    group two							! here's a second way to look at it
			long    List_Terminator					!
			long    Junk1						!
			long    Junk2						!
		    end group two						!
	    end variant								!
	end record ItemRec							!
	!
	%include "$dscdef"      %from %library "sys$library:basic$starlet"      ! descriptor stuff
	record switcheroo
	    variant
		case
		    group one							!
			basic$quadword	my_quad					!
		    end group							!
		case								!
		    group two							!
			word	my_length					! length
			byte	my_type						! type
			byte	my_class					! class
			long	my_address					! address
		    end group							!
		case								!
		    group three							!
			DSCDEF1	my_descriptor					! defined in $dscdef in sys$library:basic$starlet
		    end group							!
	    end variant								!
	end record								!
	!
	declare switcheroo my_dsc						! declare a variable to match the new record
	!=======================================================================
	!	main
	!=======================================================================
	main:									!
	!
	!   LIB$SET_SYMBOL symbol ,value-string [,table-type-indicator] 
	!
	rc% = lib$set_symbol(symbol_name$, symbol_data$, LIB$K_CLI_GLOBAL_SYM)	! write the symbol
	if (rc% and 7%) <> 1%							! if fail then try multi-line logicals
	then									!
	    !
	    ! since lib$set_symbol did not work, let's attempt a slice-n-dice of the data...
	    !	...then write it out as multi-line logicals 
	    !-------------------------------------------------------------------
	    ! since we now have a unplanned relationship between like-named
	    ! symbols and logical names, and we're going to create one, or more,
	    ! logicals, then we must delete a symbol which we may have been
	    ! trying to lengthen.
	    !-------------------------------------------------------------------
	    !
	    ! LIB$DELETE_SYMBOL symbol [,table-type-indicator] 
	    !
	    rc% = lib$delete_symbol(symbol_name$, LIB$K_CLI_GLOBAL_SYM)		! ignore rc%
	    !
	    max_index% = ( len(symbol_data$) / max_logical_size%)		! 
	    if mod (len(symbol_data$), max_logical_size%) > 0 then		!
		max_index% = max_index% + 1					! add a slot for a partial line 
	    end if								!
	    !
	    dim string a$(max_index%)						!
	    !
	    j% = 1								! init start of data window
	    k% = max_logical_size%						! init end of data window
	    for i% = 0 to max_index% - 1					!
		a$(i%) = seg$(symbol_data$,j%,k%)				! slice-n-dice
		j% = j% + max_logical_size%					! slide window forward by for next pass
		k% = k% + max_logical_size%					!
	    next i%								!
	    no_more:								!
	    !
	    dim ItemRec ItemBuf(max_index%)					!
	    !
	    for i% = 0 to max_index% - 1					!
		ptr%    = loc( a$(i%) )						! ptr% is a pointer to string descriptor
		my_dsc::my_quad = wcsm_peek_quad( ptr% )			! stuff our switcheroo
		!
		ItemBuf(i%)::BuffLen	= my_dsc::my_length			!
		ItemBuf(i%)::ItemCode	= lnm$_string				! 
		ItemBuf(i%)::BuffAddr	= my_dsc::my_address			!
		ItemBuf(i%)::RtnLenAdr	= 0					! not used
	    next i%								!
	    !
	    ItemBuf(max_index%)::List_Terminator = 0				! this is very important
	    !
	    table$ = "LNM$PROCESS"						!
	    !
	    ! LIB$SET_LOGICAL logical-name [,value-string] [,table] [,attributes] [,item-list] 
	    !
	    rc% = lib$set_logical(symbol_name$, "", table$,,ItemBuf())		!
	end if									!
	!
	wcsm_set_symbol_or_logical = rc%					!
	end function								!

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.