1
2
3
4
5
6
7
8
9
10
11
12
13 salv_dump_copy: proc (a_block_p, a_block_len, a_name);
14
15
16
17
18
19
20
21
22
23
24 dcl a_block_p ptr parameter;
25 dcl a_block_len fixed bin parameter;
26 dcl a_name char (*) parameter;
27
28 dcl block_p pointer;
29 dcl block_len fixed bin;
30 dcl name char (32);
31 dcl rings (3) fixed bin (3);
32 dcl seg_p ptr;
33 dcl code fixed bin (35);
34 dcl copy (block_len) bit (36) aligned based;
35
36 dcl 1 del_acl aligned,
37 2 user char (32),
38 2 err_code fixed bin (35);
39
40 dcl pds$process_group_id char (32) external static;
41
42 dcl append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*),
43 fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35));
44 dcl asd_$del_sentries entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
45 dcl delentry$dseg entry (pointer, fixed bin (35));
46 dcl initiate$priv_init entry (char (*) aligned, char (*) aligned, char (*) aligned,
47 fixed bin (1), fixed bin (2), ptr, fixed bin (35));
48 dcl syserr entry options (variable);
49 dcl syserr$error_code entry options (variable);
50
51 dcl WHOAMI char (32) internal static options (constant) init ("salv_dump_copy");
52
53 dcl seg_fault_error condition;
54
55 dcl (addr, null, ptr) builtin;
56
57
58
59 block_p = a_block_p;
60 block_len = a_block_len;
61 name = a_name;
62
63 rings (*) = 7;
64 call append$branchx (">dumps", name, RW_ACCESS_BIN, rings, pds$process_group_id, 0, 0, 36 * block_len, code);
65 if code ^= 0 then do;
66 call syserr$error_code (LOG, code, "^a: Appending ^a to dump directory.", WHOAMI, name);
67 return;
68 end;
69
70 call initiate$priv_init (">dumps", (name), "", 0, 0, seg_p, code);
71 if seg_p = null then do;
72 call syserr$error_code (LOG, code, "^a: Intiating ^a.", WHOAMI, name);
73 return;
74 end;
75
76 on condition (seg_fault_error) begin;
77 call syserr (LOG, "^a: seg_fault_error copying ^p into >dumps>^a", WHOAMI, block_p, name);
78 call delentry$dseg (seg_p, (0));
79 goto DUMP_FINISHED;
80 end;
81
82 seg_p -> copy = block_p -> copy;
83
84 del_acl.user = pds$process_group_id;
85 call asd_$del_sentries (">dumps", name, addr (del_acl), 1, (0));
86
87 DUMP_FINISHED:
88 return;
89
90 %page; %include syserr_constants;
91 %page; %include access_mode_values;
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139 end salv_dump_copy;