1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Information Systems Inc., 1987 *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Bull Inc., 1987                *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 bft_:
 10      proc ();
 11 
 12 /* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,^indprocbody,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
 13 
 14 /* PROGRAM FUNCTION
 15 
 16 This is the file that holds all of the Multics entrypoints.  These entrypoints
 17 do nothing more than place the supplied arguments into a structure of the type
 18 defined in bft_values.incl.pl1.  This is done so that only a pointer must be
 19 passed between the two programs (this one and the bft_main_.pl1 program, which
 20 holds all of the code for the minor capabilities).  This will only work because
 21 these calls are guaranteed to be local (ie.  on Multics).  Once all of the
 22 necessary information is written into the structure, the pointer to the
 23 structure is converted to char and then passed to the minor capability as a
 24 character string, and it us decoded back to a pointer there.  On return , each
 25 entrypoint reassigns the passed error code to its parameter error_code so the
 26 calling routine may use the information.
 27 */
 28 
 29 /* NOTES
 30 */
 31 
 32 /****^  HISTORY COMMENTS:
 33   1) change(86-07-22,Eichele), approve(87-07-15,MCR7580),
 34      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
 35      Created.
 36   2) change(87-10-23,Flegel), approve(87-10-23,MCR7787),
 37      audit(88-01-27,RWaters), install(88-02-24,MR12.2-1028):
 38      Changed to work with multiple entries for queueing as well as adding a few
 39      new control arguments.
 40                                                    END HISTORY COMMENTS */
 41 
 42 /* PARAMETERS */
 43 dcl p_id_sw                fixed bin parameter;       /* Request ID type */
 44 dcl p_id                   char (*) parameter;        /* Request ID */
 45 dcl p_priority             fixed bin parameter;       /* Transfer priority */
 46 dcl p_flags                bit (36) aligned parameter;  /* Transfer flags */
 47 dcl p_arg_len              fixed bin parameter;
 48 dcl p_arg_ptr              ptr parameter;
 49 dcl p_data_block_ptr       ptr parameter;
 50 dcl p_destination_filename char (*) var parameter;
 51 dcl p_major_sender         fixed bin parameter;
 52 dcl p_mcb_ptr              ptr parameter;
 53 dcl p_minor_cap_no         fixed bin parameter;
 54 dcl p_source_filename      char (*) var parameter;
 55 dcl p_code                 fixed bin (35) parameter;
 56 
 57 /* MISC VARIABLES */
 58 dcl dir_name               char (168);                /* Pathname */
 59 dcl message                char (256);
 60 dcl bft_major              fixed bin;
 61 dcl bft_mcb                ptr;
 62 dcl bft_struct_ptr         ptr;
 63 dcl code                   fixed bin (35);
 64 dcl command_id             fixed bin;
 65 dcl major_num              fixed bin;
 66 
 67 /* STRUCTURES */
 68 dcl 01 bft_struct          like bft_values_struct based (bft_struct_ptr);
 69 
 70 /* SYSTEM CALLS */
 71 dcl absolute_pathname_      entry (char(*), char(*), fixed bin(35));
 72 
 73 /* SYSTEM CALL SUPPORT */
 74 
 75 /* EXTERNAL CALLS */
 76 
 77 /* EXTERNAL CALL SUPPORT */
 78 dcl bft_error_table_$invalid_request_type  fixed bin(35) ext static;
 79 dcl bft_error_table_$unexpected_minor_capability fixed bin (35) ext static;
 80 
 81 /* BUILTINS */
 82 dcl byte                   builtin;
 83 dcl null                   builtin;
 84 dcl addr                   builtin;
 85 dcl length                 builtin;
 86 dcl rtrim                  builtin;
 87 
 88 /* CONDITIONS */
 89 dcl cleanup                condition;
 90 
 91 /* CONSTANTS */
 92 
 93 /*^L*/
 94 
 95 /* INITIALIZATION */
 96 
 97 /* MAIN */
 98 
 99      return;
100 
101 /*^L*/
102 
103 /* INTERNAL ENTRIES */
104 
105 
106 /* *** Entry: cancel - Internal entry for bft_  *** */
107 
108 cancel:
109      entry (p_id_sw, p_id, p_code);
110 
111 
112 /* ENTRY FUNCTION
113 
114 Remove the specified request from the bft queues.
115 */
116 
117 /* NOTES
118 */
119 
120      p_code = 0;
121 
122 /* Fill out the message: ID_SW;ID; */
123 
124 
125      if p_id_sw = BFT_TIME_ID | p_id_sw = BFT_PATH_ID | p_id_sw = BFT_ENTRY_ID then
126           message = byte (p_id_sw) || DELIM_CHAR;
127      else do;
128           p_code = bft_error_table_$invalid_request_type;
129           return;
130      end;
131 
132      if p_id_sw = BFT_PATH_ID then do;
133           call absolute_pathname_ (p_id, dir_name, p_code);
134           if p_code ^= 0 then
135                return;
136           message = rtrim (message) || rtrim (dir_name) || DELIM_CHAR;
137      end;
138      else
139           message = rtrim (message) || rtrim (p_id) || DELIM_CHAR;
140 
141 /* Execute bft_minor_$add_to_fetch_queue */
142 
143      bft_major = 0;
144      call ws_$find_capability_number ("bft_main_", LOCAL_SYSTEM, bft_major,
145           p_code);
146      if p_code ^= 0 then
147           return;
148 
149      call ws_$create_instance ("bft_", "process_event", BFT_INBUFFER_SIZE,
150           BFT_OUTBUFFER_SIZE, null, bft_mcb, p_code);
151      if p_code ^= 0 then
152           return;
153 
154      call ws_$execute_capability (bft_major, bft_minor_$cancel_request,
155           addr (message), length (rtrim (message)), bft_mcb, p_code);
156      call ws_$destroy_instance (bft_mcb, (0));
157 
158      return;
159 
160 /*^L*/
161 
162 /* *** Entry: process_event - Internal entry fo bft_ *** */
163 
164 process_event:
165      entry (p_minor_cap_no, p_major_sender, p_arg_ptr, p_arg_len, p_mcb_ptr,
166           p_data_block_ptr);
167 
168 /* ENTRY FUNCTION
169 
170 This is the point where MOWSE will begin necessary execution.  There are no
171 minor capabilities defined other than those required by MOWSE.
172 */
173 
174 /* NOTES
175 */
176 
177      bft_mcb = p_mcb_ptr;
178      if (p_minor_cap_no > MAXIMUM_SYSTEM_MINOR) | (p_minor_cap_no < MINIMUM_SYSTEM_MINOR) then do;
179           code = bft_error_table_$unexpected_minor_capability;
180           return;
181      end;
182 
183      if p_minor_cap_no ^= EXECUTE_COMMAND_REPLY then
184           call minor_error (p_minor_cap_no);
185 
186      major_num = 0;
187      code = 0;
188      call ws_$find_capability_number ("bft_main_", LOCAL_SYSTEM, major_num, code);
189      if code ^= 0 then
190           call ws_$put_background_message (bft_mcb, 0, "bft_ ", "Error in loading BFT.");
191 
192      code = 0;
193      call ws_$destroy_instance (bft_mcb, code);
194      if code ^= 0 then do;
195           call ws_$put_background_message (bft_mcb, 0, "bft_ ",
196                "BFT_ failed to properly destroy itself.");
197           return;
198      end;
199 
200      return;
201 
202 /*^L*/
203 
204 /* *** Entry: fetch - Internal entry for bft_ *** */
205 
206 fetch:
207      entry (p_source_filename, p_destination_filename, p_flags, p_priority,
208           p_code);
209 
210 /* ENTRY FUNCTION
211 
212 This entrypoint assembles the arguments and makes the proper call to
213 bft_minor_$add_to_fetch_queue.
214 */
215 
216 /* NOTES
217 */
218 
219      call add_to_queue (p_destination_filename, p_source_filename, p_flags,
220           p_priority, bft_minor_$add_to_fetch_queue, p_code);
221 
222      return;
223 
224 /*^L*/
225 
226 /* *** Entry: load - Internal entry for bft_ *** */
227 
228 load:
229      entry (p_code);
230 
231 /* ENTRY FUNCTION
232 
233 This entrypoint assembles the arguments and makes the proper call to bft_minor_
234 (main entrypoint).
235 */
236 
237 /* NOTES
238 */
239 
240 /* Allocate a structure where the arguments will be placed */
241 
242      on cleanup call clean_up ();
243 
244      call ws_$create_instance ("bft_", "process_event", BFT_INBUFFER_SIZE,
245           BFT_OUTBUFFER_SIZE, null, bft_mcb, p_code);
246      if p_code ^= 0 then
247           return;
248 
249      call ws_$execute_command ("bft_main_", LOCAL_SYSTEM, command_id,
250           bft_mcb, p_code);
251 
252      call ws_$destroy_instance (bft_mcb, (0));
253 
254      return;
255 
256 /*^L*/
257 
258 /* *** Entry: recover_fetch - Internal entry for bft_ *** */
259 
260 recover_fetch:
261      entry (p_code);
262 
263 /* ENTRY FUNCTION
264 
265 This entrypoint assembles the arguments and makes the proper call to
266 bft_minor_$recover_fetch
267 */
268 
269 /* NOTES
270 */
271 
272 /* Locate the bft_main_ capability */
273 
274      bft_major = 0;
275      call ws_$find_capability_number ("bft_main_", LOCAL_SYSTEM, bft_major,
276           p_code);
277      if p_code ^= 0 then
278           return;
279 
280 /* Execute bft_minor_$recover_fetch */
281 
282      call ws_$create_instance ("bft_", "process_event", BFT_INBUFFER_SIZE,
283           BFT_OUTBUFFER_SIZE, null, bft_mcb, p_code);
284      if p_code ^= 0 then
285           return;
286 
287      call ws_$execute_capability (bft_major, bft_minor_$recover_fetch,
288           null, (0), bft_mcb, p_code);
289 
290      call ws_$destroy_instance (bft_mcb, (0));
291 
292      return;
293 
294 /*^L*/
295 
296 /* *** Entry: recover_store - Internal entry for bft_ *** */
297 
298 recover_store:
299      entry (p_code);
300 
301 /* ENTRY FUNCTION
302 
303 This entrypoint assembles the arguments and makes the proper call to
304 bft_minor_$recover_store.
305 */
306 
307 /* NOTES
308 */
309 
310 /* Find the bft_main_ capability */
311 
312      major_num = 0;
313      call ws_$find_capability_number ("bft_main_", LOCAL_SYSTEM,
314           major_num, p_code);
315      if p_code ^= 0 then
316           return;
317 
318 /* Execute bft_minor_$recover_store */
319 
320      call ws_$create_instance ("bft_", "process_event", BFT_INBUFFER_SIZE,
321           BFT_OUTBUFFER_SIZE, null, bft_mcb, p_code);
322      if p_code ^= 0 then
323           return;
324 
325      call ws_$execute_capability (major_num, bft_minor_$recover_store,
326           null, (0), bft_mcb, p_code);
327 
328      call ws_$destroy_instance (bft_mcb, (0));
329 
330      return;
331 
332 /*^L*/
333 
334 /* *** Entry: store - Internal entry for bft_ *** */
335 
336 store:
337      entry (p_source_filename, p_destination_filename, p_flags, p_priority,
338           p_code);
339 
340 /* ENTRY FUNCTION
341 
342 This entrypoint assembles the arguments and makes the proper call to
343 bft_minor_$add_to_store_queue.
344 */
345 
346 /* NOTES
347 */
348 
349      call add_to_queue (p_source_filename, p_destination_filename, p_flags,
350           p_priority, bft_minor_$add_to_store_queue, p_code);
351 
352      return;
353 
354 /*^L*/
355 
356 /* *** Entry: unload - Internal entry for bft_ *** */
357 
358 unload:
359      entry (p_code);
360 
361 /* ENTRY FUNCTION
362 
363 This entrypoint assembles the arguments and makes the proper call to
364 TERMINATE_APPLICATION.
365 */
366 
367 /* NOTES
368 */
369 
370 /* Allocate the structure where the arguments will be placed */
371 
372      call ws_$create_instance ("bft_", "process_event", BFT_INBUFFER_SIZE,
373           BFT_OUTBUFFER_SIZE, null, bft_mcb, p_code);
374      if p_code ^= 0 then
375           return;
376 
377      major_num = 0;
378      call ws_$find_capability_number ("bft_main_", LOCAL_SYSTEM, major_num, p_code);
379      if p_code ^= 0 then
380           return;
381 
382      bft_major = major_num;
383      call ws_$execute_capability (bft_major, bft_minor_$bft_shut_down,
384           null, 0, bft_mcb, p_code);
385      call ws_$destroy_instance (bft_mcb, (0));
386 
387      return;
388 
389 /*^L*/
390 
391 /* INTERNAL PROCEDURES */
392 
393 
394 /* *** Procedure: add_to_queue - Internal proc for bft_  *** */
395 
396 add_to_queue:
397      proc (p_multics_path, p_pc_path, p_flags, p_priority, p_minor, p_code);
398 
399 
400 /* PROCEDURE FUNCTION
401 
402 This procedure assembles the arguments for adding an element to either
403 the store or fetch queue.
404 */
405 
406 /* NOTES
407 */
408 
409 
410 /* PARAMETERS */
411 dcl p_priority             fixed bin parameter;       /* Transfer priority */
412 dcl p_flags                bit (36) aligned parameter;  /* Transfer modes */
413 dcl p_minor                fixed bin parameter;       /* Store or Fetch */
414 dcl p_pc_path              char (*) var parameter;
415 dcl p_multics_path         char (*) var parameter;
416 dcl p_code                 fixed bin (35) parameter;  /* Error code */
417 
418 /* MISC VARIABLES */
419 dcl flags_over             char (4) aligned based (addr (p_flags));  /* Character overlay of flags */
420 dcl mcb_ptr                ptr;                       /* MOWSE control block */
421 dcl major_num              fixed bin;                 /* Capability number */
422 dcl message                char (256);                /* Message to be sent */
423 
424 /* STRUCTURES */
425 
426 /* INITIALIZATION */
427 
428 /* MAIN */
429 
430      p_code = 0;
431 
432 /* Fill out the message: MULTICS_SOURCE;PC_SOURCE;FLAGS;PRIORITY; */
433 
434      message = rtrim (p_multics_path) || DELIM_CHAR;
435      message = rtrim (message) || p_pc_path || DELIM_CHAR;
436      message = rtrim (message) || flags_over || DELIM_CHAR;
437      message = rtrim (message) || byte (p_priority);
438 
439      major_num = 0;
440      call ws_$find_capability_number ("bft_main_", LOCAL_SYSTEM, major_num, p_code);
441      if p_code ^= 0 then
442           return;
443 
444 /* Execute bft_minor_$add_to_fetch_queue */
445 
446      call ws_$create_instance ("bft_", "process_event", BFT_INBUFFER_SIZE,
447           BFT_OUTBUFFER_SIZE, null, mcb_ptr, p_code);
448      if p_code ^= 0 then
449           return;
450 
451      call ws_$execute_capability (major_num, p_minor, addr (message),
452           length (rtrim (message)), mcb_ptr, p_code);
453      call ws_$destroy_instance (mcb_ptr, (0));
454 
455 end add_to_queue;
456 
457 /*^L*/
458 
459 /* *** Procedure: minor_error - Internal proc for bft_ *** */
460 
461 minor_error:
462      proc (p_minor_number);
463 
464 /* PROCEDURE FUNCTION
465 
466 This is called when one of the predefined minor capabilities is called that is
467 not expected.
468 */
469 
470 /* NOTES
471 */
472 
473 /* PARAMETERS */
474 dcl p_minor_number         fixed bin parameter;
475 
476 /* MISC VARIABLES */
477 
478 /* STRUCTURES */
479 
480 /* INITIALIZATION */
481 
482 /* MAIN */
483 
484      call ws_$put_background_message (bft_mcb, 0, "BFT_ ",
485           "Unexpected minor capability has been called.");
486 
487      end minor_error;
488 
489 /*^L*/
490 
491 /* *** Procedure: clean_up - Internal proc for bft_ *** */
492 
493 clean_up:
494      proc ();
495 
496 /* PROCEDURE FUNCTION
497 
498 This cleanup handler frees up the space allocated in the system_free_area.
499 */
500 
501 /* NOTES
502 */
503 
504 /* PARAMETERS */
505 
506 /* MISC VARIABLES */
507 
508 /* STRUCTURES */
509 
510 /* INITIALIZATION */
511 
512 /* MAIN */
513 
514      if bft_struct_ptr ^= null then do;
515           free bft_struct_ptr -> bft_struct;
516           bft_struct_ptr = null;
517      end;
518 
519      end clean_up;
520 
521 /*^L*/
522 
523 /* INCLUDE FILES */
524 %include bft;
525 %include bft_values;
526 %include mowse_lib_dcls;
527 %include mowse;
528 
529      end bft_;