1
2
3
4
5
6
7
8
9 rlm_open:
10 proc ();
11
12 return;
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 dcl p_rel_dir char (*);
59 dcl p_rel_entry char (*);
60 dcl p_rel_opening_id bit (36) aligned;
61 dcl p_code fixed bin (35);
62
63
64
65
66
67 dcl cleanup condition;
68
69
70
71 dcl null builtin;
72
73
74
75
76 dcl IS_OPEN_ENTRY init ("1"b) bit (1) int static options (constant);
77 dcl IS_CLOSE_ENTRY init ("0"b) bit (1) int static options (constant);
78 dcl myname init ("rlm_open") char (8) internal static options (constant);
79
80
81
82 dcl file_manager_$open entry (char (*), char (*), bit (36) aligned, fixed bin (35));
83 dcl file_manager_$close entry (bit (36) aligned, fixed bin (35));
84
85 dcl rlm_opening_info$get entry (bit (36) aligned, ptr, fixed bin (35));
86 dcl rlm_opening_info$get_dont_refresh
87 entry (bit (36) aligned, ptr, fixed bin (35));
88 dcl rlm_opening_info$refresh
89 entry (ptr, fixed bin (35));
90 dcl rlm_opening_info$init entry (bit (36) aligned, ptr, fixed bin (35));
91 dcl rlm_update_opening_info$increment_openings
92 entry (ptr, fixed bin (35));
93 dcl rlm_update_opening_info$decrement_openings
94 entry (ptr, fixed bin (35));
95
96
97
98 dcl error_table_$unimplemented_version
99 ext fixed bin (35);
100 dcl dm_error_$file_already_open
101 ext fixed bin (35);
102 dcl dm_error_$relation_not_open
103 ext fixed bin (35);
104
105
106 ^L
107 open:
108 entry (p_rel_dir, p_rel_entry, p_rel_opening_id, p_code);
109
110 p_code = 0;
111 p_rel_opening_id = "0"b;
112
113 on cleanup call FINISH;
114 call file_manager_$open (p_rel_dir, p_rel_entry, p_rel_opening_id, p_code);
115
116 if p_code ^= 0 & p_code ^= dm_error_$file_already_open
117 then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
118
119 p_code = 0;
120
121 call rlm_opening_info$get (p_rel_opening_id, relation_opening_info_ptr, p_code);
122 if p_code ^= 0
123 then if p_code ^= dm_error_$relation_not_open
124 then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
125 else
126 do;
127 call rlm_opening_info$init (p_rel_opening_id, relation_opening_info_ptr, p_code);
128 if p_code ^= 0
129 then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
130
131 call rlm_opening_info$refresh (relation_opening_info_ptr, p_code);
132 if p_code ^= 0
133 then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
134 end;
135
136
137 call rlm_update_opening_info$increment_openings (relation_opening_info_ptr, p_code);
138 if p_code ^= 0
139 then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
140
141 MAIN_RETURN:
142 return;
143
144
145 ERROR_RETURN:
146 proc (er_p_is_open_entry, er_p_code);
147
148 dcl er_p_is_open_entry bit (1) parameter;
149 dcl er_p_code fixed bin (35);
150
151 p_code = er_p_code;
152 if er_p_is_open_entry
153 then
154 do;
155 call FINISH ();
156 p_rel_opening_id = "0"b;
157 end;
158 call RETURN;
159 end ERROR_RETURN;
160 %skip;
161 RETURN:
162 proc ();
163 goto MAIN_RETURN;
164 end;
165 %skip;
166 FINISH:
167 proc ();
168 call file_manager_$close (p_rel_opening_id, p_code);
169 end;
170 %page;
171 close:
172 entry (p_rel_opening_id, p_code);
173
174 call rlm_opening_info$get_dont_refresh (p_rel_opening_id, relation_opening_info_ptr, p_code);
175 if p_code ^= 0
176 then call ERROR_RETURN (IS_CLOSE_ENTRY, p_code);
177
178 call rlm_update_opening_info$decrement_openings (relation_opening_info_ptr, p_code);
179 if p_code ^= 0
180 then call ERROR_RETURN (IS_CLOSE_ENTRY, p_code);
181
182 call file_manager_$close (p_rel_opening_id, p_code);
183 if p_code ^= 0
184 then call ERROR_RETURN (IS_CLOSE_ENTRY, p_code);
185
186 call RETURN;
187 %page;
188 %include dm_rlm_opening_info;
189
190 end rlm_open;