1
2
3
4
5
6
7
8
9 bft_:
10 proc ();
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43 dcl p_id_sw fixed bin parameter;
44 dcl p_id char (*) parameter;
45 dcl p_priority fixed bin parameter;
46 dcl p_flags bit (36) aligned parameter;
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
58 dcl dir_name char (168);
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
68 dcl 01 bft_struct like bft_values_struct based (bft_struct_ptr);
69
70
71 dcl absolute_pathname_ entry (char(*), char(*), fixed bin(35));
72
73
74
75
76
77
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
82 dcl byte builtin;
83 dcl null builtin;
84 dcl addr builtin;
85 dcl length builtin;
86 dcl rtrim builtin;
87
88
89 dcl cleanup condition;
90
91
92
93
94
95
96
97
98
99 return;
100
101
102
103
104
105
106
107
108 cancel:
109 entry (p_id_sw, p_id, p_code);
110
111
112
113
114
115
116
117
118
119
120 p_code = 0;
121
122
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
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
161
162
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
169
170
171
172
173
174
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
203
204
205
206 fetch:
207 entry (p_source_filename, p_destination_filename, p_flags, p_priority,
208 p_code);
209
210
211
212
213
214
215
216
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
225
226
227
228 load:
229 entry (p_code);
230
231
232
233
234
235
236
237
238
239
240
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
257
258
259
260 recover_fetch:
261 entry (p_code);
262
263
264
265
266
267
268
269
270
271
272
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
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
295
296
297
298 recover_store:
299 entry (p_code);
300
301
302
303
304
305
306
307
308
309
310
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
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
333
334
335
336 store:
337 entry (p_source_filename, p_destination_filename, p_flags, p_priority,
338 p_code);
339
340
341
342
343
344
345
346
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
355
356
357
358 unload:
359 entry (p_code);
360
361
362
363
364
365
366
367
368
369
370
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
390
391
392
393
394
395
396 add_to_queue:
397 proc (p_multics_path, p_pc_path, p_flags, p_priority, p_minor, p_code);
398
399
400
401
402
403
404
405
406
407
408
409
410
411 dcl p_priority fixed bin parameter;
412 dcl p_flags bit (36) aligned parameter;
413 dcl p_minor fixed bin parameter;
414 dcl p_pc_path char (*) var parameter;
415 dcl p_multics_path char (*) var parameter;
416 dcl p_code fixed bin (35) parameter;
417
418
419 dcl flags_over char (4) aligned based (addr (p_flags));
420 dcl mcb_ptr ptr;
421 dcl major_num fixed bin;
422 dcl message char (256);
423
424
425
426
427
428
429
430 p_code = 0;
431
432
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
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
458
459
460
461 minor_error:
462 proc (p_minor_number);
463
464
465
466
467
468
469
470
471
472
473
474 dcl p_minor_number fixed bin parameter;
475
476
477
478
479
480
481
482
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
490
491
492
493 clean_up:
494 proc ();
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
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
522
523
524 %include bft;
525 %include bft_values;
526 %include mowse_lib_dcls;
527 %include mowse;
528
529 end bft_;