1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
[environment('sortcall')]
module vmssort(output);
procedure vmssort(var sort_rc:integer);
label RETURN;
const
max_pn_alpha=20;
max_field = 300;
SS$_NORMAL = 1;
DSC$K_DTYPE_L = 8; (* Longword Integer. 32-bit signed *)
DSC$K_DTYPE_T = 14; (* Character-coded text. A single 8-bit character *)
sor$gk_record = 1;
type
word_integer = [word] 0..65535;
byte_integer = [byte] 0..255;
pn_alpha_type=packed array[1..max_pn_alpha] of char;
field_array = packed array[1..max_field] of char;
field_type = packed record
field_lngth :integer;
field_level :field_array;
end;
sort_type = packed record
record_type :char;
page_number :integer;
abs_page_number :integer;
page_string :pn_alpha_type;
sort_part :packed array[1..3] of field_type;
print :packed array[1..3] of field_type;
end;
var
sort_stat: integer;
key_info:array[1..21] of word_integer
:= (5,DSC$K_DTYPE_T,0,33,300,
DSC$K_DTYPE_T,0,337,300,
DSC$K_DTYPE_T,0,641,300,
DSC$K_DTYPE_L,1,5,4,
DSC$K_DTYPE_L,0,1,4);
vmssort_type:byte_integer := sor$gk_record;
function sor$pass_files(
in_file: [class_s] packed array [l..u:integer] of char;
out_file: [class_s] packed array [a..b:integer] of char)
: integer; extern;
function sor$begin_sort(
%REF key_data: array [l..u:integer] of word_integer;
long_rec: word_integer := %IMMED 0;
options: integer := %IMMED 0;
in_file_size: integer := %IMMED 0;
user_compare: integer := %IMMED 0;
user_equal: integer := %IMMED 0;
s_type: byte_integer;
work_files: byte_integer := %IMMED 0;
context : integer := %IMMED 0): integer; extern;
function sor$sort_merge: integer; extern;
function sor$end_sort: integer; extern;
begin
sort_stat:=sor$pass_files(in_file:='TEXT1$$.INSORT',
out_file:='TEXT1$$.OUTSORT');
if not odd(sort_stat) then goto RETURN;
sort_stat:=sor$begin_sort(key_data:=key_info,
s_type:=vmssort_type);
if not odd(sort_stat) then goto RETURN;
sort_stat:=sor$sort_merge;
if not odd(sort_stat) then goto RETURN;
sort_stat:=sor$end_sort;
RETURN:
sort_rc:=sort_stat;
end;
end.
|