1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) BULL HN Information Systems Inc., 1989   *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Bull Inc., 1987                *
  6         *                                                         *
  7         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  8         *                                                         *
  9         * Copyright (c) 1972 by Massachusetts Institute of        *
 10         * Technology and Honeywell Information Systems, Inc.      *
 11         *                                                         *
 12         *********************************************************** */
 13 
 14 
 15 
 16 /****^  HISTORY COMMENTS:
 17   1) change(89-08-28,Farley), approve(89-09-18,MCR8132),
 18      audit(89-10-10,WAAnderson), install(89-10-11,MR12.3-1091):
 19      Increased the size of the console output buffer (out_buf) from
 20      132 to 256 to be consistent with oc_trans_output_.
 21                                                    END HISTORY COMMENTS */
 22 
 23 
 24 /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */
 25 syserr_real:
 26      procedure (arg_code);
 27 
 28 /*        This procedure completely recoded  June 28, 1973 by  Bill Silver. */
 29 /*        Modified 750227 by LJS to change max length of syserr messages */
 30 /*        Modified August, 1975 by Larry Johnson to implement error_code and binary entries */
 31 /*        Modified January 1976 by Larry Johnson to fix bugs in "=" message handling */
 32 /*        Modified March 1976 by Steve Webber to use logger HPROC */
 33 /*        Modified May 1976 by Larry Johnson to add "binary_mylock" entry for use by ocdcm_ */
 34 /*        Modified November 1976 by Larry Johnson to stop logging "=" messages */
 35 /*        Modified May 1977 by Noel I. Morris to shrink stack frame and implement panic */
 36 /*        Modified August 1977 by Noel I. Morris to fix bug in *lost "=" messages */
 37 /*        Modified August 1978 by Bernard S. Greenberg to eliminate calling ocdcm with syserr lock locked. */
 38 /*        Modified April 1982 by C. Hornig to add NL to console messages. */
 39 /*        Modified June 1982 by E. N. Kittlitz to not equalize alarm messages. */
 40 /*        Modified September 1982 by C. Hornig to use automatic buffer for console */
 41 /*        Modified 830601 BIM to check for silly error codes. */
 42 /*        Modified 830622 for new ocdcm_ interface... -E. A. Ranzenbach */
 43 /*        Modified 83-12-19 BIM for better call to terminate_proc */
 44 /*        Modified 83-??-?? Keith Loepere for calls to bce. */
 45 /*        Modified 1984-11-26, BIM: options (validate) changed to
 46           pmut$wire_and_mask, actually call the copy primitive if
 47           we are called unwired. */
 48 /*        Modified 1984-12-20, BIM: avoid recursive copy attempts by checking
 49           the paged syserr log lock before actually copying. */
 50 /*        Modified 1984-12-21, EJ Sharpe for multiple_binary entrypoint */
 51 /*        Modified 1985-01-21, EJ Sharpe for 2047 char text (was 512),
 52           also added process_id to wired msg */
 53 /*        Modified 1985-01-25, Keith Loepere, to fix race in log copying. */
 54 /*        Modified 1985-02-15, Keith Loepere, to restructure syserr paged vs
 55           wired lock startegy; basically to make the paged lock the
 56           highest paged lock in the system so that a copy into the paged lock
 57           is always possible from any paged process. */
 58 /*        Modified 1985-03-28, EJ Sharpe, avoid copy to paged log when process
 59           is to be terminated or system is to be crashed. */
 60 
 61 /*        The syserr code which we receive as an argument is converted
 62    to an action code whose value is mod 10 of the original value.
 63    The meaning of the ten possible action codes is:
 64    0  =>  write message without alarm, log, and return.
 65    1  =>  write message with alarm, log, and CRASH system - allow bce to return.
 66    2  =>  write message with alarm, log, and terminate process.
 67    3  =>  write message with alarm, log, and return.
 68    4  =>  log message and return, don't write message unless message not logged.
 69    5  =>  log message and return, don't write message even if not logged.
 70    (6 - 9) not used, mapped into code 5.
 71 
 72 
 73    /*               PARAMETER DATA                */
 74 
 75 dcl  arg_code                           fixed bin;          /* (I) The syserr code. */
 76 dcl  arg_data_code                      fixed bin;          /* (I) Format of binary data on $binary entry */
 77 dcl  arg_data_len                       fixed bin;          /* (I) Length of binary data on $binary entry */
 78 dcl  arg_data_pieces_array_ptr          ptr;                /* ptr to array of ptrs and lengths of bin data */
 79 dcl  arg_data_ptr                       ptr;                /* (I) Pointer to binary data on $binary entry */
 80 dcl  arg_error_code                     ptr unal;           /* (I) error_table_$ code on $error_code entry */
 81 dcl  arg_n_data_pieces                  fixed bin;          /* number of pieces of bin data */
 82 dcl  arg_panic_mess                     char (*);           /* (I) message to panic entry */
 83 
 84 
 85 /*                  AUTOMATIC  DATA               */
 86 
 87 dcl  alarm_flag                         bit (1) aligned;    /* ON => write message with alarm.  */
 88 dcl  arg_list_ptr                       ptr;                /* arg list to syserr_real */
 89 dcl  1 auto_mbuf                        aligned,            /* refer to DATA STRUCTURING below */
 90        2 header                         like mbuf_header,
 91        2 equal                          char (4) unal;
 92 dcl  1 auto_wlog_header                 aligned like wlog_header;
 93 dcl  1 auto_wmess_header                aligned like wmess_header;
 94 dcl  binary_call                        bit (1);            /* ON => entered through $binary entry */
 95 dcl  code                               fixed bin;          /* copy of code passed to syserr */
 96 dcl  cont_flag                          bit (1) aligned;    /* Continuation line flag used by oc_trans_output_. */
 97 dcl  copying_permitted                  bit (1) aligned;    /* environment permits page faults */
 98 dcl  cs_pos                             fixed bin;          /* Position of ioa_ ccntrol string in param list */
 99 dcl  data_code                          fixed bin;          /* Data classification code */
100 dcl  data_len                           fixed bin;          /* Length of binary data */
101 dcl  data_piece_len                     fixed bin;          /* Length of piece of binary data */
102 dcl  data_piece_ptr                     ptr;                /* Pointer to piece of binary data */
103 dcl  data_pieces_array_ptr              pointer;            /* pointer to array of ptrs and lengths of the pieces of the binary data */
104 dcl  data_ptr                           ptr;                /* Pointer to binary data */
105 dcl  error_table_call                   bit (1);            /* ON => entered through $error_code entry */
106 dcl  error_table_code                   fixed bin (35);
107 dcl  etmsgp                             ptr;                /* Pointer to error table message on $error_code call */
108 dcl  mbuf_ptr                           ptr;                /* Pointer to ASCII message buffer. */
109 dcl  message_len                        fixed bin (21);     /* length of syserr message in data */
110 dcl  n_data_pieces                      fixed bin;          /* number of binary data parts */
111 dcl  nargs                              fixed bin;
112 dcl  1 oc_io                            aligned like console_io;
113 dcl  oc_line_leng                       fixed bin;          /* line length of the console...        */
114 dcl  oc_printed_leng                    fixed bin;          /* how much we will print on console */
115 dcl  ocdcm_code                         fixed bin (35);     /* returned by ocdcm_...                */
116 dcl  old_mask                           bit (72) aligned;   /* actually entry value of the mask */
117 dcl  old_wlog_ptr                       ptr;                /* to copy of syserr_data$wired_log_area */
118 dcl  olen                               fixed bin (19);     /* Length  of the output string in  WORDS.  */
119 dcl  optr                               ptr;                /* Pointer to beginning of the output buffer. */
120 dcl  out_buf                            char (256) aligned; /* console buffer */
121 dcl  piece_index                        fixed bin;          /* index of binary data piece */
122 dcl  print_len                          fixed bin (21);     /* number of chars to print on console */
123 dcl  print_ptr                          ptr;                /* Pointer to beginning of expanded message for console */
124 dcl  print_this_line_len                fixed bin (21);     /* Number  of characters processed. */
125 dcl  rtime                              fixed bin (71);     /* Raw time in microseconds. */
126 dcl  sys_code                           fixed bin;          /* Syserr code of this message. */
127 dcl  tenths_min                         fixed bin;          /* Number of tenths of a minute. */
128 dcl  wire_arg                           bit (72) aligned;   /* mask with pmut's nasty note or'ed into it */
129 dcl  wired                              bit (1) aligned;    /* wired and masked */
130 dcl  wired_wlog_ptr                     ptr;                /* to syserr_data$wired_log_area */
131 dcl  wired_wmess_ptr                    ptr;                /* to where we would add message to syserr_data */
132 dcl  wired_stack_ptr                    pointer;            /* restore value for unwire_unmask */
133 dcl  wmess_len                          fixed bin;          /* Size of current wired message entry. */
134 dcl  write_flag                         bit (1) aligned;    /* ON => this message should be written. */
135 
136 
137 /*                  BASED  DATA                   */
138 
139 dcl  CR_NL                              char (5) based (addr (CR_NL_bits));
140 
141 /* DATA STRUCTURING:
142      This program endeavors to avoid copying data many times.  As such,
143 it overlays various data structures such that the large data areas need be
144 copied as seldom as possible.  The idea is to build a wlog structure that
145 is acceptable to syserr_copy$wired_log.  However, the text in this wlog
146 structure also wants to be part of a mbuf structure for console purposes.
147 So, we lay down the text and data as for a wlog structure, but not the
148 header.  Instead, we allow for enough room for either a wlog/wmess header,
149 or a mbuf header, but keep these headers in auto storage, and overlay them
150 in front of the text when necessary. */
151 
152 dcl  binary_data                        (data_len) bit (36) aligned based (data_ptr); /* binary data on $binary entry */
153 dcl  data_piece                         (data_piece_len) bit (36) aligned based (data_piece_ptr); /* Binary data on $multiple_binary entry */
154 
155 dcl  1 data_pieces_array                (n_data_pieces) aligned based (data_pieces_array_ptr),
156                                                             /* an array of pointers pieces of the binary data */
157        2 ptr                            pointer,            /* pointer to part of the binary data */
158        2 len                            fixed bin;          /* number of words */
159 
160 dcl  1 et                               aligned based (etmsgp), /* An error table message */
161        2 len                            fixed bin (8) unal, /* Length of the message */
162        2 msg                            char (et.len) unal; /* The message */
163 
164 /* This buffer will hold the ASCII message.  When writing a message the string will
165    start at either  mbuf.no_log or mbuf.time  and extend to and include mbuf.text. */
166 
167 dcl  1 mbuf                             aligned based (mbuf_ptr),
168        2 header                         aligned like mbuf_header,
169        2 text                           char (2047) unal;   /* Expanded syserr message in ASCII. */
170 
171 dcl  1 mbuf_header                      aligned based,
172        2 no_log,                                            /* Special message written only if there is no room
173                                                                in the wired log buffer for this message entry. */
174          3 lost                         char (6) unal,      /* "*lost " */
175          3 seq_num                      pic "9999" unal,
176          3 comma                        char (2) unal,      /* ", " */
177          3 sys_code                     pic "9" unal,
178          3 pad                          char (3) unal,
179        2 time,                                              /* Time message logged.  Converted to:  "hhmm.t"
180                                                                where t = tenths of minutes. */
181          3 hh                           pic "99" unal,
182          3 mmt                          pic "99.9" unal,
183          3 pad                          char (2) unal;
184 
185 dcl  old_wlog                           (syserr_data$wired_log_size) bit (36) aligned based (old_wlog_ptr);
186                                                             /* allocated copy of syserr_data$wired_log_area */
187 
188 dcl  wmess_copy                         (wmess_len) bit (36) aligned based; /* for copying wmess into syserr_data */
189 
190 
191 /*                  EXTERNAL ENTRIES CALLED       */
192 
193 dcl  arg_count_                         entry (fixed bin);
194 dcl  arg_list_ptr_                      entry (ptr);
195 dcl  formline_                          entry (fixed bin, fixed bin, ptr, fixed bin (21), fixed bin, ptr);
196 dcl  oc_trans_output_                   entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (19), fixed bin, bit (1) aligned);
197 dcl  ocdcm_$console_info                entry (char (4), bit (36), char (8), fixed bin, fixed bin, fixed bin (35));
198 dcl  ocdcm_$drain_io                    entry ();
199 dcl  ocdcm_$priority_io                 entry (ptr);
200 dcl  pmut$bce_and_return                entry options (variable);
201 dcl  pmut$read_mask                     entry (bit (72) aligned);
202 dcl  pmut$set_mask                      entry (bit (72) aligned);
203 dcl  pmut$unwire_unmask                 entry (bit (72) aligned, pointer);
204 dcl  pmut$wire_and_mask                 entry (bit (72) aligned, pointer);
205 dcl  pxss$unique_ring_0_wakeup          entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
206 dcl  syserr                             entry options (variable);
207 dcl  syserr_copy$lock                   entry ();
208 dcl  syserr_copy$unlock                 entry ();
209 dcl  syserr_copy$wired_log              entry (ptr);
210 dcl  syserr_real$syserr_real            entry options (variable);
211 dcl  terminate_proc                     entry (fixed bin (35));
212 dcl  wired_utility_$grow_stack_frame    entry (fixed bin) returns (ptr);
213 
214 
215 /*                  EXTERNAL DATA        */
216 
217 dcl  error_table_$                      ext;
218 dcl  pds$process_group_id               char (32) aligned ext;
219 dcl  pds$processid                      bit (36) aligned ext;
220 dcl  pds$apt_ptr                        pointer ext;
221 dcl  prds$                              ext;
222 dcl  prds$idle_ptr                      pointer ext;
223 dcl  scs$open_level                     bit (72) aligned ext;
224 dcl  sys_info$time_correction_constant  fixed bin (71) ext;
225 dcl  syserr_data$logger_ec              fixed bin (71) ext;
226 dcl  syserr_data$logger_proc_id         bit (36) aligned ext;
227 dcl  syserr_data$wired_log_size         fixed bin ext;
228 
229 
230 /*                  MISCELANEOUS        */
231 
232 dcl  cleanup                            condition;
233 
234 dcl  (add, addcharno, addr, addrel, baseno, bin, bit, byte, clock, currentsize, divide, length, max, min, mod, multiply, ptr, rel, rtrim, segno, size, stac, stackbaseptr, stacq, string, substr, unspec, wordno) builtin;
235 
236 
237 /*                  CONSTANTS           */
238 
239 dcl  CR_NL_bits                         bit (45) static options (constant) init ("015012177177177"b3); /* cr, nl, 3 pads -
240                                                   sufficient to add nl to console string */
241 dcl  bad_ring1_msg                      char (24) static options (constant) init ("syserr: Bad ring 1 call.");
242 dcl  crash_msg                          char (46) static options (constant) init ("Multics not in operation; control process: ^a.");
243 dcl  lock_msg                           char (21) static options (constant) init ("syserr: Mylock error.");
244 dcl  terminate_msg                      char (33) static options (constant) init ("Now terminating user process: ^a.");
245 %page;
246 
247 /*        MAIN  SYSERR_REAL  ENTRY  -  CALLED BY  SYSERR */
248 
249           cs_pos = 2;                                       /* formline_ control string is second param */
250           call ring0_setup;
251 
252 syserr_start:
253           data_len = 0;
254 
255           call arg_list_ptr_ (arg_list_ptr);
256           call SETUP_AND_TEXT;
257           go to COMMON;
258 
259 
260 /* Entry point if binary data is included */
261 
262 binary:
263      entry (arg_code, arg_data_ptr, arg_data_code, arg_data_len);
264 
265           cs_pos = 5;                                       /* formline_ control string is 5th param */
266           call ring0_setup;
267 
268 syserr_binary_start:
269           data_len = arg_data_len;
270 
271           call arg_list_ptr_ (arg_list_ptr);
272           call SETUP_AND_TEXT;
273           if data_len > 0 then do;                          /* If there is binary data */
274                binary_call = "1"b;                          /* this is binary call */
275                data_code = arg_data_code;
276                data_ptr -> binary_data = arg_data_ptr -> binary_data; /* Copy to wired stack */
277           end;
278 
279           go to COMMON;
280 
281 
282 /* Entry point if binary data is supplied in pieces */
283 
284 multiple_binary:
285      entry (arg_code, arg_data_pieces_array_ptr, arg_n_data_pieces, arg_data_code);
286 
287           cs_pos = 5;
288           call ring0_setup;
289 
290 syserr_multiple_binary_start:
291           data_pieces_array_ptr = arg_data_pieces_array_ptr;
292           n_data_pieces = arg_n_data_pieces;
293           data_len = 0;
294           do piece_index = 1 to n_data_pieces;
295                data_len = data_len + data_pieces_array (piece_index).len;
296           end;
297 
298           call arg_list_ptr_ (arg_list_ptr);
299           call SETUP_AND_TEXT;
300 
301           if data_len > 0 then do;
302                binary_call = "1"b;                          /* there's something for us */
303                data_code = arg_data_code;
304                data_piece_ptr = data_ptr;
305                do piece_index = 1 to n_data_pieces;         /* copy it piece by piece */
306                     data_piece_len = data_pieces_array (piece_index).len;
307                     data_piece_ptr -> data_piece = data_pieces_array (piece_index).ptr -> data_piece;
308                     data_piece_ptr = addrel (data_piece_ptr, data_piece_len);
309                end;
310           end;
311           goto COMMON;
312 
313 
314 /* Enter here with error code to expand */
315 
316 error_code:
317      entry (arg_code, arg_error_code);
318 
319           cs_pos = 3;                                       /* formline_ control string is 3rd */
320           call ring0_setup;
321 
322 syserr_error_start:
323           error_table_call = "1"b;
324           data_len = 0;
325 
326           call arg_list_ptr_ (arg_list_ptr);
327           call SETUP_AND_TEXT;
328           go to COMMON;
329 %page;
330 
331 /* Ring 1 entry points to syserr. These entries are the same as the corresponding ring 0
332    entries, except that a ring 1 caller is not allowed to crash the system or terminate a process. */
333 
334 ring1:
335      entry (arg_code);
336 
337           cs_pos = 2;                                       /* control string is second */
338           call arg_count_ (nargs);                          /* get argument count */
339           call ring1_setup;
340           go to syserr_start;                               /* normal ring0 entry starts here */
341 
342 
343 ring1_error_code:
344      entry (arg_code, arg_error_code);
345 
346           cs_pos = 3;                                       /* control string is 3rd  */
347           call arg_count_ (nargs);                          /* get argument count */
348           call ring1_setup;
349           go to syserr_error_start;                         /* ring0 entry starts here */
350 
351 
352 ring1_binary:
353      entry (arg_code, arg_data_ptr, arg_data_code, arg_data_len);
354 
355           cs_pos = 5;                                       /* control string is 5th */
356           call arg_count_ (nargs);                          /* get argument count */
357           call ring1_setup;
358           go to syserr_binary_start;
359 
360 
361 ring1_multiple_binary:
362      entry (arg_code, arg_data_pieces_array_ptr, arg_n_data_pieces, arg_data_code);
363           cs_pos = 5;
364           call arg_count_ (nargs);                          /* get argument count */
365           call ring1_setup;
366           goto syserr_multiple_binary_start;
367 %page;
368 COMMON:
369           wired = "0"b;
370           on cleanup
371                begin;                                       /* locks will be unlocked by verify_lock */
372                if wired then call pmut$unwire_unmask (wire_arg, wired_stack_ptr);
373           end;
374           copying_permitted = "0"b;
375 
376           sd_ptr = addr (syserr_data$syserr_area);
377 
378           call pmut$read_mask (old_mask);
379           if old_mask = scs$open_level then                 /* allowing interrupts */
380                if pds$apt_ptr ^= prds$idle_ptr then         /* Not an idle process */
381                     if stackbaseptr () ^= addr (prds$) then /* Not on the PRDS */
382                          if ^termp_flags (sys_code)
383                               & ^crash_flags (sys_code) then/* not if process/system will disappear */
384                               if sd.log_flag then           /* WARNING, this is a paged database. */
385                                                             /* The following tree touches it IFF all the other conditions are satisfied. */
386                                    if addr (syserr_log_data$) -> syserr_log_data.lock.pid ^= pds$processid then
387                                                             /* Not in the middle of copying the log already */
388                                         copying_permitted = "1"b; /* All these pass? then we can copy here. */
389 
390           write_flag = write_flags (sys_code);              /* Set flag if message is to be written */
391           alarm_flag = alarm_flags (sys_code);              /* set flag if alarm needed */
392 
393           rtime = clock ();                                 /* Get raw time in microseconds. */
394 
395           auto_wmess_header.code = code;                    /* fill in wmess header that we can unwired */
396           auto_wmess_header.time = rtime;
397           auto_wmess_header.pad = "0"b;
398           auto_wmess_header.process_id = pds$processid;
399           auto_wmess_header.data_code = data_code;
400 
401           wired_wlog_ptr = addr (syserr_data$wired_log_area);
402                                                             /* place for old messages */
403           if copying_permitted then do;                     /* when we can copy, we get and hold the paged lock.
404                                                                The wired area is emptied into the paged log, and then we add
405                                                                our message to the paged log.  Our message never goes into the
406                                                                wired area. */
407                call syserr_copy$lock ();
408                old_wlog_ptr = wired_utility_$grow_stack_frame (syserr_data$wired_log_size);
409           end;
410 
411           call pmut$wire_and_mask (wire_arg, wired_stack_ptr);
412           wired = "1"b;
413 
414 /* Before we reference any data in syserr_data we may have to lock it.
415    Note, this lock controls all the data in syserr_data including the wired_log_area. */
416 
417           if ^sd.ocdcm_init_flag then call panic (mbuf.text);
418 
419           call SR_LOCK ();
420 
421 /* Now fill in the time of message string that goes before each message.
422    It is in the form:  "hhmm.t  ". */
423 
424           print_ptr = addr (mbuf.time);                     /* For now, console message starts with time. */
425           print_len = message_len + length (string (mbuf.time)); /* Get total length of string being written. */
426 
427           tenths_min = mod (divide (rtime - sys_info$time_correction_constant, 6000000, 52, 0), 14400);
428                                                             /* Number of 10ths of minutes so far today */
429           auto_mbuf.header.time.hh = divide (tenths_min, 600, 5);
430           auto_mbuf.header.time.mmt = tenths_min - divide (tenths_min, 600, 5) * 600;
431           auto_mbuf.header.time.pad = "";
432 %page;
433           if ^sd.log_flag then                              /* Is logging mechanism ON? */
434                                                             /* NO, can't log message. */
435                auto_wmess_header.seq_num = 0;               /* Thus there is no sequence number. */
436           else if copying_permitted then do;
437 
438 /* look for old messages to copy out */
439 
440                if wired_wlog_ptr -> wlog.count > 0 then do;
441                     old_wlog_ptr -> old_wlog = wired_wlog_ptr -> old_wlog; /* copy out old messages */
442                     wired_wlog_ptr -> wlog.next = rel (addr (wired_wlog_ptr -> wlog.buffer)); /* reset wired log */
443                     wired_wlog_ptr -> wlog.count = 0;
444                end;
445                else old_wlog_ptr -> wlog.count = 0;         /* no old messages */
446 
447                auto_wmess_header.seq_num, wired_wlog_ptr -> wlog.seq_num = wired_wlog_ptr -> wlog.seq_num + 1;
448           end;
449 %page;
450 
451 /* This code is entered to put the current syserr message into the wired log.
452    Each time this procedure is called we want to wake up the syserr
453    logger HPROC who takes the messages out of the wired log buffer. */
454 
455           else do;
456 
457 /* Get pointer to this message entry.  We have to fill in the length of the
458    text before we know where the end of the entry will be.  Assume for now that
459    there is room for this message. */
460 
461                wired_wmess_ptr = ptr (wired_wlog_ptr, wired_wlog_ptr -> wlog.next);
462 
463 RETRY_ADD:                                                  /* here to retry with a shrunk message */
464 
465 /* Now check to see if there really is room for this message entry in the wired buffer.
466    If not, we will have to write out the message with a special prefix:
467    "*lost xxxxxx, z "
468    where   xxxxxx  is the sequence number of the message, and
469    z       is the syserr code of the message. */
470 
471                if wmess_len > (size (wlog_header) + wired_wlog_ptr -> wlog.bsize)
472                     - (bin (wired_wlog_ptr -> wlog.next, 18) - wordno (wired_wlog_ptr)) then do;
473                                                             /* Is entry too big?  Do this if YES. */
474                     if binary_call then do;                 /* First try throwing away binary data */
475                          binary_call = "0"b;                /* by making it no longer a binary call */
476                          wmess_len = wmess_len - auto_wmess_header.data_size;
477                          auto_wmess_header.data_size = 0;
478                          go to RETRY_ADD;
479                     end;
480 
481                     auto_wmess_header.seq_num,              /* Get sequence number of this message. */
482                          wired_wlog_ptr -> wlog.seq_num = wired_wlog_ptr -> wlog.seq_num + 1; /* claim sequence number now. */
483 
484                     if wifnl_flags (sys_code) then do;      /* If message should be written if not logged */
485                          write_flag = "1"b;                 /* causes message to be written */
486                          print_ptr = addr (mbuf.no_log);    /* Now writing special note.  */
487                          print_len = print_len + length (string (mbuf.no_log));
488                          auto_mbuf.header.no_log.lost = "*lost"; /* initialize work area */
489                          auto_mbuf.header.no_log.comma = ",";
490                          auto_mbuf.header.no_log.pad = "";
491                          auto_mbuf.header.no_log.seq_num = mod (auto_wmess_header.seq_num, 10000);
492                                                             /* edit sequence number */
493                          auto_mbuf.header.no_log.sys_code = sys_code; /* edit code */
494                     end;
495                end;
496                else do;
497 
498 /* There is room for this message in the wired log.  Thus we can fill in the entry. */
499 
500                     auto_wmess_header.seq_num,              /* Get sequence number of this message. */
501                          wired_wlog_ptr -> wlog.seq_num = wired_wlog_ptr -> wlog.seq_num + 1; /* now that we know for sure that we are sending it. */
502 
503                     wired_wlog_ptr -> wlog.next = bit (add (bin (wired_wlog_ptr -> wlog.next, 18), wmess_len, 18), 18); /* Incr address of where next entry goes. */
504                     wired_wlog_ptr -> wlog.count = wired_wlog_ptr -> wlog.count + 1; /* Add message to log buffer. */
505 
506                     wmess_ptr -> wmess.header = auto_wmess_header; /* construct wmess_header in front of message */
507                     wired_wmess_ptr -> wmess_copy = wmess_ptr -> wmess_copy; /* add wmess to syserr_data */
508                end;
509 
510                call WAKEUP_DAEMON;                          /* move these messages! */
511           end;
512 %page;
513 /* If we don't have to write this message then we are all done.  If we must write it then
514    we must first convert it for console output.   Note, a maximum of 80 characters can
515    be typed on one line.  With the "no_log" and "time" strings at the beginning of the
516    line and since ASCII characters may convert into more than one typed character, it is
517    possible the output string will be too long.  In this case the line will be
518    continued.  Note, the message itself may consist of more than one line. */
519 
520           if write_flag then do;                            /*  write - code is (4 - 9). */
521 
522 /* Check here for a non-alarm syserr message being the same as the last message written.
523    If this is the case, only an "=" will be printed. */
524 
525                if ^alarm_flag & mbuf.text = sd.prev_text_written then do;
526                                                             /* A match */
527                     print_len = print_len - message_len + 1;
528                     message_len = 1;                        /* set length to 1 character */
529                     print_ptr = addrel (addr (auto_mbuf), wordno (print_ptr) - wordno (mbuf_ptr)); /* lie - tell ocdcm_ to print only this header */
530                     if mbuf.text ^= " " then auto_mbuf.equal = "=";
531                     else auto_mbuf.equal = "";
532                                                             /* substitute "=" unless blank message */
533                end;
534                else do;                                     /* New message */
535                     if message_len > length (sd.prev_text_written) then /* too long to save */
536                          unspec (sd.prev_text_written) = "0"b;
537                                                             /* so clear out old message */
538                     else sd.prev_text_written = substr (mbuf.text, 1, message_len);
539                                                             /* save text */
540                     mbuf_ptr -> mbuf_header = auto_mbuf.header; /* get the real mbuf header in front of the message for printing */
541                end;
542           end;
543 %page;
544 /* Syserr data has been globally updated.  Now we need to write the actual message, which is done from data in the stack. */
545 
546           call SR_UNLOCK;                                   /* Unlock syserr data */
547 
548           if write_flag then do;
549                optr = addr (out_buf);                       /* Pointer to output buffer. */
550                cont_flag = "0"b;                            /* => 1st line of message.  oc_trans_output_ turns
551                                                                it ON in case of a continuation line.  */
552 
553 /* Each iteration processes 1 console output line.
554    There may be more than one line in the syserr
555    message or there may be a continuation line. */
556 
557 
558                call ocdcm_$console_info ("", "0"b, "", 0, oc_line_leng, ocdcm_code);
559                                                             /* get console line length...           */
560                if ocdcm_code ^= 0 then oc_line_leng = 80;   /* default line length...               */
561 
562                do while (print_len > 0);
563                     call oc_trans_output_ (print_ptr, print_len, print_this_line_len, optr, olen, oc_line_leng, cont_flag);
564                     oc_printed_leng = multiply (olen, 4, 17);
565 
566                     oc_io.read = "0"b;
567                     oc_io.alert = alarm_flag;
568                     oc_io.sequence_no = auto_wmess_header.seq_num;
569                     oc_io.event_chan = 0;
570 
571                     if print_this_line_len >= print_len then do; /* this is the last line - add CR NL */
572                          oc_printed_leng = length (rtrim (substr (out_buf, 1, oc_printed_leng), byte (127))); /* actual last char */
573                          substr (out_buf, oc_printed_leng + 1, 5) = CR_NL;
574                          olen = divide (oc_printed_leng + 5, 4, 17); /* 2 for cr/nl, 3 for rounding up to word */
575                          oc_printed_leng = multiply (olen, 4, 17);
576                     end;
577 
578 /* advance for next line */
579                     print_ptr = addcharno (print_ptr, print_this_line_len);
580                     print_len = print_len - print_this_line_len;
581                     alarm_flag = "0"b;                      /* Don't want alarm ON more than once. */
582 
583                     oc_io.leng = olen;
584                     oc_io.text = substr (out_buf, 1, oc_printed_leng);
585 
586                     call ocdcm_$priority_io (addr (oc_io)); /* do the I/O...*/
587                end;
588 %page;
589 
590 /*        Now check to see if we have to terminate the process or CRASH the system.  */
591 
592                if termp_flags (sys_code) then do;           /* If process to be terminated */
593                     call syserr_real$syserr_real (LOG, terminate_msg, pds$process_group_id);
594                     call pmut$set_mask (scs$open_level);    /* Unmask so that recursive call wires */
595                     call terminate_proc (error_table_code);
596                end;
597 
598 
599                else if crash_flags (sys_code) then do;      /* If system is to crash */
600 
601 /* TOO BAD we must CRASH.  Before we call bce we must be sure that all of the messages on
602    the ocdcm_ syserr write queue have been written.  We will call a special entry
603    in  ocdcm_ which completes all pending I/O. */
604 
605                     call syserr_real$syserr_real (ANNOUNCE, crash_msg, pds$process_group_id);
606 
607                     call ocdcm_$drain_io ();                /* flush pending I/O...                 */
608 
609                     call pmut$bce_and_return;
610                end;
611           end;
612 %page;
613 
614 /* Time to leave */
615 
616           call pmut$unwire_unmask (wire_arg, wired_stack_ptr);
617 
618           if copying_permitted then do;
619                if old_wlog_ptr -> wlog.count > 0 then call syserr_copy$wired_log (old_wlog_ptr);
620                wlog_ptr -> wlog_header = auto_wlog_header;  /* reconstruct wlog header before text */
621                wlog.count = 1;
622                wmess_ptr -> wmess_header = auto_wmess_header;
623                call syserr_copy$wired_log (wlog_ptr);       /* add in our new message */
624                call syserr_copy$unlock;
625           end;
626           return;
627 %page;
628 /* All this entry does is force the  sd.lock  OFF.  */
629 
630 syserr_reset:
631      entry;
632 
633           addr (syserr_data$syserr_area) -> sd.lock = "0"b;
634 
635           return;
636 
637 
638 /* This entry is called if syserr is called before the IOM and operator's
639    console software has been initialized.  It is also called when trouble
640    is encountered in syserr or ocdcm_. */
641 
642 panic:
643      entry (arg_panic_mess);
644 
645           fgbxp = addr (flagbox$);                          /* Get pointer to bce flagbox. */
646           fgbx.message = arg_panic_mess;                    /* Copy the message. */
647           fgbx.alert, fgbx.mess = "1"b;                     /* Turn on flag bits. */
648 
649           do while ("1"b);                                  /* Back to bce. */
650                call pmut$bce_and_return;
651           end;
652 %page;
653 
654 /* common processing for ring 1 calls */
655 
656 ring1_setup:
657      proc;
658 
659           binary_call = "0"b;                               /* defaults */
660           data_code = 0;
661           error_table_call = "0"b;
662 
663           if nargs < cs_pos then do;                        /* if not enough */
664                call syserr (4, bad_ring1_msg);
665                go to ring1_return;
666           end;
667           code = arg_code;                                  /* copy the code */
668           sys_code = mod (code, 10);                        /* compute action code */
669           code = divide (code, 10, 17, 0);                  /* check sort code */
670           if code < 0 | code > 24 then code = 24;           /* apply default if out of range */
671           code = 10 * code + sys_code;                      /* this is new code after errors removed */
672 
673      end ring1_setup;
674 
675 
676 ring1_return:
677           return;                                           /* nonlocal return from ring1_setup */
678 
679 
680 ring0_setup: proc;
681 
682           binary_call = "0"b;                               /* defaults */
683           data_code = 0;
684           error_table_call = "0"b;
685 
686           code = arg_code;                                  /* copy syserr code */
687           sys_code = mod (code, 10);                        /* compute action code */
688           return;
689      end ring0_setup;
690 %page;
691 
692 /* This internal procedure is called to unlock the wired log.  */
693 
694 SR_UNLOCK:
695      procedure;
696 
697           if stacq (sd.lock, "0"b, sd.lock) then ;          /* Unlock unconditionally */
698 
699      end SR_UNLOCK;
700 
701 SR_LOCK:
702      procedure;
703 
704           if sd.lock = pds$processid then call panic (lock_msg);
705           do while (^stac (addr (sd.lock), pds$processid));
706           end;
707           return;
708      end SR_LOCK;
709 
710 WAKEUP_DAEMON:
711      procedure;
712 
713           call pxss$unique_ring_0_wakeup (syserr_data$logger_proc_id, syserr_data$logger_ec, 0, (0));
714           return;
715      end WAKEUP_DAEMON;
716 %page;
717 SETUP_AND_TEXT:
718      proc;
719 
720 /* allocate a wlog structure to hold our message;
721    generate the text of the message */
722 
723 dcl  len_for_et                         fixed bin;
724 dcl  max_header_size                    fixed bin;
725 dcl  text_and_data_size                 fixed bin;
726 dcl  work_ptr                           ptr;
727 
728           auto_wmess_header.text_len, message_len = 2047;   /* maximum */
729           auto_wmess_header.data_size = data_len;
730 
731           text_and_data_size = currentsize (addr (auto_wmess_header) -> wmess); /* how much a wmess corresponding to this auto header would need */
732 
733           max_header_size = max (size (wlog_header) + size (wmess_header), size (mbuf_header));
734 
735           work_ptr = wired_utility_$grow_stack_frame (max_header_size + text_and_data_size); /* Allocate message buffer. */
736 
737           wlog_ptr = addrel (work_ptr, max_header_size - (size (wlog_header) + size (wmess_header)));
738           wmess_ptr = addrel (wlog_ptr, size (wlog_header));
739           mbuf_ptr = addrel (work_ptr, max_header_size - size (mbuf_header));
740 
741           call formline_ (cs_pos, cs_pos + 1, addr (wmess.text), message_len, 1, arg_list_ptr);
742                                                             /* Expand syserr message. */
743 
744           if message_len = 0 then do;                       /* if asked to write null message, be careful */
745                substr (wmess.text, 1, 4) = "";              /* clear text buffer */
746                message_len = 1;                             /* write 1 blank */
747           end;
748 
749           error_table_code = -9;
750           if error_table_call then do;                      /* If passed an error table code */
751                etmsgp = arg_error_code;                     /* Copy packed pointer. */
752                unspec (error_table_code) = unspec (arg_error_code);
753                if baseno (etmsgp) = "077777"b3 then         /* If segment is -1 ... */
754                     etmsgp = ptr (addr (error_table_$), rel (etmsgp));
755                                                             /* Use error_table_. */
756                if segno (etmsgp) = 0 then error_table_code = -9;
757                else do;
758                     len_for_et = auto_wmess_header.text_len - message_len;
759                                                             /* Amount of room left to insert message */
760                     len_for_et = min (len_for_et, et.len + 1);
761                     if len_for_et > 0 then do;
762                          substr (wmess.text, message_len + 1, 1) = " ";
763                          substr (wmess.text, message_len + 2, len_for_et - 1) = et.msg;
764                                                             /* Concatenate message on end */
765                          message_len = message_len + len_for_et;
766                                                             /* Adjust message length */
767                     end;
768                end;
769           end;
770 
771           auto_wmess_header.text_len = message_len;
772           wmess_len = currentsize (addr (auto_wmess_header) -> wmess);
773           data_ptr = addrel (wmess_ptr, wmess_len - data_len);
774           return;
775      end SETUP_AND_TEXT;
776 %page; %include flagbox;
777 %page; %include oc_data;
778 %page; %include syserr_actions;
779 %page; %include syserr_constants;
780 %page; %include syserr_data;
781 %page; %include syserr_log_dcls;
782 %page;
783 /*        BEGIN MESSAGE DOCUMENTATION
784 
785    Message:
786    syserr: Mylock error.
787 
788    S:     $crash
789 
790    T:     $run
791 
792    M:     $err
793 
794    A:     $recover
795 
796 
797    Message:
798    Now terminating user process: PERSON.PROJ.
799 
800    S:     $info
801 
802    T:     $run
803 
804    M:     This line is always preceded by an explanation
805    of the error which required the terminaation of the user process
806    PERSON.PROJ.
807 
808    A:     $ignore
809 
810 
811    Message:
812    Multics not in operation; control process: PERSON.PROJ.
813 
814    S:     $crash
815 
816    T:     $run
817 
818    M:     This message is always preceded
819    by an explanation of the error which crashed the system.
820 
821    A:     $recover
822 
823 
824    Message:
825    syserr: Bad ring 1 call.
826 
827    S:     $log
828 
829    T:     $run
830 
831    M:     A bad call to syserr was made from ring 1.
832    The system keeps running.
833 
834    A:     $ignore
835 
836 
837    END MESSAGE DOCUMENTATION */
838 
839      end syserr_real;