1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /*        This DIM serves to allow I/O operations to fan out. A single
 12           stream may be attached to several streams by the braodcast
 13           module.
 14 
 15           Originally coded by R. J. Feiertag on June 10,1971.
 16 
 17           declare ios_$attach ext entry(char(*),char(*),char(*),char(*),bit(72) aligned);
 18           call ios_$attach(stream,"broadcast_",object_stream1,"",status);
 19           call ios_$attach(stream,"broadcast_",object_stream2,"",status);
 20                                                   .
 21                                                   .
 22                                                   .
 23                                                   .
 24           call ios_$attach(stream,"broadcast_",object_streamn,"",status);
 25 
 26           All the object streams will be attached to stream and all I/O calls
 27            on stream will result in identical calls to all the object streams.
 28 */
 29 
 30 broadcaster_$broadcast_attach: proc(stream,type,object_stream,mode,status,sdb_ptr);
 31 
 32           dcl stream char(*), /* stream being attached to */
 33               type char(*), /* name of broadcaster */
 34               object_stream char(*), /* stream being attached */
 35               mode char(*), /* mode of attachment */
 36               status bit(72) aligned, /* status of call */
 37               sdb_ptr ptr, /* pointer to sdb */
 38               sp ptr, /* points to status */
 39               i fixed bin, /* index */
 40               next_list ptr, /* points to block of sdb entries */
 41               stream_found bit(1), /* indicates a stream has been found */
 42               last_dev ptr, /* points to previous device name entry */
 43               next_dev ptr, /* points to current device name entry */
 44               entry_size fixed bin internal static init(-12),
 45               area_ptr ptr internal static init(null), /* pointer to area for allocation */
 46               space area based(area_ptr), /* area for allocation */
 47               bstatus bit(72) aligned; /* status for call outs */
 48 
 49           dcl 1 status_structure aligned based(sp), /* structure of status string */
 50                     2 error_code fixed bin, /* error code */
 51                     2 pad1 bit(15) unaligned,
 52                     2 detach bit(1) unaligned, /* indicates if stream is to be detached */
 53                     2 pad2 bit(20) unaligned;
 54 
 55           dcl 1 sdb aligned based(sdb_ptr), /* stream data block */
 56                     2 dim_name char(32), /* name of this dim */
 57                     2 device_name_list ptr, /* points to threaded list of device names */
 58                     2 name_list(5) aligned, /* array of device name entries */
 59                          3 next_device ptr, /* points to next device name entry */
 60                          3 name_size fixed bin, /* number of chars in device name */
 61                          3 name char(32), /* name of device */
 62                          3 index fixed bin, /* index in block of entries */
 63                     2 next ptr, /* points to next block of entries */
 64                     2 last ptr; /* points to last block of entries */
 65 
 66           dcl 1 sdbi aligned based(next_list), /* a block of device name entries */
 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), /* a device name entry */
 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; /* error codes */
 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 /*^L*/
 90           status = "0"b;
 91           if area_ptr = null then area_ptr = get_system_free_area_ (); /* get pointer to area */
 92           sp = addr(status); /* get pointer to status */
 93           if sdb_ptr = null then do; /* new stream */
 94                     allocate sdb set(sdb_ptr); /* create an sdb */
 95                     if sdb_ptr = null then do; /* could not allocate sdb */
 96                               sp->status_structure.detach = "1"b; /* stream not attached */
 97 alloc_err:                    sp->status_structure.error_code = error_table_$no_room_for_dsb;
 98                               return;
 99                               end;
100                     sdb.dim_name = "broadcast_"; /* initialize sdb */
101                     sdb.device_name_list = null;
102                     sdb.next = null;
103                     sdb.last = null;
104                     do i = 1 to 5; /* initialize device name entries */
105                               sdb.name_list(i).name_size = 0; /* indicates entry is empty */
106                               end;
107                     end;
108           next_list = addr(sdb.name_list(1)); /* get first block of entries */
109 try_again:
110           do i = 1 to 5; /* look at each entry in block */
111                     if sdbi.name_list(i).name_size = 0 then do; /* have found empty entry */
112                               sdbi.name_list(i).name_size = 32; /* fill in entry */
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; /* thread in entry */
116                               sdb.device_name_list = addr(sdbi.name_list(i));
117                               return;
118                               end;
119                     end;
120           if sdbi.next = null then do; /* there are no free entries, so create some */
121                     allocate sdbi set(sdbi.next); /* create a new block of entries */
122                     sdbi.next->sdbi.last = next_list; /* back thread this entry */
123                     next_list = sdbi.next; /* go to this new entry */
124                     if next_list = null then go to alloc_err; /* cannot allocate more entries */
125                     do i = 1 to 5; /* initialize new entries */
126                               sdbi.name_list(i).name_size = 0;
127                               end;
128                     sdbi.next = null; /* this is last block */
129                     end;
130            else next_list = sdbi.next; /* get next block */
131           go to try_again; /* look through the new block */
132 /*^L*/
133 broadcast_detach: entry(sdb_ptr,object_stream,disposal,status);
134 
135           dcl disposal char(*); /* special action to be taken */
136 
137           status = "0"b;
138           sp = addr(status); /* get pointer to status */
139           last_dev = null; /* no previous device yet */
140           next_dev = sdb.device_name_list; /* start at first entry */
141           stream_found = "0"b; /* no entry found yet */
142           do while(next_dev ^= null); /* look through all entries */
143                     if (object_stream = "") | (object_stream = ne.name) then do; /* have found stream */
144                               stream_found = "1"b; /* remember stream is found */
145                               if last_dev = null then if ne.next_device = null then do; /* this is only entry */
146                                         if sdb.next ^= null then free sdb.next->sdbi;
147                                                   /* free extra block if one exists */
148                                         free sdb; /* free sdb */
149                                         sp->status_structure.detach = "1"b; /* detach the stream */
150                                         return;
151                                         end;
152                                else sdb.device_name_list = ne.next_device; /* new first entry */
153                                else last_dev->ne.next_device = ne.next_device; /* thread out entry */
154                               ne.name_size = 0; /* indicate entry is free */
155                               next_list = addrel(next_dev,ne.index*entry_size); /* get pointer to beginning
156                                                                                           of block */
157                               next_dev = ne.next_device; /* move to next device */
158                               if sdbi.last ^= null then do; /* if not sdb itself the try to free */
159                                         do i = 1 to 5 while(sdbi.name_list(i).name_size = 0);
160                                                   end; /* find first non-free entry */
161                                         if i = 6 then do; /* all entries in block are free */
162                                                   sdbi.last->sdbi.next = sdbi.next; /* unthread forward list */
163                                                   if sdbi.next ^= null then sdbi.next->sdbi.last = sdbi.last;
164                                                             /* unthread from backward list */
165                                                   free sdbi;
166                                                   end;
167                                         end;
168                               end;
169                     else do; /* entry not correct one */
170                               last_dev = next_dev; /* move to next entry */
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; /* stream not found */
175           return;
176 /*^L*/
177 broadcast_write: entry(sdb_ptr,workspace,offset,nelem,nelemt,status);
178 
179           dcl workspace ptr, /* points to caller's buffer area */
180               offset fixed bin, /* offset at which to begin writing from */
181               nelem fixed bin, /* number of elements to write */
182               nelemt fixed bin; /* number of elements written */
183 
184           status = "0"b;
185           sp = addr(status); /* get pointer to status */
186           next_dev = sdb.device_name_list; /* get pointer to first entry */
187           nelemt = nelem; /* maximum possible number of elements written */
188           do while(next_dev ^= null); /* do a write for each entry */
189                     call ios_$write(ne.name,workspace,offset,nelem,i,bstatus); /* write on this stream */
190                     nelemt = min(nelemt,i); /* return minimum elements written */
191                     if sp->status_structure.error_code = 0 then status = bstatus; /* return status */
192                     next_dev = ne.next_device; /* go to next stream */
193                     end;
194           return;
195 /*^L*/
196 broadcast_abort:    entry(sdb_ptr,old_status,status);
197 
198           dcl old_status bit(72) aligned; /* status from previous transaction */
199 
200           status = "0"b;
201           sp = addr(status);
202           next_dev = sdb.device_name_list; /* get pointer to list of stream names */
203           do while(next_dev ^= null); /* make one call for each stream */
204                     call ios_$abort(ne.name,old_status,bstatus); /* abort this stream */
205                     if sp->status_structure.error_code = 0 then status = bstatus; /* return bad status */
206                     next_dev = ne.next_device; /* go to next stream */
207                     end;
208           return;
209 /*^L*/
210 broadcast_resetwrite:         entry(sdb_ptr,status);
211 
212           status = "0"b;
213           sp = addr(status);
214           next_dev = sdb.device_name_list; /* get pointer to list of stream names */
215           do while(next_dev ^= null); /* make one call for each stream */
216                     call ios_$resetwrite(ne.name,bstatus);
217                     if sp->status_structure.error_code = 0 then status = bstatus; /* return status */
218                     next_dev = ne.next_device; /* go to next stream */
219                     end;
220           return;
221           end;