1
2
3
4
5
6
7
8
9 convert_SAT_audit_flags:
10 procedure ();
11
12 db_name = "SAT";
13 ME = "convert_SAT_audit_flags";
14 call cu_$arg_list_ptr (alp);
15 call convert_it;
16 return;
17
18 convert_PNT_audit_flags:
19 entry ();
20
21 db_name = "PNT";
22 ME = "convert_PNT_audit_flags";
23 call cu_$arg_list_ptr (alp);
24 call convert_it;
25 return;
26
27
28
29
30
31
32
33
34
35
36
37
38 XXX
39
40
41 NOTE
42
43
44
45
46
47
48
49 %page;
50
51
52
53 dcl ME char (32);
54 dcl alp pointer;
55 dcl code fixed bin (35);
56 dcl db_dir char (168);
57 dcl db_ent char (32);
58 dcl db_name char (3);
59 dcl revert_sw bit (1) init ("0"b);
60 dcl satp pointer;
61 dcl satep pointer;
62
63
64
65
66 dcl com_err_ entry options (variable);
67 dcl convert_MR10_2_audit_flags_ entry (bit (36) aligned);
68 dcl revert_MR10_2_audit_flags_ entry (bit (36) aligned);
69 dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin(35));
70 dcl cu_$arg_list_ptr entry (pointer);
71 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr);
72 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35));
73 dcl hcs_$initiate entry (char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35));
74 dcl hcs_$terminate_noname entry (ptr, fixed bin(35));
75 dcl pathname_ entry (char(*), char(*)) returns(char(168));
76 dcl pnt_manager_$get_abs_entry entry (fixed bin (35), pointer, fixed bin (35));
77 dcl pnt_manager_$update_entry entry (pointer, bit (1), bit (1), fixed bin (35));
78
79
80
81
82 dcl error_table_$bad_index fixed bin (35) ext;
83 dcl error_table_$checksum_failure fixed bin (35) ext;
84 dcl error_table_$no_record fixed bin (35) ext;
85 dcl error_table_$segknown fixed bin (35) ext;
86 dcl error_table_$unimplemented_version fixed bin (35) ext;
87
88 dcl clean_up condition;
89
90 dcl addr builtin;
91 dcl null builtin;
92 %page;
93
94
95
96 convert_it:
97 procedure ();
98
99 dcl done bit (1);
100 dcl pnt_rec_no fixed bin (35);
101 dcl 1 pnte aligned like pnt_entry;
102 dcl project_index fixed bin;
103
104 satp = null();
105
106 on clean_up begin;
107 if db_name = "SAT"
108 then call close_sat;
109 end;
110
111 call process_arguments;
112
113 if db_name = "SAT"
114 then do;
115 call open_sat;
116 do project_index = 1 to sat.current_size;
117 satep = addr(sat.project(project_index));
118 if revert_sw
119 then call revert_MR10_2_audit_flags_ (project.audit);
120 else call convert_MR10_2_audit_flags_ (project.audit);
121 end;
122 call close_sat;
123 end;
124 else do;
125 done = "0"b;
126 do pnt_rec_no = 1 by 1 while (^done);
127 call pnt_manager_$get_abs_entry (pnt_rec_no, addr(pnte), code);
128
129 if code = 0
130 then do;
131 if revert_sw
132 then call revert_MR10_2_audit_flags_ (pnte.public.audit);
133 else call convert_MR10_2_audit_flags_ (pnte.public.audit);
134 call pnt_manager_$update_entry (addr(pnte), "0"b, "0"b, code);
135 if code ^= 0
136 then do;
137 call com_err_ (code, ME, "Updating PNT record #^d.", pnt_rec_no);
138 goto ERROR_EXIT;
139 end;
140 end;
141 else if code = error_table_$checksum_failure
142 then call com_err_ (code, ME, "Checksum failure on record #^d.", pnt_rec_no);
143 else if code = error_table_$no_record
144 then ;
145 else if code = error_table_$bad_index
146 then done = "1"b;
147 else do;
148 call com_err_ (code, ME, "Reading PNT record #^d.", pnt_rec_no);
149 goto ERROR_EXIT;
150 end;
151 end;
152 end;
153
154 return;
155
156 end convert_it;
157 %page;
158
159
160
161 open_sat:
162 procedure ();
163
164 call hcs_$initiate (db_dir, db_ent, "", 0, 0, satp, code);
165 if code ^= 0 & code ^= error_table_$segknown
166 then do;
167 call com_err_ (code, ME, "Unable to initiate ^a.", pathname_ (db_dir, db_ent));
168 goto ERROR_EXIT;
169 end;
170 else if sat.version ^= SAT_version
171 then do;
172 code = error_table_$unimplemented_version;
173 call com_err_ (code, ME, pathname_ (db_dir, db_ent));
174 goto ERROR_EXIT;
175 end;
176
177 return;
178
179 end open_sat;
180
181
182
183
184
185 close_sat:
186 procedure ();
187
188 if satp ^= null()
189 then call hcs_$terminate_noname (satp, code);
190
191 return;
192
193 end close_sat;
194 %page;
195
196
197
198 process_arguments:
199 procedure ();
200
201 dcl al fixed bin (21);
202 dcl ap pointer;
203 dcl n_args fixed bin;
204
205 dcl arg char (al) based (ap);
206
207 call cu_$arg_count_rel (n_args, alp, code);
208 if code ^= 0
209 then do;
210 ARG_ERR: call com_err_ (code, ME);
211 goto ERROR_EXIT;
212 end;
213
214 if n_args < 1 | n_args > 2
215 then do;
216 USAGE: call com_err_ (0, ME, "Usage is: ^a PATH {-revert}.", ME);
217 goto ERROR_EXIT;
218 end;
219
220 call cu_$arg_ptr_rel (1, ap, al, code, alp);
221 if code ^= 0 then goto ARG_ERR;
222
223 call expand_pathname_ (arg, db_dir, db_ent, code);
224 if code ^= 0 then goto USAGE;
225
226 if n_args = 2
227 then do;
228 call cu_$arg_ptr_rel (2, ap, al, code, alp);
229 if code ^= 0 then goto ARG_ERR;
230
231 if arg = "-revert"
232 then do;
233 call com_err_ (0, ME, "WARNING: Flags produced will not be same as originals.");
234 revert_sw = "1"b;
235 end;
236 else goto USAGE;
237 end;
238
239 return;
240
241 end process_arguments;
242 %page;
243 %include sat;
244 %include user_attributes;
245 %include pnt_entry;
246
247
248 ERROR_EXIT:
249 if db_name = "SAT"
250 then call close_sat;
251
252 end convert_SAT_audit_flags;