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 OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.