1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 linus_close:
21 proc (sci_ptr, lcb_ptr);
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 ^L
51 %include linus_lcb;
52 %page;
53 %include linus_forced_scope_info;
54 %page;
55 %include linus_ready_data;
56 %page;
57 %include linus_ready_table;
58 %page;
59 %include linus_temp_tab_names;
60 %page;
61 ^L
62 dcl sci_ptr ptr;
63
64 dcl dsl_$close entry options (variable);
65 dcl (
66 linus_data_$c_id,
67 linus_error_$no_db,
68 linus_error_$no_input_arg_reqd,
69 mrds_data_$max_temp_rels,
70 sys_info$max_seg_size
71 ) ext fixed bin (35);
72
73 dcl initial_mrds_vclock float bin (63);
74
75 dcl cleanup condition;
76
77 dcl i fixed bin;
78
79 dcl (addr, fixed, null, rel, vclock) builtin;
80
81 dcl nargs fixed;
82
83 dcl (icode, code, out_code) fixed bin (35);
84
85 dcl linus_print_error entry (fixed bin (35), char (*));
86 dcl linus_convert_code entry (fixed bin (35), fixed bin (35), fixed bin (35));
87 dcl ssu_$arg_count entry (ptr, fixed bin);
88 ^L
89 on cleanup call clean_up;
90
91 icode, code = 0;
92 call ssu_$arg_count (sci_ptr, nargs);
93 if nargs ^= 0 then
94 call linus_print_error (linus_error_$no_input_arg_reqd, "");
95
96
97 else if lcb.db_index = 0 then
98 call linus_print_error (linus_error_$no_db, "");
99 else call main_close;
100 ^L
101 main_close:
102 proc;
103
104 declare temp_index fixed bin (35);
105
106 if lcb.db_index ^= 0 then do;
107 temp_index = lcb.db_index;
108 lcb.db_index = 0;
109 if lcb.timing_mode then
110 initial_mrds_vclock = vclock;
111 call dsl_$close (temp_index, icode);
112 if lcb.timing_mode then
113 lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock;
114 end;
115
116
117 if icode ^= 0 then do;
118 call linus_convert_code (icode, out_code, linus_data_$c_id);
119
120 call linus_print_error (out_code, "");
121 end;
122
123 if lcb.force_retrieve_scope_info_ptr ^= null then do;
124 free lcb.force_retrieve_scope_info_ptr -> forced_retrieve_scope_info;
125 lcb.force_retrieve_scope_info_ptr = null;
126 end;
127
128 lcb.si_ptr = null;
129
130 if lcb.ttn_ptr ^= null then do;
131 ttn_ptr = lcb.ttn_ptr;
132 do i = 1 to mrds_data_$max_temp_rels;
133 temp_tab_names (i) = "";
134 end;
135 end;
136
137 if lcb.rd_ptr ^= null then do;
138 free lcb.rd_ptr -> ready_data;
139 lcb.rd_ptr = null;
140 end;
141 if lcb.rt_ptr ^= null then do;
142 free lcb.rt_ptr -> ready_table;
143 lcb.rt_ptr = null;
144 end;
145
146 end main_close;
147 ^L
148
149
150 clean_up:
151 proc;
152
153 call main_close;
154
155 end clean_up;
156
157
158 end linus_close;