COMPILATION LISTING OF SEGMENT broadcaster_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1639.9 mst Thu Options: optimize map 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 /* */ 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 /* */ 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 /* */ 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 /* */ 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 /* */ 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; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1612.8 broadcaster_.pl1 >dumps>old>recomp>broadcaster_.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 88 ref 92 108 116 138 185 201 213 addrel builtin function dcl 88 ref 155 area_ptr 000010 internal static pointer initial dcl 32 set ref 91 91* bstatus 000114 automatic bit(72) dcl 32 set ref 189* 191 204* 205 216* 217 detach 1(15) based bit(1) level 2 packed unaligned dcl 49 set ref 96* 149* device_name_list 10 based pointer level 2 dcl 55 set ref 101* 115 116* 140 152* 186 202 214 dim_name based char(32) level 2 dcl 55 set ref 100* disposal parameter char unaligned dcl 135 ref 133 entry_size 000774 constant fixed bin(17,0) initial dcl 32 ref 155 error_code based fixed bin(17,0) level 2 dcl 49 set ref 97* 174* 191 205 217 error_table_$ioname_not_found 000014 external static fixed bin(17,0) dcl 81 ref 174 error_table_$no_room_for_dsb 000012 external static fixed bin(17,0) dcl 81 ref 97 get_system_free_area_ 000024 constant entry external dcl 83 ref 91 i 000102 automatic fixed bin(17,0) dcl 32 set ref 104* 105* 109* 111 112 113 114 114 115 116* 125* 126* 159* 159* 161 189* 190 index 13 based fixed bin(17,0) array level 3 in structure "sdbi" dcl 66 in procedure "broadcaster_$broadcast_attach" set ref 114* index 13 based fixed bin(17,0) level 2 in structure "ne" dcl 75 in procedure "broadcaster_$broadcast_attach" ref 155 ios_$abort 000020 constant entry external dcl 83 ref 204 ios_$resetwrite 000022 constant entry external dcl 83 ref 216 ios_$write 000016 constant entry external dcl 83 ref 189 last 110 based pointer level 2 in structure "sdb" dcl 55 in procedure "broadcaster_$broadcast_attach" set ref 103* last 76 based pointer level 2 in structure "sdbi" dcl 66 in procedure "broadcaster_$broadcast_attach" set ref 122* 158 162 163* 163 last_dev 000110 automatic pointer dcl 32 set ref 139* 145 153 170* mode parameter char unaligned dcl 32 ref 30 name 3 based char(32) array level 3 in structure "sdbi" dcl 66 in procedure "broadcaster_$broadcast_attach" set ref 113* name 3 based char(32) level 2 in structure "ne" dcl 75 in procedure "broadcaster_$broadcast_attach" set ref 143 189* 204* 216* name_list 12 based structure array level 2 in structure "sdb" dcl 55 in procedure "broadcaster_$broadcast_attach" set ref 108 name_list based structure array level 2 in structure "sdbi" dcl 66 in procedure "broadcaster_$broadcast_attach" set ref 116 name_size 14 based fixed bin(17,0) array level 3 in structure "sdb" dcl 55 in procedure "broadcaster_$broadcast_attach" set ref 105* name_size 2 based fixed bin(17,0) array level 3 in structure "sdbi" dcl 66 in procedure "broadcaster_$broadcast_attach" set ref 111 112* 126* 159 name_size 2 based fixed bin(17,0) level 2 in structure "ne" dcl 75 in procedure "broadcaster_$broadcast_attach" set ref 154* ne based structure level 1 dcl 75 nelem parameter fixed bin(17,0) dcl 179 set ref 177 187 189* nelemt parameter fixed bin(17,0) dcl 179 set ref 177 187* 190* 190 next 74 based pointer level 2 in structure "sdbi" dcl 66 in procedure "broadcaster_$broadcast_attach" set ref 120 121* 122 123 128* 130 162* 162 163 163 next 106 based pointer level 2 in structure "sdb" dcl 55 in procedure "broadcaster_$broadcast_attach" set ref 102* 146 146 next_dev 000112 automatic pointer dcl 32 set ref 140* 142 143 145 152 153 154 155 155 157* 157 170 171* 171 186* 188 189 192* 192 202* 203 204 206* 206 214* 215 216 218* 218 next_device based pointer array level 3 in structure "sdbi" dcl 66 in procedure "broadcaster_$broadcast_attach" set ref 115* next_device based pointer level 2 in structure "ne" dcl 75 in procedure "broadcaster_$broadcast_attach" set ref 145 152 153* 153 157 171 192 206 218 next_list 000104 automatic pointer dcl 32 set ref 108* 111 112 113 114 115 116 120 121 122 122 123* 123 124 126 128 130* 130 155* 158 159 162 162 163 163 163 165 null builtin function dcl 88 ref 91 93 95 101 102 103 120 124 128 139 142 145 145 146 158 163 188 203 215 object_stream parameter char unaligned dcl 32 ref 30 113 133 143 143 offset parameter fixed bin(17,0) dcl 179 set ref 177 189* old_status parameter bit(72) dcl 198 set ref 196 204* sdb based structure level 1 dcl 55 set ref 94 148 sdb_ptr parameter pointer dcl 32 set ref 30 93 94* 95 100 101 102 103 105 108 115 116 133 140 146 146 148 152 177 186 196 202 210 214 sdbi based structure level 1 dcl 66 set ref 121 146 165 sp 000100 automatic pointer dcl 32 set ref 92* 96 97 138* 149 174 185* 191 201* 205 213* 217 status parameter bit(72) dcl 32 set ref 30 90* 92 133 137* 138 177 184* 185 191* 196 200* 201 205* 210 212* 213 217* status_structure based structure level 1 dcl 49 stream parameter char unaligned dcl 32 ref 30 stream_found 000106 automatic bit(1) unaligned dcl 32 set ref 141* 144* 174 type parameter char unaligned dcl 32 ref 30 workspace parameter pointer dcl 179 set ref 177 189* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. space based area(1024) dcl 32 NAMES DECLARED BY EXPLICIT CONTEXT. alloc_err 000117 constant label dcl 97 ref 124 broadcast_abort 000622 constant entry external dcl 196 broadcast_detach 000266 constant entry external dcl 133 broadcast_resetwrite 000713 constant entry external dcl 210 broadcast_write 000505 constant entry external dcl 177 broadcaster_$broadcast_attach 000023 constant entry external dcl 30 try_again 000154 constant label dcl 109 ref 131 NAME DECLARED BY CONTEXT OR IMPLICATION. min builtin function ref 190 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1160 1206 775 1170 Length 1372 775 26 150 162 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME broadcaster_$broadcast_attach 122 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 area_ptr broadcaster_$broadcast_attach STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME broadcaster_$broadcast_attach 000100 sp broadcaster_$broadcast_attach 000102 i broadcaster_$broadcast_attach 000104 next_list broadcaster_$broadcast_attach 000106 stream_found broadcaster_$broadcast_attach 000110 last_dev broadcaster_$broadcast_attach 000112 next_dev broadcaster_$broadcast_attach 000114 bstatus broadcaster_$broadcast_attach THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry ext_entry_desc alloc_based_storage free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. get_system_free_area_ ios_$abort ios_$resetwrite ios_$write THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$ioname_not_found error_table_$no_room_for_dsb LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 30 000015 90 000061 91 000064 92 000076 93 000100 94 000104 95 000110 96 000114 97 000117 98 000122 100 000123 101 000126 102 000130 103 000133 104 000136 105 000143 106 000146 108 000150 109 000154 111 000161 112 000166 113 000171 114 000202 115 000204 116 000210 117 000214 119 000215 120 000217 121 000224 122 000231 123 000232 124 000234 125 000240 126 000245 127 000250 128 000252 129 000255 130 000256 131 000260 133 000261 137 000312 138 000316 139 000320 140 000322 141 000326 142 000327 143 000333 144 000352 145 000354 146 000364 148 000374 149 000376 150 000401 152 000402 153 000410 154 000413 155 000415 157 000422 158 000424 159 000430 160 000441 161 000443 162 000446 163 000453 165 000462 168 000464 170 000465 171 000466 173 000470 174 000471 175 000476 177 000477 184 000517 185 000523 186 000525 187 000531 188 000534 189 000540 190 000575 191 000603 192 000611 193 000614 194 000615 196 000616 200 000634 201 000640 202 000642 203 000646 204 000652 205 000674 206 000702 207 000705 208 000706 210 000707 212 000725 213 000731 214 000733 215 000737 216 000743 217 000761 218 000767 219 000772 220 000773 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved