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 copy_fdump: proc (a_code);
45
46 dcl i fixed bin,
47 p ptr,
48 ptp ptr,
49 (dt, dt_dn355) char (24),
50 (ename, a_ename, xname, ename_dn355, a_ename_dn355) char (32),
51 erf char (12),
52 (erf_no, a_erf_no) fixed bin,
53 ptsi fixed bin,
54 code fixed bin (35),
55 a_code fixed bin (35),
56 rb (3) fixed bin (6) init (7, 7, 7),
57 seqno fixed bin,
58 esw fixed bin,
59 dumpadd fixed bin (18),
60 nrecs fixed bin (18),
61 next_part_add fixed bin,
62 first fixed bin (20),
63 (length, a_length) fixed bin (35),
64 (a_valid, a_valid_dn355) bit (1),
65 word_count fixed bin (18),
66 copy (word_count) fixed bin (35) based,
67 dump_pvtx fixed bin,
68 dump_pvid bit (36) aligned,
69 tsdwp ptr,
70 tsdw bit (72);
71
72 dcl (max_size, max_pages, dn355_size) fixed bin;
73 dcl single_dn355_size fixed bin (35);
74 dcl words_per_image fixed bin;
75 dcl pg_size fixed bin;
76
77 dcl (dumping_Multics, dumping_dn355) bit (1);
78
79 dcl (hdr_size, rest_size) fixed bin;
80
81 dcl dn355_copy bit (single_dn355_size) aligned based;
82
83 dcl 1 din based aligned,
84 2 header (hdr_size) fixed bin (35),
85 2 dn355_images (4),
86 3 dn355_core bit (single_dn355_size) aligned,
87 2 rest (rest_size) fixed bin (35);
88
89
90 dcl (error_table_$noaccess fixed bin (35),
91 error_table_$dmpinvld fixed bin (35),
92 error_table_$noprtdmp fixed bin (35),
93 error_table_$bdprtdmp fixed bin (35),
94 error_table_$dmpvalid fixed bin (35),
95 error_table_$nopart fixed bin (35),
96 sys_info$default_max_length fixed bin (35),
97 sys_info$page_size fixed bin (35),
98 pds$process_group_id char (32) aligned,
99 abs_seg$) ext;
100
101 dcl sst$astsize fixed bin external static;
102 dcl 1 sst$level (0:3) aligned external static,
103 2 ausedp bit (18) unaligned,
104 2 no_aste bit (18) unaligned;
105
106 dcl privileged_mode_ut$swap_sdw ext entry (ptr, ptr),
107 thread$out entry (ptr, bit (18) unal),
108 lock$lock_ast entry,
109 lock$unlock_ast entry,
110 get_ptrs_$given_astep ext entry (ptr) returns (bit (72) aligned),
111 syserr ext entry options (variable),
112 condition_ ext entry (char (*), entry),
113 reversion_ ext entry (char (*)),
114 date_time_ ext entry (fixed bin (71), char (*)),
115 append$branchx ext entry (char (*), char (*), fixed bin (5), (3) fixed bin (6), char (*),
116 fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)),
117 initiate ext entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)),
118 pc$cleanup entry (ptr),
119 get_aste ext entry (fixed bin) returns (ptr),
120 put_aste ext entry (ptr),
121 cv_bin_$dec ext entry (fixed bin (17)) returns (char (12) aligned),
122 demand_deactivate$force_given_segno entry (ptr, fixed bin (35)),
123 terminate_$noname entry (ptr, fixed bin (35)),
124 find_partition entry (char (*), fixed bin, bit (36) aligned, fixed bin (18), fixed bin (18), fixed bin (35)),
125 ptw_util_$make_disk entry (pointer, fixed bin (20));
126
127 dcl (addr, addrel, bit, char, divide, fixed, ltrim, min, null, size, substr) builtin;
128
129
130
131 esw = 0;
132 go to setup;
133
134 set_erf_no:
135 entry (a_erf_no, a_code);
136 erf_no = a_erf_no;
137 esw = 1;
138 go to setup;
139
140 get_erf_no:
141 entry (a_length, a_valid, a_ename, a_valid_dn355, a_ename_dn355, a_code);
142 esw = 2;
143 a_length = 0;
144 a_valid, a_valid_dn355 = "0"b;
145 a_ename, a_ename_dn355 = " ";
146
147 setup:
148 a_code = 0;
149 p = null ();
150 pg_size = sys_info$page_size;
151 max_size = sys_info$default_max_length;
152 max_pages = divide (max_size + pg_size - 1, pg_size, 17, 0);
153 dn355_size = 16384 * 4;
154 single_dn355_size = 16384 * 36;
155 words_per_image = 16384;
156 hdr_size = size (dump);
157
158
159
160 call find_partition ("dump", dump_pvtx, dump_pvid, dumpadd, nrecs, code);
161 if code ^= 0 then do;
162 if code = error_table_$nopart then a_code = error_table_$noprtdmp;
163 else a_code = code;
164 return;
165 end;
166
167 first = dumpadd;
168
169 if nrecs = 0 then do;
170 a_code = error_table_$bdprtdmp;
171 return;
172 end;
173
174 next_part_add = first + nrecs;
175
176
177
178 dumpptr = addr (abs_seg$);
179 tsdwp = addr (tsdw);
180 call lock$lock_ast;
181 astep = get_aste (max_pages);
182 ptsi = fixed (aste.ptsi, 2);
183 call thread$out (astep, sst$level.ausedp (ptsi));
184 call lock$unlock_ast;
185 ptp = addrel (astep, sst$astsize);
186 tsdw = get_ptrs_$given_astep (astep);
187 call privileged_mode_ut$swap_sdw (dumpptr, tsdwp);
188 aste.pvtx = dump_pvtx;
189 aste.csl = bit (fixed (max_pages,9), 9);
190 aste.nqsw = "1"b;
191
192
193 call condition_ ("any_other", handler);
194 if esw = 1 then go to set_num;
195 if esw = 2 then go to get_num;
196
197
198
199 do seqno = 0 by 1;
200 do i = 0 to (max_pages - 1) while (i < next_part_add - dumpadd);
201 call ptw_util_$make_disk (addrel (ptp, i), (dumpadd + i));
202 end;
203 if seqno = 0 then do;
204 call check_dump_header;
205 length = min (length, nrecs * pg_size - dn355_size - hdr_size);
206 if dumping_dn355 then do;
207 xname = ename_dn355;
208 word_count = dn355_size;
209 call get_branch;
210 do i = 1 to 4;
211 if substr (dumpptr -> dump.dumped_355s, i, 1)
212 then p -> dn355_copy = dumpptr -> din.dn355_images (i).dn355_core;
213 else p -> dn355_copy = "0"b;
214
215 p = addrel (p, words_per_image);
216 end;
217
218 dumpptr -> dump.valid_355 = "0"b;
219 end;
220 if dumping_Multics then do;
221 call pc$cleanup (astep);
222 aste.npfs = "0"b;
223 do i = 0 to 1;
224 call ptw_util_$make_disk (addrel (ptp, i), (dumpadd + i));
225 end;
226 dumpadd = dumpadd + divide (dn355_size, pg_size, 18, 0);
227 do i = 2 to (max_pages - 1) while (i < next_part_add - dumpadd);
228 call ptw_util_$make_disk (addrel (ptp, i), (dumpadd + i));
229 end;
230 rest_size = min (max_size - hdr_size, length);
231 word_count = hdr_size + rest_size;
232 xname = ename;
233 call get_branch;
234 p -> copy = dumpptr -> copy;
235 length = length - rest_size;
236 end;
237 end;
238 else do;
239 substr (ename, 13) = ltrim (char (seqno)) || "." || ltrim (erf);
240 word_count = min (length, max_size);
241 xname = ename;
242 call get_branch;
243 p -> copy = dumpptr -> copy;
244 length = length - word_count;
245 end;
246 call pc$cleanup (astep);
247 aste.npfs = "0"b;
248 dumpadd = dumpadd + max_pages;
249 if ^dumping_Multics then go to endup;
250 if length <= 0 then go to cleanup;
251 end;
252
253 cleanup:
254 call ptw_util_$make_disk (ptp, first);
255 dumpptr -> dump.valid = "0"b;
256 call syserr (LOG, "copy_fdump: Copied fdump image of erf ^d (^a) for ^a",
257 dumpptr -> dump.erfno, dt, pds$process_group_id);
258
259 endup:
260 call pc$cleanup (astep);
261
262 exit:
263 call reversion_ ("any_other");
264 if p ^= null () then do;
265 call demand_deactivate$force_given_segno (p, code);
266 call terminate_$noname (p, code);
267 end;
268
269
270 call lock$lock_ast;
271 call put_aste (astep);
272 call lock$unlock_ast;
273 tsdw = ""b;
274 call privileged_mode_ut$swap_sdw (dumpptr, tsdwp);
275 return;
276
277 set_num:
278 call ptw_util_$make_disk (ptp, first);
279
280 if (dumpptr -> dump.valid | dumpptr -> dump.valid_355)
281 then do;
282 a_code = error_table_$dmpvalid;
283 go to endup;
284 end;
285
286 dumpptr -> dump.erfno = erf_no - 1;
287 go to endup;
288
289 get_num:
290 call ptw_util_$make_disk (ptp, first);
291
292 call check_dump_header;
293
294 if dumping_Multics then do;
295 a_length = length;
296 a_valid = dumping_Multics;
297 a_ename = ename;
298 end;
299 if dumping_dn355 then do;
300 a_valid_dn355 = dumping_dn355;
301 a_ename_dn355 = ename_dn355;
302 end;
303
304 go to endup;
305
306
307
308
309
310
311
312 check_dump_header: proc;
313 if esw ^= 1 then
314 if dumpptr -> dump.valid = "0"b then
315 if dumpptr -> dump.valid_355 = "0"b then do;
316 a_code = error_table_$dmpinvld;
317 go to endup;
318 end;
319 dumping_Multics = dumpptr -> dump.valid;
320 dumping_dn355 = dumpptr -> dump.valid_355;
321 length = dumpptr -> dump.words_dumped;
322
323
324
325
326
327
328
329 erf = cv_bin_$dec ((dumpptr -> dump.erfno));
330 if dumping_Multics then do;
331 call date_time_ (dumpptr -> dump.time, dt);
332 ename = substr (dt, 1, 2) || substr (dt, 4, 2) || substr (dt, 7, 2) || "."
333 || substr (dt, 11, 5) || "0." || ltrim (erf);
334 end;
335 if dumping_dn355 then do;
336 call date_time_ (dumpptr -> dump.time_355, dt_dn355);
337 ename_dn355 = substr (dt_dn355, 1, 2) || substr (dt_dn355, 4, 2) || substr (dt_dn355, 7, 2) || "."
338 || substr (dt_dn355, 11, 5) || "0." || ltrim (erf) || ".355";
339 end;
340 end check_dump_header;
341
342
343 get_branch: proc;
344 append:
345 if p ^= null () then do;
346 call demand_deactivate$force_given_segno (p, code);
347 call terminate_$noname (p, code);
348 end;
349
350 call append$branchx (">dumps", xname, RW_ACCESS_BIN, rb, (pds$process_group_id), 0, 0, 36 * word_count, code);
351 if code ^= 0 then do;
352 if code = error_table_$noaccess then do;
353 call append$branchx (">", "dumps", A_ACCESS_BIN, rb, "*.*.*", 1, 0, 0, code);
354 if code ^= 0 then do;
355 a_code = code;
356 go to endup;
357 end;
358 go to append;
359 end;
360 else do;
361 a_code = code;
362 go to endup;
363 end;
364 end;
365 call initiate (">dumps", xname, "", 0, 0, p, code);
366 if p = null then do;
367 a_code = code;
368 go to endup;
369 end;
370 end get_branch;
371
372
373
374
375 handler: proc (mc_ptr, name);
376
377 dcl mc_ptr ptr,
378 name char (*);
379
380
381 call syserr (ANNOUNCE, "copy_fdump: unexpected ^a signal.", name);
382 go to exit;
383 end handler;
384
385 %page; %include access_mode_values;
386 %page; %include aste;
387 %page; %include bos_dump;
388 %page; %include syserr_constants;
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428 end copy_fdump;