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