OpenVMS Source Code Demos

DCL_SYMBOLS.BAS

1000	%title "vax_basic_dcl_symbols.bas"
	%ident "version_101"
	!
	!0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
	!1         2         3         4         5         6         7         8         9         0         1         2         3
	!=========================================================================================================================
	! Title  : vax_basic_dcl_symbols.bas
	! Author : Neil S. Rieck (Waterloo, Ontario, Canada)
	! Purpose: demo how to read/set CLI symbols
	! History:
	! 100 NSR 991126 1. original program
	! 101 NSR 000418 1. Now system service declartions come from BASIC$STARLET
	!=========================================================================================================================
	! note: to hack the 'STARLET' system library, do the following from DCL:
	!	$ set def sys$login                       (go to your home directory)
	!	$ lib/ext=* sys$library:basic$starlet.tlb (copy text from 'text libary' to 'text file')
	!	$ edit/read/edt basic$starlet.txt         (edit large text file using EDT)
	!=========================================================================================================================
	option type=explicit							! cuz tricks are for kids
	!
	%include "starlet"	%from %library "sys$library:basic$starlet"	! system services (calls)
	%include "$ssdef"	%from %library "sys$library:basic$starlet"	! ss$ definitions
	%include "lib$routines"	%from %library "sys$library:basic$starlet"	! lib$ routines (calls)
	%include "$libclidef"	%from %library "sys$library:basic$starlet"	! lib$ cli definitions
	!
	declare string	stuff$		,&
		long	rc%		,&
		word	result_len%	,&
		long	where%
	!
	!	notes:
	!	1. to create a local symbol from DCL:
	!		$ test1 = 1
	!	   or	$ test2 = "demo" (or test2 := demo)
	!	2. to create a global symbol from DCL:
	!		$ test1 == 1
	!	   or	$ test2 == "demo" (or test2 :== demo)
	!	3. don't attempt to pass symbols to a subprocess because subprocesses have no CLI (eg. DCL)
	!
	print "reading symbol 'my_test1'"
	rc% = lib$get_symbol("my_test1",stuff$,,)				! read symbol "my_test1"
	gosub display_rc
	print ">";stuff$;"<"	if (rc% and 1%) = 1%
	!
	!	create local symbol
	!
	print "creating local symbol 'my_test2'"
	rc% = lib$set_symbol("my_test2","two", lib$k_cli_local_sym )		! create local symbol "my_test2"
	gosub display_rc
	!
	!	create global symbol
	!
	print "creating global symbol 'my_test3'"
	rc% = lib$set_symbol("my_test3","three", lib$k_cli_global_sym )		! create global symbol "my_test3"
	gosub display_rc
	!
	!	read symbol (we don't care where it was found)
	!
	print "reading symbol 'my_test2'"
	rc% = lib$get_symbol("my_test2",stuff$,,)				! read symbol "my_test2"
	gosub display_rc
	print ">";stuff$;"<"	if (rc% and 1%) = 1%
	!
	!	read symbol (we want to know where it was found)
	!
	print "reading symbol 'my_test3'"
	rc% = lib$get_symbol(	"my_test3"		,			! desired symbol name 		&
				stuff$			,			! resultant string		&
				result_len%		,			! resultant string length	&
				where% )					! where was the symbol found
	gosub display_rc
	print "len>";str$(result_len%)
	print "where>";str$(where%);
	select where%
	    case lib$k_cli_local_sym
		print " (local)"
	    case lib$k_cli_global_sym
		print " (global)"
	    case else
		print " (not found)"
	end select
	print ">";stuff$;"<"
	!
	!	read a symbol (that doesn't exist)
	!
	print "reading symbol 'never_find_it'"
	rc% = lib$get_symbol(	"never_find_it"		,			! desired symbol name 		&
				stuff$			,			! resultant string		&
				result_len%		,			! resultant string length	&
				where% )					! where was the symbol found
	gosub display_rc
	print "** Notice that all the following values are wrong on an ERROR or FATAL"
	print "   so init your variables before the call and/or always check the return code"
	print "len>";str$(result_len%)
	print "where>";str$(where%)
	print ">";stuff$;"<"
	!
	goto fini
	!
	!	<<< display VMS severity and return code >>>
	!
	display_rc:
	select (rc% and 7%)
	    case 0%
		print "-w-";
	    case 1%
		print "-s-";
	    case 2%
		print "-e-";
	    case 3%
		print "-i-";
	    case 4%
		print "-f-";
	    case else
		print "-?-";
	end select
	print " rc: ";str$(rc%)
	return
	!
	!	<<< that's all folks >>>
	!
	fini:
	end

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.