OpenVMS Source-Code Demos

BASIC_PEEK_DEMO

1024	%title "BASIC-PEEK-DEMO"						! never change this line number :-)
	%ident                              "105.3"				!
	declare string constant k_version = "105.3"			,	!				&
				k_program = "BASIC-PEEK-DEMO"			!
	!========================================================================================================================
	! Title  : DEC-BASIC-Peek_Demo_xxx.bas
	! Author : Neil Rieck (Kitchener/Waterloo/Cambridge, Ontario, Canada)
	!        :            (http://neilrieck.net) (mailto:n.rieck@sympatico.ca)
	! Notes  : 1) This program allows DEC-BASIC to peek at a memory location in a way similar to DEC-C
	!	      (the difference being that DEC-C can do it without the creation of an external function)
	!	   2) Compile this program with cli switches "/list/machine" then look for the BASIC line numbers
	!	      converted to hex
	! History:
	! ver who when   what
	! --- --- ------ --------------------------------------------------------------------------------------------------------
	! 100 NSR 001022 1. original program
	! 101 NSR 070629 1. cleanup for publishing to public domain
	! 102 NSR 110409 1. added three dump routines
	!		 2. added a demo for a fixed string array
	!     NSR 110410 3. added a demo for variable string arrays
	! 103 NSR 130105 1. another cleanup
	! 104 NSR 141001 1. added a few lines of code to foil compiler optimization
	! 105 NSR 170520 1. added code to peek at a 2-dimension array (created at run-time)
	!     NSR 170521 2. added code to peek at 1 and 3 dimension arrays (created at run-time)
	!		 3. wrote a function to peek at an array descriptor (DSC$K_CLASS_NCA)
	!========================================================================================================================
	!  32-bit Descriptor Prototype (from dump of sys$library:BASIC$STARLET.TLB)
	!
	!  Each class of 32-bit descriptor consists of at least  2  longwords in the following format:
	!
	!	+-------+-------+---------------+
	!	| CLASS | DTYPE |    LENGTH     |  :Descriptor
	!	+-------+-------+---------------+
	!	|            POINTER            |
	!	+-------------------------------+
	!
	!	DSC$W_LENGTH   A one-word field specific to the descriptor
	!	<0,15:0>       class/*  typically a 16-bit (unsigned) length.
	!
	!	DSC$B_DTYPE    A one-byte atomic data type code
	!	<0,23:16>
	!
	!	DSC$B_CLASS    A one-byte descriptor class code (see below)
	!	<0,31:24>
	!
	!	DSC$A_POINTER  A longword pointing to the first byte of the
	!	<1,31:0>       data element described.
	!========================================================================================================================
	!	Enabling either "when error use" or "on error" trapping (and including any BASIC code which references ERL)
	!	has been known to add more code, and therefore, more human-readable references to the machine code listings.
	!	Disabling compiler optimization will stop the compiler from unrolling loops (and other stuff) as well as
	!	leaving target labels in the machine code listings.
	!	Try any one of these commands just for fun:
	!		bas/list/machine/nooptim                      BASIC-PEEK-DEMO_105
	!		bas/list/machine/optim=level=0                BASIC-PEEK-DEMO_105
	!		bas/list/machine/optim=level=0/cross/show=all BASIC-PEEK-DEMO_105
	!	then inspect file BASIC-PEEK-DEMO_105.lis
	!========================================================================================================================
	option type=explicit							! no kid stuff
	set no prompt								! no '?' after input prompt
	%include "starlet"	%from %library "sys$library:basic$starlet"	! system services (and basic$quadword)
	%include "$dscdef"	%from %library "sys$library:basic$starlet"	! mostly descriptor constants
	%include "$iledef"	%from %library "sys$library:basic$starlet"	! Item List Entry structures
	!
	on error goto my_error_trap						!
	!
	!	note: for this little trick to work, we must...
	!
	!		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 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 )				!
	external DSCDEF6 function my_array_details (any by desc )		!
	!
	external sub dump_long(long , long )					!
	external sub dump_word(long , long )					!
	external sub dump_byte(long , long , long)				!
	!
	declare long	i%						,	&
			ptr1						,	&
			ptr2						,	&
			length						,	&
			temp						,	&
			test123						,	&
			last_subscr					,	&
			x ,y ,z						,	&
			x2,y2,z2					,	&
			subtest						,	&
			junk						,	&
		string	dynamic_str$					,	&
			junk$						,	&
			default$						!
	map(m1)string	mapped_str$ = 10					! a little larger than required
	map(m2)long	mapped_long%						!
	!
	!	support for:	fixed-string array
	!			variable string array
	!
	!	note:	1) the BASIC view of how these arrays are data-filled, then referenced, appears identical
	!		   but the binary code behind it is totally different. For example, a mapped string produces
	!		   a descriptor. Some people assume (falsely) that a mapped long will produce a long
	!		   descriptor.
	!		2) you may wish to compile with switches "/list/machine" for more information
	!
	declare long constant k_max_subscr = 2				!
	declare long constant k_max_size = 5				!
	!
	map(m3)string fs_array$(k_max_subscr) = k_max_size		! fixed string array; subscripts 0->k_max_subscr
	!
	!	This array is built at compile-time. The Alpha-BASIC compiler "knows" boundary limits (because
	!	I used a constant) and will simulate appropriate conditions when an array boundary is exceeded.
	!
	dim string vs_array_ct$(k_max_subscr)				! variable string array; subscripts 0->k_max_subscr
	!
	!=======================================================================
	!	main
	!=======================================================================
2048	main:
	print k_program +"_"+ k_version					!
	print string$(len(k_program +"_"+ k_version), asc("="))		! what will the optimizer do with this?
	!
	!-----------------------------------------------------------------------
	!	initialize test data (for most tests)
	!-----------------------------------------------------------------------
	print "-i-initializing test data"				!
	test123	= 123%							! stand-alone long
	mapped_long%	= 124%						! mapped long
	dynamic_str$	= "HELLO"					!
	!
	for i% = 0 to k_max_subscr					!
	    fs_array$(i%)    = "FS"+str$(i%)				! fixed string array
	    vs_array_ct$(i%) = "VSC"+str$(i%)				! variable string compile-time
	next i%								!
	!
	!	This array is built at run-time and behaves the way you would expect
	!	The whole purpose of this code is to do something the compiler can't ever optimize
	!
	yada0:								! find this label in machine code listing
	when error in							!
	    Print "-i-run-time array init"				!
	    print "last subscript? (enter any number between 2 and 5) ";!
	    input last_subscr						!
	use								!
	    last_subscr = 0						!
	end when 							!
	select last_subscr						!
	    case 2 to 99						!
	    case else							!
		last_subscr = 2						!
	end select							!
	print "-i-last subscript will be: "+ str$(last_subscr)		!
	yada1:								! find this label in machine code listing
	dim string vs_array_rt$(last_subscr)				! create array at run time
	yada2:								! find this label in machine code listing
	!
	!	now load the array with data
	!
	print "initializing test data (continue)"			!
	for i% = 0 to last_subscr					!
	    vs_array_rt$(i%) = "VSR"+str$(i%)				! variable string run-time
	next i%								!
	!-----------------------------------------------------------------------
	!	example #1 (LONG INTEGER)
	!-----------------------------------------------------------------------
4096	test1:
	print
	print "-i-Test-1 "+ string$(65,asc("#"))			!
	print "Long Integer=";test123					!
	ptr1  = loc( test123 )						! ptr1 is a pointer to a long integer
	print "addr  ="; ptr1						! display the address
	call dump_byte(ptr1, 4, 0)					! 4-bytes (32-bit long)
	print "hack="; my_peek_L( loc(test123) )			!
	print "-i-end of hack 1. Hit <enter>";				!
	input junk$							!
	!-----------------------------------------------------------------------
	!	example #1b (MAPPED INTEGER)
	!-----------------------------------------------------------------------
	test1b:
	print
	print "-i-Test-1b"						!
	print "Mapped Integer=";mapped_long%				!
	ptr1	= loc( mapped_long% )					! ptr1
	print "addr  ="; ptr1						! display the address
	call dump_byte(ptr1, 4, 0)					! 4-bytes (32-bit long)
	print "hack="; my_peek_L( loc(mapped_long%) )			!
	print "-i-end of hack 1b. Hit <enter>";				!
	input junk$							!
	!-----------------------------------------------------------------------
	!	example #2 (DYNAMIC STRING)
	!-----------------------------------------------------------------------
8192	test2:
	print								!
	print "-i-Test-2 "+ string$(65,asc("#"))			!
	print "Dynamic String=";dynamic_str$				!
	ptr1	= loc( dynamic_str$ )					! ptr1 is a pointer to string descriptor
	print "addr   "; ptr1						! display the descriptor address
	call dump_word(ptr1  , 1)					!
	call dump_byte(ptr1+2, 2, 0)					!
	call dump_long(ptr1+4, 1)					!
	print "a=(length ) "; my_peek_W( ptr1   )			! DATA LENGTH
	print "b=(type   ) "; my_peek_B( ptr1+2 )			! DESCRIPTOR TYPE
	print "c=(class  ) "; my_peek_B( ptr1+3 )			! DESCRIPTOR CLASS
	print "d=(address) "; my_peek_L( ptr1+4 )			! DATA ADDRESS
	!
	ptr2	= my_peek_L( ptr1+4 )					! get the address (again)
	length	= my_peek_W( ptr1   )					! get the LENGTH (again)
	call dump_byte(ptr2, length, 1)					!
	print "-i-end of hack 2. Hit <enter>";				!
	input junk$							!
	!-----------------------------------------------------------------------
	!	example #3 (MAPPED STRING)
	!-----------------------------------------------------------------------
16384	test3:
	print
	print "-i-Test-3 "+ string$(65,asc("#"))			!
	mapped_str$	= "GOOD BYE"					!
	print "Mapped String=";mapped_str$				!
	print "-?-enter some text or just hit <enter> for the default";	! -+- foil compiler optimization
	input junk$							! -+
	mapped_str$ = junk$ if edit$(junk$ ,2) <> ""			! -+
	ptr1	= loc( mapped_str$ )					! ptr1 is a pointer to data
	length = len( mapped_str$ )					! be sure to check equiv machine code
	print "addr   "; ptr1						! display the string address
	print "length "; length						! display the string length
	call dump_byte(ptr1, length, 1)					!
	print "-i-end of hack 3. Hit <enter>";				!
	input junk$							!
	!-----------------------------------------------------------------------
	!	example #4 (fs array)
	!-----------------------------------------------------------------------
16385	test4:
	print								!
	print "-i-Test-4 "+ string$(65,asc("#"))			!
	print "fs array (fixed length strings - no descriptors)"
	print "array data"
	for i% = 0 to k_max_subscr					!
	    print " ";i%;" ";fs_array$(i%)				!
	next i%								!
	print "declared max size: "+ str$(k_max_size)			! be sure to check equiv machine code
	print "declared max subs: "+ str$(k_max_subscr)			! be sure to check equiv machine code
	ptr1	= loc( fs_array$(0) )					! ptr1 is a pointer to string data
	length	= len( fs_array$(0) )					! the compiler knew this value
	print "addr-0 "; ptr1						! display the string address
	print "length "; length						! display the max string length
	call dump_byte(ptr1, length, 1)					!
	print "-i-end of hack 4. Hit <enter>";				!
	input junk$							!
	!-----------------------------------------------------------------------
	!	example #5 (vs array)
	!-----------------------------------------------------------------------
16386	test5:
	print
	print "-i-Test-5 "+ string$(65,asc("#"))			!
	print "vs array (compile-time - variable length strings - descriptors)"
	print "array data"						!
	for i% = 0 to k_max_subscr					!
	    print " ";i%;" ";vs_array_ct$(i%)				!
	next i%								!
	ptr1	= loc( vs_array_ct$(0) )				! ptr1 is a pointer to string descriptor
	print "addr-0 "; ptr1						! display the descriptor address
	call dump_word(ptr1  , 1   )					!
	call dump_byte(ptr1+2, 2, 0)					!
	call dump_long(ptr1+4, 1   )					!
	print "a=(length ) "; my_peek_W( ptr1   )			! DATA LENGTH
	print "b=(type   ) "; my_peek_B( ptr1+2 )			! DESCRIPTOR TYPE
	print "c=(class  ) "; my_peek_B( ptr1+3 )			! DESCRIPTOR CLASS
	print "d=(address) "; my_peek_L( ptr1+4 )			! DATA ADDRESS
	!
	ptr2	= my_peek_L( ptr1+4 )					! get the address (again)
	length	= my_peek_W( ptr1   )					! get the LENGTH (again)
	call dump_byte(ptr2, length, 1)					!
	print "hit <enter> to continue ";				!
	input junk$							!
	!
	ptr1	= loc( vs_array_ct$(1) )				! ptr1 is a pointer to string descriptor
	print "addr-1 "; ptr1						! display the descriptor address
	call dump_word(ptr1  , 1   )					!
	call dump_byte(ptr1+2, 2, 0)					!
	call dump_long(ptr1+4, 1   )					!
	print "a=(length ) "; my_peek_W( ptr1   )			! DATA LENGTH
	print "b=(type   ) "; my_peek_B( ptr1+2 )			! DESCRIPTOR TYPE
	print "c=(class  ) "; my_peek_B( ptr1+3 )			! DESCRIPTOR CLASS
	print "d=(address) "; my_peek_L( ptr1+4 )			! DATA ADDRESS
	!
	ptr2	= my_peek_L( ptr1+4 )					! get the address (again)
	length	= my_peek_W( ptr1   )					! get the LENGTH (again)
	call dump_byte(ptr2, length, 1)					!
	!
	print "-i-end of hack 5. Hit <enter>";				!
	input junk$							!
	!-----------------------------------------------------------------------
	!	example #6 (vs array)
	!-----------------------------------------------------------------------
	record switcheroo
	    variant
		case
		    group one						!
			basic$quadword	my_quad				!
		    end group						!
		case							!
		    group two						!
			word	my_len					!
			byte	my_typ					!
			byte	my_class				!
			long	my_addr					!
		    end group
		case
		    group three						!
			DSCDEF1	my_descriptor				! definied 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
	!
16387	test6:
	print
	print "-i-Test-6 "+ string$(65,asc("#"))			!
	print "vs array (run-time - variable length strings - descriptors)"
	print "array data"						!
	for i% = 0 to last_subscr					!
	    print " ";i%;" ";vs_array_rt$(i%)				!
	next i%								!
	ptr1	= my_loc( vs_array_rt$() )				! here, ptr1 is a pointer to array descriptor (maybe not)
	print "addr   "; ptr1						! display the descriptor address
	ptr1	= loc( vs_array_rt$(0) )				! ptr1 is a pointer to string descriptor
	print "addr-0 "; ptr1						! display the descriptor address
	call dump_word(ptr1  , 1   )					!
	call dump_byte(ptr1+2, 2, 0)					!
	call dump_long(ptr1+4, 1   )					!
	print "a=(length ) "; my_peek_W( ptr1   )			! DATA LENGTH
	print "b=(type   ) "; my_peek_B( ptr1+2 )			! DESCRIPTOR TYPE
	print "c=(class  ) "; my_peek_B( ptr1+3 )			! DESCRIPTOR CLASS
	print "d=(address) "; my_peek_L( ptr1+4 )			! DATA ADDRESS
	!
	print
	print "-i-Test-6a "+ string$(65,asc("#"))			!
	ptr2	= my_peek_L( ptr1+4 )					! get the address (again)
	length	= my_peek_W( ptr1   )					! get the LENGTH (again)
	call dump_byte(ptr2, length, 1)					!
	print "hit <enter> to continue ";				!
	input junk$							!
	!
	!	use a different technique to pull the next string
	!
	print
	print "-i-Test-6b "+ string$(65,asc("#"))			!
	ptr1	= loc( vs_array_rt$(1) )				! ptr1 is a pointer to string descriptor
	my_dsc::my_quad = my_peek_Q( ptr1 )				! stuff our switcheroo
	ptr2	= my_dsc::my_addr					!
	length	= my_dsc::my_len					!
	call dump_byte(ptr2, length, 1)					!
	!
	!	use a different technique to pull the next string
	!
	!	note: I did this to show it is possible to write code by reverse-engineering (hacking) the STARLET library.
	!		But since there appears to be a tiny bug in module $dscdef in sys$library:basic$starlet the
	!		technique shown above in Test-6b is preferable to this one.
	!
	print
	print "-i-Test-6c "+ string$(65,asc("#"))			!
	ptr1	= loc( vs_array_rt$(2) )				! ptr1 is a pointer to string descriptor
	my_dsc::my_quad = my_peek_Q( ptr1 )				! stuff our switcheroo
	ptr2	= my_dsc::DSC$A_POINTER					! using DSCDEF1
!~~~	length	= my_dsc::DSC$W_LENGTH   				x using DSCDEF1; this should work but will not compile
	length 	= my_dsc::DSC$W_MAXSTRLEN				! using DSCDEF1; this should not work but does
	call dump_byte(ptr2, length, 1)					!
	!
	print "-i-end of hack 6. Hit <enter>";				!
	input junk$							!
	!=======================================================================
	! OpenVMS String Array Notes:
	!
	! 1) It appears that when BASIC declares a run-time array of strings with dimensions of 2x3, then OpenVMS declares a
	!    contiguous list of 3x4+1=13 string descriptors with the last one only containing nulls which signifies "no-more"
	! 2) When you pass an array by of strings reference (I like to use "any by reference") the compiler passes the address of
	!    the first descriptor
	! 3) Excerpt from: HP BASIC for OpenVMS Reference Manual (January 2005)
	!    When passing an entire array by descriptor, VAX BASIC creates a DSC$K_CLASS_A descriptor; I64 BASIC/Alpha BASIC
	!    creates a DSC$K_CLASS_NCA descriptor. For most BASIC applications, this is not noticeable because both the calling
	!    program and the called subprogram use NCA descriptors.  However, a program that relies on individual descriptor
	!    fields may have to be modified to work with descriptors produced by I64 BASIC/Alpha BASIC. For more information
	!    about DSC$K_CLASS_A and DSC$K_CLASS_NCA descriptors, see the OpenVMS Calling Standard.
	!
	!	  0 1 2 3
	!	+--------
	! 0	| d d d d
	! 1	| d d d d
	! 2	| d d d d <-- demo(2,3)
	!       | d       <-- internal end-of-list marker
	!
	!=======================================================================
	!	array of 1-dimension
	!=======================================================================
	test71:
	print
	print "-i-Test-71 "+ string$(65,asc("#"))			!
	subtest = 1							!
	x2 = last_subscr						!
	sleep 1
	!
	test71_reentry_point:						! spaghetti zone :-)
	print "-i-beginning subtest:";subtest				!
	select subtest							!
	case 1								! only populate array on first pass
	    dim string array71(x2)					!
	    for x = 0 to x2						!
		array71(x) = "x:"+str$(x)				!
	    next x							!
	case 2								!
	    array71(1) = "this is a test"				! change one location to something longer
	case 3								!
	    x2 = 0							!
	    dim string array71(x2)					!
	case 4								!
	    mat array71 = nul$						!
	case else							!
	    goto test71_done
	end select							!
	print "-i-note: declared dimensions are ";x2			!
	print "-i-note: actual   dimensions are ";x2+1			!
	sleep 1
	declare DSCDEF6 hack						!
	hack = my_array_details( array71() )				! just fooling around
!~~~	ptr1	=    loc( array71() )					x compiler throws: %BASIC-E-ENTARRNOT
!~~~	ptr1	=    loc( array71(0))					x works on Itanium (provides addr of 1st descriptor)
	ptr1	= my_loc( array71() )					! my custom alternate (provides addr of 1st descriptor)
	print "addr   "; ptr1						! display 1st descriptor address
	call dump_byte(ptr1, (x2+1+1)*8, 1)				! just hacking (part 1)
	print "-----------"
	if subtest=1 then
	    junk = (x2+1+1)*8
	    print "----------- start of before"				! let's see about 50 bytes before
	    call dump_byte(ptr1-junk, junk, 1)				! just hacking (part 2)
	    print "----------- end of before"				!
	end if
	!
	get71_next:
	print "a=(length ) "; my_peek_W( ptr1   )			! DATA LENGTH
	print "b=(type   ) "; my_peek_B( ptr1+2 )			! DESCRIPTOR TYPE
	print "c=(class  ) "; my_peek_B( ptr1+3 )			! DESCRIPTOR CLASS
	print "d=(address) "; my_peek_L( ptr1+4 )			! DATA ADDRESS
	my_dsc::my_quad = my_peek_Q( ptr1 )				! stuff our switcheroo
	length 	= my_dsc::DSC$W_MAXSTRLEN				! using DSCDEF1; this should not work but does
	ptr2 = my_peek_L( ptr1+4 )					! prep to extract
	if ptr2 <> 0 then						!
	    call dump_byte(ptr2, length, 1)				!
	    print "-i-advancing address by 8-bytes"			!
	    ptr1 = ptr1 + 8						! advance 8-bytes
	    goto get71_next						!
	else
	    print "-i-address is null so done"
	end if								!
	!
	print string$(50,asc("-"))					!
	subtest = subtest + 1						!
	goto test71_reentry_point					!
	test71_done:
	!
	print "-i-end of hack 71. Hit <enter>";				!
	input junk$							!

	!=======================================================================
	!	array of  2-dimensions
	!=======================================================================
	test72:
	print
	print "-i-Test-72 "+ string$(65,asc("#"))			!
	x2 = last_subscr						!
	y2 = last_subscr + 1						!
	!
	!	BASIC traditionally declares array dimensions from zero to declared value
	!
	print "-i-note: declared dimensions are ";x2;"x";y2		!
	print "-i-note: actual   dimensions are ";x2+1;"x";y2+1		!
	sleep 1
	dim string array72(x2,y2)					!
	hack = my_array_details( array72(,) )				! just fooling around
	ptr1	= my_loc( array72(,) )					!
	print "addr   "; ptr1						! display the descriptor address
	for x = 0 to x2							!
	    for y = 0 to y2						!
		array72(x, y) = "data-x:"+str$(x)+";y:"+str$(y)
	    next y							!
	next x								!
!~~~	ptr1	=    loc( array72(,) )					x this will not work
	ptr1	= my_loc( array72(,) )					!
	print "addr   "; ptr1						! display the descriptor address
	call dump_byte(ptr1,(((x2+1)*(y2+1)+1)*8), 1)			! just hacking
	print "------"
	call dump_word(ptr1  , 1   )					!
	call dump_byte(ptr1+2, 2, 0)					!
	call dump_long(ptr1+4, 1   )					!
	print "a=(length ) "; my_peek_W( ptr1   )			! DATA LENGTH
	print "b=(type   ) "; my_peek_B( ptr1+2 )			! DESCRIPTOR TYPE
	print "c=(class  ) "; my_peek_B( ptr1+3 )			! DESCRIPTOR CLASS
	print "d=(address) "; my_peek_L( ptr1+4 )			! DATA ADDRESS
	print "------"
	ptr2 = my_peek_L( ptr1+4 )					!
	length 	= my_dsc::DSC$W_MAXSTRLEN				! using DSCDEF1; this should not work but does
	call dump_byte(ptr2, length, 1)					!
	!
	print "-i-end of hack 72. Hit <enter>";				!
	input junk$							!
	!=======================================================================
	!	array of 3-dimensions
	!=======================================================================
	test73:
	print
	print "-i-Test-73 "+ string$(65,asc("#"))			!
	x2 = last_subscr						!
	y2 = last_subscr + 1						!
	z2 = last_subscr + 2						!
	!
	!	BASIC traditionally declares array dimensions from zero to declared value
	!
	print "-i-note: declared dimensions are ";x2;"x";y2;"x";z2	!
	print "-i-note: actual   dimensions are ";x2+1;"x";y2+1;"x";z2+1
	sleep 1
	dim string array73(x2,y2,z2)					!
	hack = my_array_details( array73(,,) )				! just fooling around
	ptr1	= loc( array73(0,0,0) )					!
	print ptr1
	ptr1	= my_loc( array73(,,) )					!
	print ptr1
	print "addr   "; ptr1						! display the descriptor address
	for x = 0 to x2							!
	    for y = 0 to y2						!
		for z = 0 to z2						!
		    array73(x,y,z) = "x:"+str$(x)+";y:"+str$(y)+";z:"+str$(z)
		next z
	    next y							!
	next x								!
!~~~	ptr1	=    loc( array73(,,) )					x this will not work
	ptr1	= my_loc( array73(,,) )					!
	print "addr   "; ptr1						! display the descriptor address
	call dump_byte(ptr1,(((x2+1)*(y2+1)*(z2+1)+1)*8)   , 1)		! just hacking
	print "------"
	call dump_word(ptr1  , 1   )					!
	call dump_byte(ptr1+2, 2, 0)					!
	call dump_long(ptr1+4, 1   )					!
	print "a=(length ) "; my_peek_W( ptr1   )			! DATA LENGTH
	print "b=(type   ) "; my_peek_B( ptr1+2 )			! DESCRIPTOR TYPE
	print "c=(class  ) "; my_peek_B( ptr1+3 )			! DESCRIPTOR CLASS
	print "d=(address) "; my_peek_L( ptr1+4 )			! DATA ADDRESS
	print "------"
	ptr2 = my_peek_L( ptr1+4 )					!
	length 	= my_dsc::DSC$W_MAXSTRLEN				! using DSCDEF1; this should not work but does
	call dump_byte(ptr2, length, 1)					!
	!
	print "-i-end of hack 73. Hit <enter>";				!
	input junk$							!
	!
	goto fini
	!-----------------------------------------------------------------------
	!	common error trap
	!-----------------------------------------------------------------------
	my_error_trap:
	print
	print "==============================="
	print "   common error trap"
	print "==============================="
	print "-i-error : "; err
	print "-e-text  : "; ert$(err)
	print "-i-line  : "; erl
	print "-i-module: "; ern$
	print "==============================="
	resume fini								!
	!=======================================================================
	!	adios
	!=======================================================================
31000	fini:									!
	print "Adios..."							!
	end program 1 								! VMS-s-
	!#######################################################################
	!
	!	External functions
	!
	!-----------------------------------------------------------------------
	!	peek L(ong)
	!-----------------------------------------------------------------------
32000	function long my_peek_L(long incoming by ref)				! long function receives long address
	option type=explicit							!
	my_peek_L =  incoming							! exit with this value
	end function								!
	!-----------------------------------------------------------------------
	!	peek W(ord)
	!-----------------------------------------------------------------------
32010	function word my_peek_W(word incoming by ref)				! word function receives word address
	option type=explicit							!
	my_peek_W =  incoming							! exit with this value
	end function								!
	!-----------------------------------------------------------------------
	!	peek B(yte)
	!-----------------------------------------------------------------------
32020	function byte my_peek_B(byte incoming by ref)				! byte function receives byte address
	option type=explicit							!
	my_peek_B =  incoming							! exit with this value
	end function								!
	!-----------------------------------------------------------------------
	!	peek Q/uadword
	!-----------------------------------------------------------------------
32030	function basic$quadword my_peek_Q(basic$quadword incoming 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 =  incoming							! 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
	!-----------------------------------------------------------------------
32040	function long my_loc(long incoming by value)				! this function receives an address
	option type=explicit							!
	!
	my_loc =  incoming							! exit with this value
	end function								!
	!-----------------------------------------------------------------------
	!	my_array_details
	!-----------------------------------------------------------------------
32041	function DSCDEF6 my_array_details(DSCDEF6 incoming)
	option type=explicit
	%include "$dscdef"	%from %library "sys$library:basic$starlet"	! mostly descriptor constants
	!
	print "-i-DSC$L_V0 ";incoming::DSC$L_V0					! addr
	print "-i-DSC$L_S1 ";incoming::DSC$L_S1
	print "-i-DSC$L_S2 ";incoming::DSC$L_S2
	!
	my_array_details = incoming						! pass the whole thing back
	end function								!
	!-----------------------------------------------------------------------
	!	dump long data
	!-----------------------------------------------------------------------
32050	sub dump_long(long ptr1, long count%)					!
	option type=explicit							!
	!
	external long function my_peek_L( long by value )			!
	declare long i%, temp							!
	print "Long Peek:"							!
	for i% = 0 to (count%*4 -1) step 4					!
	    temp = ptr1 + i%							!
	    print using " ########## = ##########";temp;my_peek_L(temp)		!
	next i%									!
	end sub									!
	!-----------------------------------------------------------------------
	!	dump_word
	!-----------------------------------------------------------------------
32060	sub dump_word(long ptr1, long count%)					!
	option type=explicit							!
	external long function my_peek_W( long by value )			!
	declare long i%, temp							!
	print "Word Peek:"							!
	for i% = 0 to (count%*2 -1) step 2					!
	    temp = ptr1 + i%							!
	    print using " ########## = ##########";temp;my_peek_W(temp)		!
	next i%									!
	end sub									!
	!-----------------------------------------------------------------------
	!	dump_byte (with ASCII display)
	!-----------------------------------------------------------------------
32070	sub dump_byte(long ptr1, long count%, long extra%) 			!
	option type=explicit							!
	external byte function my_peek_B( long by value )			!
	declare long i%, temp, eightbit%, sevenbit%				!
	declare string a$							!
	print "Byte Peek:"							!
	for i% = 0 to count% - 1						!
	    temp = ptr1 + i%							!
	    eightbit% = my_peek_B(temp)						!
	    if extra% = 1 then							!
		if eightbit% >= 128 then					!
		    sevenbit% = eightbit% - 128					!
		else								!
		    sevenbit% = eightbit%					!
		end if								!
		select sevenbit%						!
		    case < 32, 127						!
			a$ = "."						!
		    case else							!
			a$ = chr$(sevenbit%)					!
		end select							!
		a$ = " = "+ a$							!
	    else								!
		a$ = ""								!
	    end if								!
	    print using " ########## = ########## 'LLLLL";temp;eightbit%; a$	!
	next i%									!
	end sub									!