1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
 10 
 11 ioi_device:
 12      procedure;
 13 
 14 /* Written May 1982 by C. Hornig for new ioi_ */
 15 /* Finished March 1983 by Chris Jones */
 16 /* Modified April 1984 by Chris Jones to fix bug when unlocking after a dead process. */
 17 
 18 /****^  HISTORY COMMENTS:
 19   1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
 20      audit(85-11-26,CLJones), install(86-03-21,MR12.0-1033):
 21      Add support for FIPS.
 22   2) change(86-02-03,Farley), approve(86-07-18,MCR7439),
 23      audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
 24      Changed to execute in the BCE environment.
 25   3) change(86-11-18,Farley), approve(86-11-20,MECR0002),
 26      audit(86-11-19,Fawcett), install(86-11-20,MR12.0-1222):
 27      Corrected a race condition with the setting of dte.lock by validating that
 28      the device is still assigned to the process AFTER getting the lock. (e.g.
 29      the Initializer had the lock as part of doing a force unassignment of the
 30      device and now the device table entry is initialized.)
 31   4) change(86-12-19,Farley), approve(86-12-19,MCR7587),
 32      audit(86-12-19,Fawcett), install(87-01-05,MR12.0-1253):
 33      Formal installation to close out above MECR0002.
 34                                                    END HISTORY COMMENTS */
 35 
 36 dcl       p_code                 fixed bin (35) parameter;
 37 dcl       p_device               bit (6) aligned parameter;
 38 dcl       p_controller           bit (1) aligned parameter;
 39 dcl       p_devx                 fixed bin parameter;
 40 dcl       p_dtep                 ptr parameter;
 41 dcl       p_gtep                 ptr parameter;
 42 
 43 dcl       code                   fixed bin (35);
 44 dcl       device                 bit (6) aligned;
 45 dcl       controller             bit (1) aligned;
 46 dcl       devx                   fixed bin;
 47 dcl       force_flag             bit (1) aligned;
 48 dcl       test_processid         bit (36) aligned;
 49 
 50 dcl       ioi_assignment$unassign
 51                                  entry (fixed bin, fixed bin (35));
 52 dcl       lock$lock_fast         entry (ptr);
 53 dcl       lock$unlock_fast       entry (ptr);
 54 dcl       tc_util$validate_processid
 55                                  entry (bit (36) aligned, fixed bin (35));
 56 
 57 dcl       error_table_$already_assigned
 58                                  fixed bin (35) ext static;
 59 dcl       error_table_$bad_index fixed bin (35) ext static;
 60 dcl       error_table_$bad_ring_brackets
 61                                  fixed bin (35) ext static;
 62 dcl       error_table_$dev_nt_assnd
 63                                  fixed bin (35) ext static;
 64 dcl       error_table_$invalid_device
 65                                  fixed bin (35) ext static;
 66 dcl       error_table_$process_unknown
 67                                  fixed bin (35) ext static;
 68 
 69 dcl       pds$process_id         bit (36) aligned external;
 70 dcl       pds$validation_level   fixed bin (3) external;
 71 
 72 dcl       sys_info$service_system
 73                                  bit (1) aligned external static;
 74 
 75 dcl       (addr, hbound, lbound, null, ptr, rel, stac, stacq)
 76                                  builtin;
 77 ^L
 78 /* * * * * * * * * * GET_DTEP * * * * * * * * * */
 79 
 80 get_dtep:
 81      entry (p_devx, p_dtep, p_code);
 82 
 83           force_flag = "0"b;
 84           goto get_dtep_join;
 85 
 86 get_dtep_force:
 87      entry (p_devx, p_dtep, p_code);
 88 
 89           force_flag = "1"b;
 90 get_dtep_join:
 91           devx = p_devx;
 92           p_dtep = null ();
 93           p_code = 0;
 94 
 95           idp = addr (ioi_data$);
 96           if (devx < lbound (ioi_data.dt, 1)) | (devx > hbound (ioi_data.dt, 1)) then do;
 97                p_code = error_table_$bad_index;
 98                return;
 99           end;
100 
101           dtep, p_dtep = addr (ioi_data.dt (devx));
102 
103           if ^force_flag & (dte.process_id ^= pds$process_id) then do;
104                p_code = error_table_$dev_nt_assnd;
105                return;
106           end;
107 
108           if ^force_flag & (dte.ring < pds$validation_level) then do;
109                p_code = error_table_$bad_ring_brackets;
110                return;
111           end;
112 
113           if sys_info$service_system then do;
114                call lock$lock_fast (addr (dte.lock));
115                if ^force_flag & (dte.process_id ^= pds$process_id) then do;
116                     p_code = error_table_$dev_nt_assnd;     /* lost the race */
117                     call lock$unlock_fast (addr (dte.lock));
118                     return;
119                end;
120           end;
121           return;
122 
123 /* * * * * * * * * * UNLOCK * * * * * * * * * */
124 
125 unlock:
126      entry (p_dtep);
127 
128           dtep = p_dtep;
129           if sys_info$service_system then
130                call lock$unlock_fast (addr (dte.lock));
131           return;
132 ^L
133 /* * * * * * * * * * ASSIGN * * * * * * * * * */
134 
135 assign:
136      entry (p_gtep, p_device, p_controller, p_devx, p_code);
137 
138           gtep = p_gtep;
139           device = p_device;
140           controller = p_controller;
141           idp = addr (ioi_data$);
142           call find_dte;
143           if dtep = null () then do;
144                p_code = error_table_$invalid_device;
145                return;
146           end;
147 
148 /**** We now try to get control of this device by placing our process_id (PID) in the dte.  If the PID is zero,
149       no one else has the device and we will be successful.  If the PID in the dte is non-zero, we check to
150       see if the process which controls the device is still alive.  If it is, we give up; the device is under the
151       control of that process.  If the PID in the dte is for a non-existant process, we slam our PID on top
152       of it.  We use gating instructions (stac and stacq) for all of this since another process on another
153       processor may be trying to do the same thing. ****/
154 
155           if ^sys_info$service_system then
156                dte.process_id = pds$process_id;             /* If not UP force setting */
157           else do while (^stac (addr (dte.process_id), pds$process_id));
158                test_processid = dte.process_id;
159                call tc_util$validate_processid (test_processid, code);
160                if code ^= error_table_$process_unknown then do;
161                     p_code = error_table_$already_assigned;
162                     return;
163                end;
164                if stacq (dte.process_id, pds$process_id, test_processid) then do;
165                                                             /* grab the device */
166                     call ioi_assignment$unassign (devx, code);
167                     if code ^= 0 then do;
168                          dte.process_id = ""b;              /* could use stacq, but what if it fails? */
169                          p_code = code;
170                          return;
171                     end;
172                end;
173           end;
174 
175           dte.ring = pds$validation_level;
176           p_devx = devx;
177           p_code = 0;
178           return;
179 
180 /* * * * * * * * * * UNASSIGN * * * * * * * * * */
181 
182 unassign:
183      entry (p_dtep);
184 
185           dtep = p_dtep;
186           gtep = ptr (dtep, dte.gtep);
187           dte.process_id = ""b;                             /* all necessary validation has already been done */
188           return;
189 ^L
190 find_dte:
191      proc;
192 
193           do devx = 1 to ioi_data.ndt;
194                dtep = addr (ioi_data.dt (devx));
195                if dte.in_use & (rel (gtep) = dte.gtep) & (dte.device = device) & (dte.controller = controller) then
196                     return;
197           end;
198           dtep = null ();                                   /* couldn't find it */
199           return;
200 
201      end find_dte;
202 ^L
203 %include ioi_data;
204 
205      end ioi_device;