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 broadcaster_$broadcast_attach: proc(stream,type,object_stream,mode,status,sdb_ptr);
31
32 dcl stream char(*),
33 type char(*),
34 object_stream char(*),
35 mode char(*),
36 status bit(72) aligned,
37 sdb_ptr ptr,
38 sp ptr,
39 i fixed bin,
40 next_list ptr,
41 stream_found bit(1),
42 last_dev ptr,
43 next_dev ptr,
44 entry_size fixed bin internal static init(-12),
45 area_ptr ptr internal static init(null),
46 space area based(area_ptr),
47 bstatus bit(72) aligned;
48
49 dcl 1 status_structure aligned based(sp),
50 2 error_code fixed bin,
51 2 pad1 bit(15) unaligned,
52 2 detach bit(1) unaligned,
53 2 pad2 bit(20) unaligned;
54
55 dcl 1 sdb aligned based(sdb_ptr),
56 2 dim_name char(32),
57 2 device_name_list ptr,
58 2 name_list(5) aligned,
59 3 next_device ptr,
60 3 name_size fixed bin,
61 3 name char(32),
62 3 index fixed bin,
63 2 next ptr,
64 2 last ptr;
65
66 dcl 1 sdbi aligned based(next_list),
67 2 name_list(5) aligned,
68 3 next_device ptr,
69 3 name_size fixed bin,
70 3 name char(32),
71 3 index fixed bin,
72 2 next ptr,
73 2 last ptr;
74
75 dcl 1 ne aligned based(next_dev),
76 2 next_device ptr,
77 2 name_size fixed bin,
78 2 name char(32),
79 2 index fixed bin;
80
81 dcl (error_table_$no_room_for_dsb,error_table_$ioname_not_found) ext fixed bin;
82
83 dcl ios_$write ext entry(char(*) aligned,ptr,fixed bin,fixed bin,fixed bin,bit(72) aligned),
84 ios_$abort ext entry(char(*) aligned,bit(72) aligned,bit(72) aligned),
85 ios_$resetwrite ext entry(char(*) aligned,bit(72) aligned),
86 get_system_free_area_ entry () returns (ptr);
87
88 dcl (addr,null,addrel) builtin;
89
90 status = "0"b;
91 if area_ptr = null then area_ptr = get_system_free_area_ ();
92 sp = addr(status);
93 if sdb_ptr = null then do;
94 allocate sdb set(sdb_ptr);
95 if sdb_ptr = null then do;
96 sp->status_structure.detach = "1"b;
97 alloc_err: sp->status_structure.error_code = error_table_$no_room_for_dsb;
98 return;
99 end;
100 sdb.dim_name = "broadcast_";
101 sdb.device_name_list = null;
102 sdb.next = null;
103 sdb.last = null;
104 do i = 1 to 5;
105 sdb.name_list(i).name_size = 0;
106 end;
107 end;
108 next_list = addr(sdb.name_list(1));
109 try_again:
110 do i = 1 to 5;
111 if sdbi.name_list(i).name_size = 0 then do;
112 sdbi.name_list(i).name_size = 32;
113 sdbi.name_list(i).name = object_stream;
114 sdbi.name_list(i).index = i;
115 sdbi.name_list(i).next_device = sdb.device_name_list;
116 sdb.device_name_list = addr(sdbi.name_list(i));
117 return;
118 end;
119 end;
120 if sdbi.next = null then do;
121 allocate sdbi set(sdbi.next);
122 sdbi.next->sdbi.last = next_list;
123 next_list = sdbi.next;
124 if next_list = null then go to alloc_err;
125 do i = 1 to 5;
126 sdbi.name_list(i).name_size = 0;
127 end;
128 sdbi.next = null;
129 end;
130 else next_list = sdbi.next;
131 go to try_again;
132
133 broadcast_detach: entry(sdb_ptr,object_stream,disposal,status);
134
135 dcl disposal char(*);
136
137 status = "0"b;
138 sp = addr(status);
139 last_dev = null;
140 next_dev = sdb.device_name_list;
141 stream_found = "0"b;
142 do while(next_dev ^= null);
143 if (object_stream = "") | (object_stream = ne.name) then do;
144 stream_found = "1"b;
145 if last_dev = null then if ne.next_device = null then do;
146 if sdb.next ^= null then free sdb.next->sdbi;
147
148 free sdb;
149 sp->status_structure.detach = "1"b;
150 return;
151 end;
152 else sdb.device_name_list = ne.next_device;
153 else last_dev->ne.next_device = ne.next_device;
154 ne.name_size = 0;
155 next_list = addrel(next_dev,ne.index*entry_size);
156
157 next_dev = ne.next_device;
158 if sdbi.last ^= null then do;
159 do i = 1 to 5 while(sdbi.name_list(i).name_size = 0);
160 end;
161 if i = 6 then do;
162 sdbi.last->sdbi.next = sdbi.next;
163 if sdbi.next ^= null then sdbi.next->sdbi.last = sdbi.last;
164
165 free sdbi;
166 end;
167 end;
168 end;
169 else do;
170 last_dev = next_dev;
171 next_dev = ne.next_device;
172 end;
173 end;
174 if ^stream_found then sp->status_structure.error_code = error_table_$ioname_not_found;
175 return;
176
177 broadcast_write: entry(sdb_ptr,workspace,offset,nelem,nelemt,status);
178
179 dcl workspace ptr,
180 offset fixed bin,
181 nelem fixed bin,
182 nelemt fixed bin;
183
184 status = "0"b;
185 sp = addr(status);
186 next_dev = sdb.device_name_list;
187 nelemt = nelem;
188 do while(next_dev ^= null);
189 call ios_$write(ne.name,workspace,offset,nelem,i,bstatus);
190 nelemt = min(nelemt,i);
191 if sp->status_structure.error_code = 0 then status = bstatus;
192 next_dev = ne.next_device;
193 end;
194 return;
195
196 broadcast_abort: entry(sdb_ptr,old_status,status);
197
198 dcl old_status bit(72) aligned;
199
200 status = "0"b;
201 sp = addr(status);
202 next_dev = sdb.device_name_list;
203 do while(next_dev ^= null);
204 call ios_$abort(ne.name,old_status,bstatus);
205 if sp->status_structure.error_code = 0 then status = bstatus;
206 next_dev = ne.next_device;
207 end;
208 return;
209
210 broadcast_resetwrite: entry(sdb_ptr,status);
211
212 status = "0"b;
213 sp = addr(status);
214 next_dev = sdb.device_name_list;
215 do while(next_dev ^= null);
216 call ios_$resetwrite(ne.name,bstatus);
217 if sp->status_structure.error_code = 0 then status = bstatus;
218 next_dev = ne.next_device;
219 end;
220 return;
221 end;