OpenVMS Source-Code Demos

RMS_TEST_USEROPEN.BAS

1000    %title "RMS_TEST_USEROPEN_xxx.BAS"					!
	%ident                              "version_106.1"			! <<<---+---
	declare string constant k_version = "version 106.1"		,	! <<<---+		&
				k_program = "RMS_TEST_USEROPEN"			!
	!=========================================================================================================================
	! Title  : RMS_TEST_USEROPEN_xxx.BAS
	! Author : Neil Rieck
	! Created: 000809
	! Notes  : 1. using DEC-BASIC's USEROPEN statement to open any type of file then peek at the FAB/RAB locations
	!	   2. original program from examples in the DEC BASIC for OpenVMS "User's Manual" and "Reference Manual"
	!	   3. additional info from $FABDEF and $RABDEF found in SYS$LIBRARY:BASIC$STARLET.TLB
	! ver who when   what
	! --- --- ------ ---------------------------------------------------------------------------------------------------------
	! 100 NSR 000809 1. original demo
	! 101 NSR 010905 1. modified demo to fix text files FTP'd here in BINARY mode (instead of ASCII mode)
	! 102 NSR 100531 1. renamed some variables
	! 103 NSR 100531 1. added code to test-open GIFs and JPGs (this is just hacking)
	! 104 NSR 110506 1. added a menu
	!		 2. added support for xabsum (to view number-of-keys)
	! 105 NSR 110507 1. hacking with XABKEY
	!     NSR 110825 2. a few teaks
	! 106 NSR 110829 1. added support for xabpro (to view file protection bits)
	!=========================================================================================================================
	option type=explicit							!
	!
	on error goto trap							!
	!
	declare string constant htab    = '9'C					! horizontal tab
	!
	%include "lib$routines"	%FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET"	! lib$spawn
	%include "STARLET"	%from %library "sys$library:basic$starlet"	! system services
	%include "$FABDEF"	%from %library "sys$library:basic$starlet"	! File Access Block
	!
	!	this common is used to pass back parameters from the useropen function to this program's main
	!	and must be identical with the useropen declaration
	!
	common(rab_ptr)	long	cmn_org					,	! 0	&
			long	cmn_rat					,	! 1	&
			long	cmn_mrs					,	! 2	&
			long	cmn_alq					,	! 3	&
			long	cmn_bks_bls				,	! 4	&
			long	cmn_num_keys				,	! 5	&
			long	cmn_mrn					,	! 6	&
			long	cmn_rfm					,	! 7	&
			long	cmn_sanity				,	! 8	&
			string	cmn_align = 0					!
	common(rab_ptr)	long	cmn_stuff(8)				,	! 8 (subscript zero not counted in BASIC)	&
			string	cmd_align = 0					!
	cmn_sanity = loc(cmn_align)-loc(cmn_org)				! prep for sanity test
	!
	map(my512)string	my512$ = 512					!
	!
	declare		string	my_file$				,	&
				temp$					,	&
				fs$					,	&
				cmd$					,	&
				junk$					,	&
			long	junk%					,	&
				pos0%					,	&
				handler_error%				,	&
				rc%					,	&
				cr_pos%					,	&
				span%					,	&
				file_stats%				,	&
				fix_file%					!
	external	long	function my_open				!
	!
	!	for this peek trick to work...
	!
	!		1. declare LONG BY VALUE passing mechanisms here (we are passing 32-bit addresses)
	!		2. declare BY REF passing mechanisms in the receiving functions
	!
	external long function my_peek_L( long by value )			!
	external long function my_poke_L( long by value, long by value)		!
	external word function my_peek_W( long by value )			!
	external byte function my_peek_B( long by value )			!
	external basic$quadword function my_peek_Q( long by value )		!
	external long function my_loc( any by ref )				!
	!========================================================================================================================
	!	main
	!========================================================================================================================
	main:
	print
	print k_program +"_"+ k_version
	print string$(len(k_program +"_"+ k_version), asc("="))			! what will the optimizer do with this?
	!-----------------------------------------------------------------------
	!	create a list of text files
	!-----------------------------------------------------------------------
	print
	print "file-spec menu"
	print "=============="
	print " 1 use:  *.dat"
	print " 2 use:  *.txt"
	print " 3 use:  *.gif"
	print " 4 use:  *.gif,*.jpg"
	print " or just enter a partial (with wildcards) or full filespec"
	input "choice? (1-4, or filespec. default=exit) "; fs$			!
	fs$ = edit$(fs$,4+2)							!
	select fs$								!
	    case ""								!
		goto fini							!
	    case "1"								!
		fs$ = "*.dat;"							!
	    case "2"								!
		fs$ = "*.txt;"							!
	    case "3"								!
		fs$ = "*.gif;"							!
	    case "4"								!
		fs$ = "*.gif;,*.jpg;"						!
	    case else								!
										! entered some filespec
	end select								!
	!
	fix_file% = 0								! init
	junk$ = edit$(fs$,32)							! upcase for next tests
	junk% = 0								! init
	junk% = 1	if pos(junk$,".TXT",1) > 0				!
	junk% = 1	if pos(junk$,".LST",1) > 0				!
	if junk% = 1 then							!
	    input "fix text files? (y/N) ";junk$				!
	    select left$(edit$(junk$,32+2),1)					!
		case "Y"							!
		    fix_file% = 1						!
	    end select								!
	end if									!
	select fs$								!
	    case "3" to "4"							!
		fs$ = "[.*..]"+ fs$ 						!
	end select								!
	cmd$ = "$dir/out="+ k_program +"_scratch.junk/nohead/notrail "+ fs$	!
	print "-i- executing cmd: "+ cmd$					!
	sleep 1									!
	rc% = lib$spawn(cmd$)							!
	if (rc% and 7%) <> 1 then
	    print "-e- lib$spawn: "+ str$(rc%)
	end if
	when error in								!
	    open k_program +"_scratch.junk" for input as #99, access read, allow none
	    while 1								!
		linput #99, my_file$						!
		junk% = pos(my_file$,";",1%)					! locate the version specifier
		if junk% > 0 then						!
		    my_file$ = left$( my_file$, junk%-1%)			!
		end if								!
		gosub test_file							!
	    next								!
	use									!
	    handler_error% = err						!
	end when								!
	select handler_error%							!
	    case 0, 11								!
	    case else								!
		print "-e- handler: ";str$(err)					!
	end select								!
	close #99								!
	goto fini								!
	!-----------------------------------------------------------------------
	!	<<< open the desired file using a "useropen" routine >>>
	!
	!	note: DEC-BASIC's OPEN function will set up the FAB before calling my
	!		"useropen" routine which will actually do the file OPEN.
	!-----------------------------------------------------------------------
	test_file:								!
	mat cmn_stuff = zer							! zap common variables just for fun
	cmn_stuff(0) = 0							! cuz mat never clears subscript zero
	!
	when error in
	    print "-i- opening: "+ my_file$
	    open my_file$ for input as #100		&
		,access read				&
		,allow none				&
		,recordtype any				&
		,organization undefined			&
		,useropen my_open						! <--- note: this is triggered on each open
	    handler_error% = 0							! cool
	use									!
	    handler_error% = err						! oops
	end when								!
	print "-i- closing #100"
	close #100								!
	!
    file_stats% = 1								!
    if file_stats% = 1 then							! change this as required
	print	"==========================================================="
	print	"file        "; my_file$					!
	print	"org         "; cmn_org; htab;					!
	select cmn_org								!
	    case = FAB$C_HSH							! 48
		print " Hash" 							!
	    case = FAB$C_IDX							! 32
		print " IDX"							!
	    case = FAB$C_REL							! 16
		print " REL"							!
	    case = FAB$C_SEQ							! 0
		print " SEQ"							!
	    case else								!
		print " ???"							!
	end select								!
	print	"rec fmt     "; cmn_rfm; htab;					!
	select cmn_rfm								!
	    case FAB$C_UDF							! 0
		print " undefined/stream binary"				!
	    case FAB$C_FIX							! 1
		print " fixed length"						!
	    case FAB$C_VAR							! 2
		print " variable length"					!
	    case FAB$C_VFC							! 3
		print " variable fixed control"					!
	    case FAB$C_STM							! 4 ( valid only for sequential org )
		print " RMS-11 stream"						!
	    case FAB$C_STMLF							! 5 ( valid only for sequential org )
		print " LF stream"						!
	    case FAB$C_STMCR							! 6 ( valid only for sequential org )
		print " CR stream"						!
	    case else								!
		print " ???"							!
	end select								!
	print	"rec attr    "; cmn_rat						!
	print	"max rec siz "; cmn_mrs						!
	print	"alloc qty   "; cmn_alq						!
	print	"bucket size "; cmn_bks_bls					!
	print	"num of keys "; cmn_num_keys; htab +" (only applies to indexed files)"!
	print	"max rec num "; cmn_mrn; htab +" (only applies to relative files)"
    end if									!
	!
	!	if input file is SEQUENTIAL and FIXED then convert it to SEQUENTIAL and VARIABLE
	!
	!	note: a text file with these attributes was probably FTP'd here using BINARY transfer
	!		rather than ASCII transfer. OpenVMS files are not supposed to have embedded
	!		paper commands like <cr> and <lf> so remove them and do a print (which RMS
	!		will write as a <nul> terminated PASCAL string which is what RMS wants)
	!
	if	cmn_org = 0%		and					! if sequential					&
		cmn_rfm = 1%		and					! and fixed length				&
		cmn_mrs = 512%		and					! and looks like a BINARY-FTP			&
		fix_file% = 1							! and this code is desired
	then									!
	    junk% = 0								!
	    junk% = 1 if pos( edit$(my_file$,32), ".TXT",1) > 0			!
	    junk% = 1 if pos( edit$(my_file$,32), ".LST",1) > 0			!
	    goto skip_convert	if junk% = 0					!
										!
	    print "-i- about to convert: "; my_file$; " from SEQUENTIAL-FIXED to SEQUENTIAL-VARIABLE"
	    input "-?- do you wish to continue? (Y/N, default=N )";junk$
	    select edit$(junk$,32+2)
		case "Y","YES"
		case else
		    goto skip_convert
	    end select
	    print "-i- opening: "; my_file$
	    when error in
		open my_file$ for input as #95		&
			,access read			&
			,allow none			&
			,organization sequential fixed	&
			,recordtype none		&
			,map my512
		!
		open my_file$ for output as #90		&
			,organization sequential	&
			,recordsize 32700
		!
		print "-i- converting file: "+ my_file$
		temp$ = ""							! init line buffer
		while 1%=1%
		    pos0% = 1%							! reset scanning pointer
		    get #95, regardless						! read a block
		    !
		    while pos0% < 512%						!
			cr_pos% = pos(my512$, cr, pos0%)			! find <cr>
			if cr_pos% = 0% then					! if <cr> not found...
			    temp$ = temp$ + seg$(my512$, pos0%, 512%)		! ...then collect to the end of the buffer
			    pos0% = 512%					! force an inner loop exit
			else							!
			    temp$ = temp$ + seg$(my512$, pos0%, cr_pos%-1%)	!
			    temp$ = edit$( temp$, 4%)				! drop controls ( including <lf> + <nul> )
			    print #90, temp$ if temp$ <> ""			! write line
			    temp$ = ""						!
			    pos0% = cr_pos%+1%					! skip past the <cr>
			end if							!
		    next							!
		next								!
	    use									!
		handler_error% = err						!
	    end when								!
	    select handler_error%						!
		case 0								!
		case 11								!
		    temp$ = edit$( temp$, 4%)					! drop controls
		    print #90,temp$	if temp$ <> ""				! send last line (if any)
		case else							!
		    print "-e- convert error: ";str$(err)			!
	    end select								!
	end if									!
	skip_convert:
	close #100, #95, #90
	return
	!-----------------------------------------------------------------------
	!	common error trap
	!-----------------------------------------------------------------------
	trap:
	print
	print "common error handler"
	print "-e- error : "+ str$(err)
	print "-e- line  : "+ str$(erl)
	print "-e- text  : "+ ert$(err)
	print "-e- module: "+ ern$
	resume fini								!
	!-----------------------------------------------------------------------
	!	<<< adios >>>
	!-----------------------------------------------------------------------
32000	fini:									!
	when error in
	    print "-i- deleting scratch files"
	    while 1								!
		kill k_program +"_scratch.junk"					!
	    next								!
	use									!
	end when								!
	print "-i- exiting"							!
	end									!
	!########################################################################################################################
	!
	!	this function is a USEROPEN routine which is called by BASIC's OPEN statement above
	!
32100	function long my_open( FABDEF user_fab, RABDEF user_rab, long channel)	!
	option type=explicit							!
	!
	%nolist									!
	%include "STARLET"	%from %library "sys$library:basic$starlet"	! system services
	%include "$RMSDEF"	%from %library "sys$library:basic$starlet"	! Record Management System
	%include "$FABDEF"	%from %library "sys$library:basic$starlet"	! File Access Block
	%include "$RABDEF"	%from %library "sys$library:basic$starlet"	! Record Access Block
	%include "$XABalldef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABDEF"	%from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABSUMDEF"	%from %library "sys$library:basic$starlet"	! Extended Access Block Summary
	%include "$XABKEYDEF"	%from %library "sys$library:basic$starlet"	! Extended Access Block KEY
	%include "$XABcxfdef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABcxrdef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABdatdef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABfhcdef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABjnldef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABprodef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABrdtdef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABrudef"    %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABitmdef"    %from %library "sys$library:basic$starlet"	! Extended Access Block
	%include "$XABtrmdef"   %from %library "sys$library:basic$starlet"	! Extended Access Block
	%list									!
	!
	!	for this peek trick to work...
	!
	!		1. declare LONG BY VALUE passing mechanisms here (we are passing 32-bit addresses)
	!		2. declare BY REF passing mechanisms in the receiving functions
	!
	external long function my_peek_L( long by value )			!
	external long function my_poke_L( long by value, long by value)		!
	external word function my_peek_W( long by value )			!
	external byte function my_peek_B( long by value )			!
	external basic$quadword function my_peek_Q( long by value )		!
	external long function my_loc( any by ref )				!
	!
	!	variable declarations
	!
	declare long	rc%, junk%, i%, pass%, preserve%, hook2%, hook9%,	!						&
			ptr1, p_addr, p_data					!
	!
	declare XABDEF		user_xab					! xab block (only used for hacking)
	declare	XABSUMDEF	user_xabsum					! xab summary block (only used for hacking)
	declare XABKEYDEF	user_xabkey(20)					! xab key block (only used for hacking)
	declare XABPRODEF1	user_xabpro					! xab pro block (only used for hacking)
	!
	!	this common is used to pass back parameters from the useropen function to this program's main
	!	and must be identical with the main declaration
	!
	common(rab_ptr)	long	cmn_org					,	! 0	&
			long	cmn_rat					,	! 1	&
			long	cmn_mrs					,	! 2	&
			long	cmn_alq					,	! 3	&
			long	cmn_bks_bls				,	! 4	&
			long	cmn_num_keys				,	! 5	&
			long	cmn_mrn					,	! 6	&
			long	cmn_rfm					,	! 7	&
			long	cmn_sanity				,	! 8	&
			string	cmn_align = 0					!
	common(rab_ptr)	long	cmn_stuff(8)				,	! 8 (subscript zero not counted)	&
			string	cmd_align = 0					!
	!-----------------------------------------------------------------------
	main:									!
	print "-i- entering my_open (a 'user open' routine)"			!
	if cmn_sanity <> (loc(cmn_align)-loc(cmn_org))	then			!
	    print "-e- oops, programmer error. The commons do not match"	!
	end if									!
	!
	mat cmn_stuff = zer							! zap common variables each time thru
	cmn_stuff(0) = 0							! cuz mat never clears subscript zero
	!
	preserve% = user_fab::fab$l_xab						! save this just in case (for method #0)
	print "-i- orig xab addr: "; preserve%					!
	gosub scan_xab_list							! also defines hook2% on first pass
	!-----------------------------------------------------------------------
	!	in this demo will only use the XABSUM and XABPRO for now
	!-----------------------------------------------------------------------
	!
	!	Oops, the following two record components are not properly named in BASIC$STARLET.TLB
	!
!~~~	user_xabsum::xab$b_cod = xab$c_sum					x init
!~~~	user_xabsum::xab$b_bln = xab$c_sumlen					x
	!
	!	Here is what I found in my copy of BASIC$STARLET.TLB (OpenVMS-8.4 with Alpha BASIC 1.7)
	!
	user_xabsum::xabsumdef$$_fill_1 = xab$c_sum				! init my xabsum
	user_xabsum::xabsumdef$$_fill_2 = xab$c_sumlen				!
	user_xabsum::xabsumdef$$_fill_4 = loc(user_xabpro::XABPRODEF$$_FILL_1)	! point to our xabpro
	!
	!	Here is what I found in my copy of BASIC$STARLET.TLB (OpenVMS-8.4 with Alpha BASIC 1.7)
	!
	user_xabpro::xabprodef$$_fill_1 = xab$c_pro				! init my xabpro
	user_xabpro::xabprodef$$_fill_2 = xab$c_prolen				!
	user_xabpro::xabprodef$$_fill_4 = 0					! next xab links to here
	!
   %let %method=0%								!
   %if %method=0% %then								! 0=no poking (more safe)
	print "-i- replacing the xab chain"					!
	user_fab::fab$l_xab = loc(user_xabsum::xabsumdef$$_fill_1)		! only use OUR xabsum (overwrite previous)
   %else									! 1=poking (more dangerous)
	print "-i- extending the xab chain"					!
	junk% = my_poke_L(hook2%, loc(user_xabsum::xabsumdef$$_fill_1)) 	! add our stuff to end of chain
   %end %if									!
	!
	!	open the file
	!
	print "-i- calling sys$open"						!
	rc% = sys$open( user_fab )						! this system call opens the file
	if (rc% and rms$_normal) then						! if the open was successful
		cmn_num_keys	= user_xabsum::xab$b_nok			! number of keys
		!
		cmn_alq		= user_fab::fab$l_alq				!
		cmn_org		= user_fab::fab$b_org				!
		cmn_rat		= user_fab::fab$b_rat				!
		cmn_bks_bls	= user_fab::fab$b_bks				!
		cmn_mrs		= user_fab::fab$w_mrs				!
		cmn_rfm		= user_fab::fab$b_rfm				!
		cmn_mrn		= user_fab::fab$l_mrn				!
		!
		gosub scan_xab_list						! also defines hook2% on first pass
		!
		print "-i- protection bits: "; user_xabpro::xab$w_pro		!
		!
		!	"I Think" the call to SYS$DISPLAY is only effective for filling in details of XABKEYDEF
		!	(does nothing with XABSUMDEF)
		!
		if (cmn_org = fab$c_idx)	then				!
!~~~		    user_fab::fab$l_xab = loc(user_xabkey(0))			x overwrite this pointer for the 2nd time
		    user_xabpro::xabprodef$$_fill_4 = loc(user_xabkey(0))	! link xabkey to xabpro
		    for i% = 0 to cmn_num_keys-1				!
			user_xabkey(i%)::XABKEYDEF$$_FILL_1 = XAB$C_KEY		!
			user_xabkey(i%)::XABKEYDEF$$_FILL_2 = XAB$S_XABKEYDEF	!
			user_xabkey(i%)::XABKEYDEF$$_FILL_3 = 0			!
			user_xabkey(i%)::XABKEYDEF$$_FILL_4 = 0			!
			user_xabkey(i%)::xab$b_ref = i%				! remember key number
			if i% > 0 then						!
			    user_xabkey(i%-1)::XABKEYDEF$$_FILL_4 = loc(user_xabkey(i%))  ! take care of back linkage
			end if							!
		    next i%							!
		    rc% = sys$display( user_fab )				!
		    if (rc% and 7%) <> 1% then					!
			print "-i- sys$display rc: "+ str$(rc%)+" ("+ str$( rc% and 7%) +")"
		    end if							!
		end if								!
		!
		print "-i- calling sys$connect"					!
		rc% = sys$connect( user_rab )					! connect to the rab
		if (rc% and 7%) <> 1% then					!
		    print "-i- sys$connect rc: "+ str$(rc%) +" ("+ str$(rc% and 7%) +")"
		end if								!
		!
		!	insert code to peek at components of user_rab
		!	then disconnect
		!
		print "-i- calling sys$disconnect"				!
		rc% = sys$disconnect( user_rab )				! connect to the rab
		if (rc% and 7%) <> 1% then					!
		    print "-i- sys$disconnect rc: "+ str$(rc%) +" ("+ str$(rc% and 7%) +")"
		end if								!
	else									!
		print "-i- sys$open rc: "+ str$(rc%) +" ("+ str$(rc% and 7%) +")"
		cmn_alq		= 0						!
		cmn_org		= 0						!
		cmn_rat		= 0						!
		cmn_bks_bls	= 0						!
		cmn_mrs		= 0						!
		cmn_rfm		= 0						!
	end if									!
	goto close_n_exit							!
	!-----------------------------------------------------------------------
	!	scan fabs (sub-routine)
	!-----------------------------------------------------------------------
	!
	!	note: XABs are in a linked list. We can either:
	!		1) follow the existing lists looking for the one we want (might need to write a peek() function)
	!		2) or switch-in our own list just for quick hacking purposes
	!
	scan_xab_list:								!
	print "-i- FAB XABs ------- pass# "+ str$(pass%) +" -------"		!
	p_addr = loc(user_fab::fab$l_xab)					!
	p_data = user_fab::fab$l_xab						! address of an xab
	!
	next_xab:								!
	if p_data = 0 then							! if end-of-list marker
	    hook9% = p_addr							! then remember this location
	else									!
	    print "-i- xab id code  : "; my_peek_B( p_data  );" ";		!
	    select my_peek_B( p_data  )
		case XAB$C_ALL
		    print "XAB$C_ALL"
		case XAB$C_CXF
		    print "XAB$C_CXF"
		case XAB$C_CXR
		    print "XAB$C_CXR"
		case XAB$C_DAT
		    print "XAB$C_DAT"
		case XAB$C_FHC
		    print "XAB$C_FHC"
		case XAB$C_ITM
		    print "XAB$C_ITM"
		case XAB$C_JNL
		    print "XAB$C_JNL"
		case XAB$C_KEY
		    print "XAB$C_KEY"
		case XAB$C_PRO
		    print "XAB$C_PRO"
		case XAB$C_RDT
		    print "XAB$C_RDT"
		case XAB$C_RU
		    print "XAB$C_RU"
		case XAB$C_SUM
		    print "XAB$C_SUM"
		case XAB$C_TRM
		    print "XAB$C_TRM"
		case else
		    print " ???"
	    end select
	    print "-i- xab blk len  : "; my_peek_B( p_data+1)			!
	    print "-i- xab spare    : "; my_peek_W( p_data+2)			!
	    print "-i- xab next xab : "; my_peek_L( p_data+4)			! xab$l_nxt is a long, 4 bytes from the start
	    p_addr = p_data+4							!
	    p_data = my_peek_L( p_data+4)					!
	    goto next_xab							!
	end if									!
	if pass% = 0 then							! if first pass thru
	    hook2% = hook9%							! we only save on the first pass thru
	    print "-i- hook         : "; hook2%
	end if									!
	print "----------------------------------------"
	pass% = pass% + 1							!
	return									!
	!-----------------------------------------------------------------------
	!	from this point on, do not disturb rc%
	!-----------------------------------------------------------------------
	close_n_exit:								!
   %if %method=0% %then								!
	print "-i- restoring the xab chain"					!
	user_fab::fab$l_xab = preserve%						! repair chain b4 we exit
   %else									!
	print "-i- restoring the xab chain"					!
	junk% = my_poke_L(hook2%, 0) 						! repair chain b4 we exit
   %end %if									!
	print "-i- calling sys$close"						!
	junk% = sys$close( user_fab )						! close now cuz we'll reopen it later with a map
	if (junk% and 7%) <> 1% then						!
	    print "-e- sys$close rc: "+str$(junk%)+" ("+ str$(junk% and 7%) +")"!
	end if									!
	print "-i- exiting my_open()"
	end function rc%							!
	!=======================================================================
	!	peek L(ong)
	!=======================================================================
32110	function long my_peek_L(long incomming by ref)				! long function receives long address
	option type=explicit							!
	my_peek_L =  incomming							! exit with this value
	end function								!
	!=======================================================================
	!	peek W(ord)
	!=======================================================================
32120	function word my_peek_W(word incomming by ref)				! word function receives word address
	option type=explicit							!
	my_peek_W =  incomming							! exit with this value
	end function								!
	!=======================================================================
	!	peek B(yte)
	!=======================================================================
32130	function byte my_peek_B(byte incomming by ref)				! byte function receives byte address
	option type=explicit							!
	my_peek_B =  incomming							! exit with this value
	end function								!
	!=======================================================================
	!	peek Q/uadword
	!=======================================================================
32140	function basic$quadword my_peek_Q(basic$quadword incomming by ref)	! byte function receives quad address
	option type=explicit							!
	%include "starlet"      %from %library "sys$library:basic$starlet"      ! system services (and basic$quadword)
	my_peek_Q =  incomming							! exit with this value
	end function								!
	!=======================================================================
	!	my_loc
	!
	!	This function was needed to get around a compiler restriction with Alpha-BASIC-3.7 on OpenVMS-8.4
	!	I'm do not know if the restriction existed with earlier Alpha BASIC compilers
	!=======================================================================
32150	function long my_loc(long incomming by value)				! this function receives an address
	option type=explicit							!
	my_loc =  incomming							! exit with this value
	end function								!
	!=======================================================================
	!	poke L(ong)
	!=======================================================================
32160	function long my_poke_L(long incomming by ref, long poke_data by value)	! long function receives long address
	option type=explicit							!
	declare long status%							!
	when error in								!
	    incomming = poke_data						!
	    status% = 0								!
	use									!
	    status% = err							!
	end when								!
	my_poke_L = status%							! 0 means a-okay
	end function								!