1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 /* format: style4,indattr,inddcls,dclind5,idind30,struclvlind5,ifthenstmt,ifthendo,^inditerdo,^indnoniterend,case,^tree,^indproc,^indend,^delnl,^insnl,comcol81,indcom,linecom,^indcomtxt */
 13 
 14 ocd_:
 15      procedure;
 16           return;
 17 
 18           /*        Outer module of the operator's console DIM.
 19    *      Recoded by  Bill Silver  on 06/26/73
 20    *      This procedure now calls the ring 0 operator's console DCM  "ocdcm_"
 21    *      instead of calling syserr_real.
 22    *      Modified June 1976 by Larry Johnson to support alarm order.
 23    *         Rearranged as a native iox_ module by Benson I. Margulies April 1981.
 24    *      Modified 830620 for new ocdcm_ calls... -E. A. Ranzenbach
 25    *      Modified 841101 for printer_(off on) control orders... -E. A. Ranzenbach
 26 */
 27 
 28 
 29 /****^  HISTORY COMMENTS:
 30   1) change(86-10-23,Fawcett), approve(86-10-23,MCR7517),
 31      audit(86-10-30,Beattie), install(86-11-03,MR12.0-1206):
 32      Changed to remove the word BOS from message.
 33                                                    END HISTORY COMMENTS */
 34 
 35 
 36           /*                  PARAMETERS                    */
 37 
 38           declare  (
 39                    IOCB_ptr                      pointer,
 40                    Attach_args                   (*) character (*) varying,
 41                    Com_err_sw                    bit (1) aligned,
 42                    Code                          fixed bin (35),
 43                    Buffer_ptr                    pointer,
 44                    Buffer_length                 fixed bin (21),
 45                    N_chars_read                  fixed bin (21),
 46                    Old_modes                     character (*),
 47                    New_modes                     character (*),
 48                    Mode                          fixed bin,
 49                    Obsolete                      bit (1) aligned,
 50                    Control_order_name            character (*),
 51                    Order_info_ptr                pointer
 52                    )                             parameter;
 53 
 54           /*                  AUTOMATIC  DATA               */
 55 
 56           declare  mask                          bit (36) aligned;
 57           dcl  code                          fixed bin (35),                    /* Error code. */
 58                alen                          fixed bin (21),                    /* Length of an ASCII string.  */
 59                ilen                          fixed bin,                         /* Length of a console input string in
 60                                                                *  ASCII or BCD characters. */
 61                olen                          fixed bin (19);                    /* Length of a console output string in WORDS. */
 62           dcl  io_uid                        fixed bin (71);                    /* UID of a queued I/O... */
 63           dcl  console_flags                 bit (36);                          /* console state flags... */
 64 
 65           dcl  01 console_read               aligned like console_io;
 66           dcl  01 console_write              aligned like console_io;
 67 
 68           dcl  01 EWI                        aligned like event_wait_info;
 69 
 70           /*        These flags are used to coordinate the conversion and writing of an output
 71    *      string.
 72 */
 73           dcl  cont_flag                     bit (1) aligned;                   /* Used by "oc_trans_output_" to indicate a
 74                                                                *  continuation line.  The oc_write entry just
 75                                                                *  has to initialize it each time it is called.  */
 76 
 77 
 78           /*        This buffer contains a converted output string  or  an unconverted input
 79    *      string.
 80 */
 81           dcl  buffer                        char (256),
 82                buf_ptr                       ptr;
 83 
 84 
 85           /*                  BASED  DATA                   */
 86 
 87 
 88           declare  attach_data_ptr               pointer;
 89 
 90           declare  1 attach_data                 based (attach_data_ptr),
 91                         2 device                 character (32) unaligned,
 92                         2 attach_description     character (72) varying,
 93                         2 open_description       character (64) varying,
 94                         2 wait_list              aligned like event_wait_channel,
 95                         2 line_leng              fixed binary,
 96                         2 alarm_flag             bit (1) aligned;               /* Set if alarm pending for next write */
 97 
 98 
 99           /*                  EXTERNAL ENTRIES CALLED       */
100           dcl  hphcs_$ocdcm_queue_io         entry (ptr, fixed bin (71));
101           dcl  hphcs_$ocdcm_get_input        entry (char (256), fixed bin (17), fixed bin (35));
102           dcl  hphcs_$ocdcm_console_info
103                                              entry (char (4), bit (36), char (8), fixed bin (17), fixed bin (17),
104                                              fixed bin (35));
105           dcl  hphcs_$ocdcm_printer_off
106                                              entry ();
107           dcl  hphcs_$ocdcm_printer_on
108                                              entry ();
109           dcl  timer_manager_$sleep          entry (fixed bin (71), bit (2));
110           dcl  ipc_$block                    entry (ptr, ptr, fixed bin (35));
111           dcl  ipc_$create_ev_chn            entry (fixed bin (71), fixed bin (35));
112           dcl  ipc_$delete_ev_chn            entry (fixed bin (71), fixed bin (35));
113           dcl  oc_trans_output_              entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (19), fixed bin (17),
114                                              bit (1) aligned);
115           dcl  oc_trans_input_               entry (ptr, fixed bin, fixed bin, ptr, fixed bin);
116           declare  (
117                    hcs_$set_ips_mask,
118                    hcs_$reset_ips_mask
119                    )                             entry (bit (36) aligned, bit (36) aligned);
120 
121           declare  (
122                    error_table_$noarg,
123                    error_table_$bad_mode,
124                    error_table_$undefined_order_request,
125                    error_table_$too_many_args,
126                    error_table_$null_info_ptr,
127                    error_table_$bad_arg
128                    )                             fixed bin (35) ext static;
129 
130 
131           dcl  (addr, addcharno, hbound, lbound, substr, unspec, multiply, null)
132                                              builtin;
133           dcl  any_other                     condition;
134 %page;
135 %page;
136 %include iox_entries;
137 %page;
138 %include oc_data;
139 %page;
140 %include iox_modes;
141 %page;
142 %include iocb;
143           declare  iocb_ptr                      pointer;
144 %page;
145 %include event_wait_info;
146 %page;
147 %include event_wait_channel;
148 %page;
149 %include oc_info;
150 %page;
151 %include sub_err_flags;
152 
153           declare  (to_write_ptr, to_read_ptr)
154                                                  pointer;
155           declare  to_write_length               fixed bin (21);
156           declare  to_read_length                fixed bin;
157 ^L
158 
159 ocd_attach:
160      entry (IOCB_ptr, Attach_args, Com_err_sw, Code);
161 
162 
163           /*        Entry to  ATTACH  Operator's Console. */
164 
165           Code = 0;
166           iocb_ptr = IOCB_ptr;
167           if hbound (Attach_args, 1) < 1
168           then call attach_error (error_table_$noarg, "Usage: ocd_ DEVICE.");
169 
170           if hbound (Attach_args, 1) - lbound (Attach_args, 1) > 1
171           then call attach_error (error_table_$too_many_args, "Usage: ocd_ DEVICE.");
172 
173           if Attach_args (1) ^= "otw_"
174           then call attach_error (error_table_$bad_arg, "Only the BCE console, otw_, is supported.");
175 
176 
177           /*        Set up event channel used to coordinate read and write operations with ocdcm_. */
178 
179           allocate attach_data set (attach_data_ptr);
180 
181           attach_data.wait_list.pad = ""b;
182 
183           attach_data.wait_list.n_channels = 1;
184 
185           call ipc_$create_ev_chn (attach_data.wait_list.channel_id (1), code);
186           if code ^= 0
187           then call attach_error (code, "Could not get an event channel.");
188 
189           attach_data.alarm_flag = "0"b;                                        /* No alarm pending.  */
190 
191           attach_data.attach_description = "ocd_ otw_";
192 
193           /*** okay, connect it up */
194 
195           on any_other go to RESET_IPS_MASK_1;
196 
197           call hcs_$set_ips_mask (""b, mask);
198           iocb_ptr -> iocb.attach_data_ptr = attach_data_ptr;
199           iocb_ptr -> iocb.attach_descrip_ptr = addr (attach_data.attach_description);
200           iocb_ptr -> iocb.open = ocd_open;
201           iocb_ptr -> iocb.detach_iocb = ocd_detach;
202 
203           call hphcs_$ocdcm_console_info ("", "0"b, "", 0, attach_data.line_leng, code);
204           if code ^= 0 then do;                                                 /* only update if info is good...       */
205                call hcs_$reset_ips_mask (mask, mask);
206                call attach_error (code, "Could not get console info.");
207           end;
208 
209           call iox_$propagate (iocb_ptr);
210 RESET_IPS_MASK_1:
211           call hcs_$reset_ips_mask (mask, mask);
212 
213           return;
214 ^L
215 attach_error:
216      procedure (code, reason);
217           declare  code                          fixed bin (35);
218           declare  reason                        character (*);
219           declare  sub_err_                      entry () options (variable);
220           declare  com_err_                      entry () options (variable);
221           declare  ME                            character (32) init ("ocd_") internal static static options (constant);
222 
223           if Com_err_sw
224           then call com_err_ (code, ME, "^a", reason);
225 
226           else call sub_err_ (code, "odc_ attach", ACTION_DEFAULT_RESTART, null (), (0), "^a", reason);
227           Code = code;
228           go to RETURN;
229      end attach_error;
230 
231 RETURN:
232           return;
233 
234 ocd_detach:
235      entry (IOCB_ptr, Code);
236           call setup;
237           call ipc_$delete_ev_chn (attach_data.wait_list.channel_id (1), (0));
238           IOCB_ptr -> iocb.attach_descrip_ptr = null ();
239           call iox_$propagate (IOCB_ptr);
240           free attach_data;
241 
242           return;
243 
244 ocd_open:
245      entry (IOCB_ptr, Mode, Obsolete, Code);
246           call setup;
247 
248           if Mode ^= Stream_input & Mode ^= Stream_output & Mode ^= Stream_input_output
249           then do;
250                Code = error_table_$bad_mode;
251                return;
252           end;
253 
254           on any_other go to RESET_IPS_MASK_2;
255 
256           call hcs_$set_ips_mask (""b, mask);
257           if Mode = Stream_input | Mode = Stream_input_output
258           then do;
259                iocb_ptr -> iocb.get_chars = ocd_get_chars;
260                iocb_ptr -> iocb.get_line = ocd_get_line;
261           end;
262           if Mode = Stream_output | Mode = Stream_input_output
263           then iocb_ptr -> iocb.put_chars = ocd_put_chars;
264           iocb_ptr -> iocb.close = ocd_close;
265           iocb_ptr -> iocb.modes = ocd_modes;
266           iocb_ptr -> iocb.control = ocd_control;
267           iocb_ptr -> iocb.open_descrip_ptr = addr (attach_data.open_description);
268           attach_data.open_description = iox_modes (Mode);
269           call iox_$propagate (iocb_ptr);
270 RESET_IPS_MASK_2:
271           call hcs_$reset_ips_mask (mask, mask);
272           return;
273 
274 ocd_close:
275      entry (IOCB_ptr, Code);
276 
277           call setup;
278 
279           on any_other go to RESET_IPS_MASK_3;
280 
281           call hcs_$set_ips_mask (""b, mask);
282           iocb_ptr -> iocb.modes = iox_$err_not_open;
283           iocb_ptr -> iocb.control = iox_$err_not_open;
284           iocb_ptr -> iocb.detach_iocb = ocd_detach;
285           iocb_ptr -> iocb.open = ocd_open;
286           call iox_$propagate (iocb_ptr);
287 RESET_IPS_MASK_3:
288           call hcs_$reset_ips_mask (mask, mask);
289           return;
290 ^L
291 ocd_put_chars:
292      entry (IOCB_ptr, Buffer_ptr, Buffer_length, Code);
293 
294 
295           /*        This entry is called to write one string.  This string may be up to a segment
296    *      long and consist of many lines.  Any lines that are too long to be printed on
297    *      the operator's console will be broken up via continuation lines.
298 */
299 
300           call setup;
301 
302           if Buffer_length <= 0
303           then do;
304                attach_data.alarm_flag = "0"b;
305                return;
306           end;
307 
308           /*        Now initialize the indexes needed for the workspace overlay and initialize the
309    *      flags that control the write operation.
310 */
311 
312           buf_ptr = addr (buffer);
313           cont_flag = "0"b;
314 
315 /**** This flag  (cont_flag) is used by  oc_trans_output_ to decide
316       *  whether or not to add a continuation character ("\c")
317       *  to the beginning of the line. */
318 
319 
320           /*        The output message will be written line by line.  We must translate the caller's
321    *      ASCII line into an output line acceptable to the operator's console.   The
322    *      procedure which does this will break up the line if the translated output line
323    *      is too long for the operator's console carriage.   It returns the number of ASCII
324    *      characters that have been processed  and  the WORD size of the translated
325    *      output string.
326 */
327 
328           to_write_ptr = Buffer_ptr;
329           to_write_length = Buffer_length;
330 
331           console_write.event_chan = 0;
332           unspec (console_write.flags) = "0"b;
333           console_write.console = "";
334           console_write.sequence_no = 0;
335 
336           alen = 0;
337 
338           do while (to_write_length > 0);
339                call oc_trans_output_ (to_write_ptr, to_write_length, alen, buf_ptr, olen, attach_data.line_leng,
340                     cont_flag);
341                console_write.alert = attach_data.alarm_flag;                    /* set by "alarm" control order...      */
342                console_write.leng = olen;                                       /* setup the write as translated...     */
343                console_write.text = substr (buffer, 1, multiply (olen, 4, 17));
344                io_uid = 0;
345                do while (io_uid = 0);
346                     call hphcs_$ocdcm_queue_io (addr (console_write), io_uid);
347                                                                                 /* queue the write...                   */
348                     if io_uid = 0
349                     then do;                                                    /* write queue is full...               */
350                          call timer_manager_$sleep (3, "11"b);
351                                                                                 /* wait 3 seconds for room in the queue. */
352                     end;
353                end;
354                attach_data.alarm_flag = "0"b;
355                to_write_ptr = addcharno (to_write_ptr, (alen));
356                to_write_length = to_write_length - alen;
357           end;
358 
359           /*        We know that this line has been written by ocdcm_.
360    *      Now we must move the window on the caller's workspace - skipping the line
361    *      that was just written.  We don't have to worry about continuation lines.
362 */
363 
364           /*        We have finished processing all of the data in the user's workspace.  We will
365    *      return status indicating that everything was completed OK.
366 */
367 
368           return;
369 ^L
370 
371           /* Noone in the initializer calls get_chars, at least unless
372    get_line returns long record. We could save up leftover input
373    in the attach data for later return, but the old IOS dim
374    got away without it, so we can presumably as well. Thus
375    we assume that the callers buffer is always long enough
376    (256 characters) and don't even try to return long_record. */
377 
378 ocd_get_chars:
379 ocd_get_line:
380      entry (IOCB_ptr, Buffer_ptr, Buffer_length, N_chars_read, Code);
381 
382 
383           /*        This entry is called to read a line from the operator's console.  Note, when there
384    *      is no input to read we will go blocked.  We will be waked up when the input string
385    *      arrives.
386 */
387 
388           call setup;
389           N_chars_read = 0;
390           to_read_ptr = Buffer_ptr;
391           to_read_length = Buffer_length;
392 
393           if Buffer_length <= 0                                                 /* Make sure caller really wants something. */
394           then return;
395 
396 
397           /*        Now initialize the indexes needed for the workspace overlay.  We need them so we
398    *      can get a pointer to the area where the  ASCII input string will be placed.
399 */
400           buf_ptr = addr (buffer);
401 
402 
403           /*        Now we will call into the ring 0 DIM to read.  If there is no input message then
404    *      we will block ourselves.   ocdcm_ will wake us up when the input string arrives.
405 */
406 
407           console_read.event_chan = attach_data.wait_list.channel_id (1);
408           unspec (console_read.flags) = "0"b;
409           console_read.sequence_no = 0;
410           console_read.console = "";
411           console_read.read = "1"b;
412           console_read.leng = 0;
413           console_read.text = "";
414 
415 READ_LOOP:
416           call hphcs_$ocdcm_queue_io (addr (console_read), io_uid);
417                                                                                 /* queue the I/O...                     */
418 
419           ilen = 0;
420 
421           do while (ilen = 0);
422                call BLOCK;                                                      /* go blocked awaiting completion...    */
423                if code ^= 0
424                then do;
425                     Code = code;
426                     return;
427                end;
428 
429                /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
430                /*                                                                                             */
431                /* At this point ocdcm_ has sent a wakeup bring us out of the blocked state and informing us that        */
432                /* the read has completed. We must now call down into ocdcm_ to retrieve the input from oc_data.         */
433                /*                                                                                             */
434                /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
435 
436                call hphcs_$ocdcm_get_input (buffer, ilen, code);
437                                                                                 /* retrieve the input...                */
438                if code ^= 0
439                then do;
440                     Code = code;
441                     return;
442                end;
443           end;
444 
445           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
446           /*                                                                                                  */
447           /* Now we call oc_trans_input_ to translate the input string and do canonicalization.               */
448           /*                                                                                                  */
449           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
450 
451           begin;
452                declare  fb_n_read                     fixed bin;
453                call oc_trans_input_ (to_read_ptr, to_read_length, fb_n_read, buf_ptr, ilen);
454                N_chars_read = fb_n_read;
455           end;
456 
457           return;
458 
459 
460 
461 
462 
463 ocd_control:
464      entry (IOCB_ptr, Control_order_name, Order_info_ptr, Code);
465 
466           call setup;
467 
468           /*        This entry supports the following order calls:
469    start
470    alarm
471    console_info
472    update_attach_data
473    printer_off
474    printer_on
475 
476    The reset_read and reset_write orders are ignored but provided for
477    compatibility.
478 
479    The error code error_table_$undefined_order_request is returned for all others.
480 */
481 
482           if Control_order_name = "start"                                       /* simulated START actutally does nothing... */
483           then do;
484                return;
485           end;
486           else if Control_order_name = "alarm"
487           then do;
488                attach_data.alarm_flag = "1"b;
489                return;
490           end;
491           else if Control_order_name = "resetread"                              /** **/
492                     | Control_order_name = "resetwrite"
493           then do;
494                Code = 0;
495                return;
496           end;
497 
498           else if Control_order_name = "console_info"
499           then do;
500                if Order_info_ptr = null
501                then do;                                                         /* got to provide a ptr...              */
502                     code = error_table_$null_info_ptr;
503                     return;
504                end;
505                oc_info_ptr = Order_info_ptr;                                    /* overlay the order info structure...  */
506                call hphcs_$ocdcm_console_info ((oc_info.name), console_flags, (oc_info.channel),
507                     (oc_info.device_idx), (oc_info.line_leng), code);
508                unspec (oc_info.flags) = unspec (console_flags);
509                return;
510           end;
511 
512           if Control_order_name = "update_attach_data"
513           then do;                                                              /* called during reconfig...            */
514                call hphcs_$ocdcm_console_info ("", "0"b, "", 0, attach_data.line_leng, code);
515                Code = code;
516                return;
517           end;
518 
519           else if Control_order_name = "printer_off"
520           then do;
521                allocate oc_info set (oc_info_ptr);
522                call hphcs_$ocdcm_console_info ("", console_flags, "", 0, attach_data.line_leng, code);
523                if code = 0
524                then do;                                                         /* only update if info is good...       */
525                     unspec (oc_info.flags) = unspec (console_flags);
526                     if ^oc_info.flags.read_unechoed_option then Code = error_table_$undefined_order_request;
527                     else call hphcs_$ocdcm_printer_off ();
528                end;
529                free oc_info;
530                return;
531           end;
532           else if Control_order_name = "printer_on"
533           then do;
534                call hphcs_$ocdcm_printer_on ();
535                return;
536           end;
537 
538           else Code = error_table_$undefined_order_request;
539           return;
540 
541 ocd_modes:
542      entry (IOCB_ptr, Old_modes, New_modes, Code);                              /* MODES are ignored...                                                                                                 */
543           Code = 0;
544           return;
545 ^L
546 
547 
548 BLOCK:
549      procedure;
550 
551 
552           /*        This internal procedure is called when we must go blocked in order to
553    *      wait for an I/O operation to complete.
554 */
555 
556           call ipc_$block (addr (attach_data.wait_list), addr (EWI), code);
557 
558      end BLOCK;
559 
560 setup:
561      procedure;
562 
563           iocb_ptr = IOCB_ptr -> iocb.actual_iocb_ptr;
564           attach_data_ptr = iocb_ptr -> iocb.attach_data_ptr;
565           Code = 0;
566      end setup;
567 
568      end ocd_;