OpenVMS Source Code Demos

SORT_DEMO.BAS

1000	%title "sort_demo_100.bas"
	%ident "version_100.1"
	!========================================================================================================================
	! title  : sort_demo_100.bas
	! author : Neil Rieck (http://neilrieck.net/)
	! history:
	! ver who when   what
	! --- --- ------ --------------------------------------------------------------------------------------------------------
	! 100 NSR 050104 1. original code
	!========================================================================================================================
	! Sample File Name:	NEIL_SAMPLE.TXT
	! Contents:		ABCDZ
	!			ABCDA
	!			ABCDA				<--- this key is a duplicate
	!			ABCDB
	!			ABCDX
	!			ABCDD
	!			ABCDE
	! Offset Info:		0123456789012345678901234567890
	!========================================================================================================================
	option type=explicit							!  cuz tricks are for kids
	!
	!	<<< system declarations >>>
	!
	%include "$sordef"      %from %library "sys$library:basic$starlet"	! sor$
	%include "sor$routines" %from %library "sys$library:basic$starlet"	! sor$
	%include "$dscdef"      %from %library "sys$library:basic$starlet"	! dsc$
	%include "$fabdef"      %from %library "sys$library:basic$starlet"	! fab$
	!
	!	<<< home-brewed functions >>>
	!
	external long function fn_sort_eq%(string by ref, string by ref, word by ref, word by ref, long by ref)
	!
	!	<<< variable declarations >>>
	!
	declare word	lrl%						,	!						&
		long	srttype%					,	! sort type					&
			addr_sort_eq%					,	! address of function sort_eq			&
			status%						,	! status					&
			context%						! SOR$ context (zap before setup of any new SOR$)
	!
	!	<<< key descriptor record >>>
	!
	record my_key_dsc							!
	    word my_data_type							!
	    word my_order							!
	    word my_offset							!
	    word my_length							!
	end record								!
	!
	!	key list record
	!
	record key_rec								!
	    word num_keys							!
	    my_key_dsc	my_key(9)						! reserve space for 10 key descriptors (0-9)
	end record								!
	!
	declare key_rec key_buffer						! declare our variable
	!
	!	<<< init >>>
	!
	key_buffer::num_keys = 1						! we will only use one key for this demo
	!
	key_buffer::my_key(0)::my_data_type	= DSC$K_DTYPE_T			!
	key_buffer::my_key(0)::my_order		= 0				!
	key_buffer::my_key(0)::my_offset	= 0				!
	key_buffer::my_key(0)::my_length	= 5				!
	!
!	key_buffer::my_key(1)::my_data_type	= DSC$K_DTYPE_T			x could be used for another key
!	key_buffer::my_key(1)::my_order		= 0				x
!	key_buffer::my_key(1)::my_offset	= 5				x
!	key_buffer::my_key(1)::my_length	= 2				x
	!
!	key_buffer::my_key(2)::my_data_type	= DSC$K_DTYPE_T			x could be used for another key
!	key_buffer::my_key(2)::my_order		= 0				x
!	key_buffer::my_key(2)::my_offset	= 7				x
!	key_buffer::my_key(2)::my_length	= 3				x
	!
	addr_sort_eq%	= LOC(FN_SORT_EQ%)					! get addr of function
	context%	= 0							! always init context before first call to SOR$
	!----------------------------------------------------------------------------------------------------
	!	SOR$PASS_FILES [inp_desc] [,out_desc] [,org] [,rfm] [,bks] [,bls] [,mrs] [,alq] [,fop] [,fsz] [,context]
	!	source: CD-ROM
	!
	status% = SOR$PASS_FILES ("neil_sample.txt", "neil_sample_out.txt",,,,,,,,,context% )
	print "-i- status: "+ str$(status%)
	!----------------------------------------------------------------------------------------------------
	!	SOR$BEGIN_SORT [key_buffer] [,lrl] [,options] [,file_alloc] [,user_compare] [,user_equal] [,sort_process]
	!		[,work_files] [,context]
	!	source: CD-ROM
	!
	!	EXTERNAL LONG FUNCTION SOR$BEGIN_SORT( OPTIONAL ANY BY REF, WORD BY REF, LONG BY REF, LONG BY REF, &
	!		LONG BY VALUE, LONG BY VALUE, BYTE BY REF, BYTE BY REF, LONG BY REF )
	!	source: extracted from file: SYS$LIBRARY:STARLETBASIC$STARLET.TLB
	!
    %let %method=1%								! 0=basic (no call to function), 1=advanced
    %if  %method=0% %then							!
	STATUS% = SOR$BEGIN_SORT(key_buffer::num_keys,LRL%,,,,,,,context%)	!
    %else									!
	STATUS% = SOR$BEGIN_SORT(key_buffer::num_keys,LRL%,,,,addr_sort_eq%,,,context%)
    %end %if									!
	print "-i- status: "+ str$(status%)					!
	!----------------------------------------------------------------------------------------------------
	status% = SOR$SORT_MERGE(context%)					!
	print "-i- status: "+ str$(status%)					!
	!----------------------------------------------------------------------------------------------------
	status% = SOR$END_SORT(context%)					!
	print "-i- status: "+ str$(status%)					!
30000	end									!
	!========================================================================================================================
	!
	!	<<< external functions >>>
	!
	!----------------------------------------------------------------------------------------------------
	! title: fn_sort_eq
	! purpose: come here when SOR$ has discovered a duplicate key
	!----------------------------------------------------------------------------------------------------
31000	function long fn_sort_eq% (string rec_1 by ref, string rec_2 by ref,	&
		word len_1 by ref, word len_2 by ref, long ctx)
	option type=explicit							! cuz tricks are for kids
	!
	%include "$sordef"      %from %library "sys$library:basic$starlet"      ! sor$
	!
	print "-i- in function 'fn_sort_eq' (deleting duplicate record)"	!
	!
	! implementation note:
	! if we only call SOR$ above with one key and no other data, we will only hit this routine when
	! rec_1 = rec_2 so the next test will be superfluous, However, if the data line was longer then
	! this routine could be used to test other non-key data.
	!
	if seg$(rec_1, 1%, 5%) < seg$(rec_2, 1%, 5%)				!
	then
	    fn_sort_eq% = SOR$_DELETE1
	else
	    fn_sort_eq% = SOR$_DELETE2
	end if
	end function
	!

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.