1 /****^  **************************************************************
  2         *                                                            *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                   *
  4         *                                                            *
  5         * Copyright, (C) Massachusetts Institute of Technology, 1983 *
  6         *                                                            *
  7         ************************************************************** */
  8 
  9 /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
 10 
 11 lap_simplex:
 12      procedure;
 13 
 14 /*
 15    This procedure is the trivial multiplexer which is used to gain direct access to the
 16    FNP LAP implementation for use by the ARPAnet HDH interface. It contains both the
 17    wired and nonwired entrypoints, since it's so small.
 18 */
 19 
 20 /*
 21    Coded December 1978 by J. Stern
 22    Modified 7/31/79 by B.Westcott to support lap instead.
 23    Modified November 1979 by C. Hornig for installation.
 24    Modified August 1981 by C. Hornig to add metering.
 25    Modified May 1982 by D. W. Cousins for deletion of HOST level2 mpx.
 26    Modified January 1983 by W. Olin Sibert to create lap_simplex (again!)
 27    Modified 6/23/83 by Jis to wire itself down when first invoked
 28    Modified Nov 1986 by T. Beecher to correctly adjust buffer.tally for
 29    insertion of L2_HEADER_PAD, to handle "frame-size" error @ line-status
 30    interrupt, and to remove local copies of error_table codes.
 31    Note:  the lap_cmdr_status structure was copied from x25_mpx.pl1.
 32 */
 33 
 34 /****^  HISTORY COMMENTS:
 35   1) change(88-07-07,Beattie), approve(88-06-27,MCR7926),
 36      audit(88-07-22,Brunelle), install(88-08-08,MR12.2-1082):
 37      Prepared for installation.
 38                                                    END HISTORY COMMENTS */
 39 
 40 /* * * * * * * * * * * INTERRUPT * * * * * * * * * * */
 41 
 42 lap_simplex$interrupt:
 43      entry (P_lap_data_ptr, P_int_type, P_int_data);
 44 
 45           lap_data_ptr = P_lap_data_ptr;
 46           int_type = P_int_type;
 47           int_data = P_int_data;
 48 
 49           if (int_type < lbound (INTERRUPT, 1)) | (int_type > hbound (INTERRUPT, 1)) then do;
 50 BAD_INTERRUPT:
 51                call syserr (Log_message, "lap_simplex(^a): Unexpected interrupt ^d ^.3b received.", lap_data.name,
 52                     int_type, int_data);
 53                return;
 54                end;
 55           else goto INTERRUPT (int_type);
 56 
 57 
 58 INTERRUPT (1):                                              /* DIALUP - major channel has dialed up */
 59           if (lap_data.state ^= LAP_LISTENING) then goto BAD_INTERRUPT;
 60           unspec (lap_data.dialup_info) = int_data;         /* Remember it, and send it on */
 61           lap_data.sc_dialup_info = lap_data.dialup_info;   /* Construct new version */
 62           lap_data.sc_dialup_info.buffer_pad = L2_HEADER_PAD;
 63           lap_data.sc_dialup_info.line_type = LINE_ASCII;
 64 
 65           call pxss$ring_0_wakeup (lap_data.load_process_id, lap_data.load_event_channel, MPX_UP, ignore_code);
 66           lap_data.state = LAP_ACTIVE;                      /* Tell the Initializer we're here */
 67           return;
 68 
 69 
 70 INTERRUPT (2):                                              /* HANGUP - major channel has hung up */
 71           call crash (int_type);
 72           return;
 73 
 74 
 75 INTERRUPT (3):                                              /* CRASH - parent multiplexer has died */
 76           call crash (int_type);
 77           return;
 78 
 79 
 80 INTERRUPT (4):                                              /* SEND_OUTPUT - it's safe to write next output frame now */
 81           lap_data.flags.send_output = "1"b;
 82           call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, (""b));
 83           return;
 84 
 85 
 86 INTERRUPT (5):                                              /* INPUT_AVAILABLE */
 87           goto BAD_INTERRUPT;
 88 
 89 
 90 INTERRUPT (6):                                              /* ACCEPT INPUT - process an input frame */
 91           unspec (rtx_info) = int_data;
 92           blockp = pointer (lap_data_ptr, rtx_info.chain_head);
 93           real_buffer_lth = buffer.tally - L2_HEADER_PAD;
 94 
 95           if ((lap_data.state < LAP_ACTIVE) | (real_buffer_lth <= 0)) then do;
 96                call tty_space_man$free_chain (lap_data.devx, INPUT, blockp);
 97                goto BAD_INTERRUPT;                          /* Packet either too small or arrived at a bad time */
 98                end;
 99 
100           call tty_space_man$switch_chain (lap_data.devx, lap_data.subchannel, INPUT, INPUT, blockp);
101                                                             /* Be sure to switch BEFORE shrinking.... */
102           begin;                                            /* Shift the characters over to eliminate the LAP */
103 dcl  old_string char (real_buffer_lth) automatic;           /* header bytes */
104 dcl  new_string char (real_buffer_lth) defined (buffer.chars);
105                old_string = substr (string (buffer.chars), L2_HEADER_PAD + 1, real_buffer_lth);
106                new_string = old_string;
107           end;
108 
109           buffer.tally = buffer.tally - L2_HEADER_PAD;
110           rtx_info.input_count = rtx_info.input_count - L2_HEADER_PAD;
111 
112           blockp = pointer (blockp, rtx_info.chain_tail);   /* Set the sentinel bit in the last char (just like */
113           begin;                                            /* the one we get when writing) */
114 dcl  last_char char (1) unaligned defined (buffer.chars (buffer.tally - 1));
115                unspec (last_char) = unspec (last_char) | "400"b3;
116           end;
117 
118           call channel_manager$interrupt (lap_data.subchannel, ACCEPT_INPUT, unspec (rtx_info));
119           return;                                           /* Otherwise, just send it on */
120 
121 
122 INTERRUPT (7):                                              /* INPUT REJECTED - ignore */
123 INTERRUPT (8):                                              /* QUIT - ignore */
124           return;
125 
126 
127 INTERRUPT (9):                                              /* LINE_STATUS - LAP link has gone down */
128           unspec (lap_down_status) = int_data;
129 
130           if lap_down_status.status_type = 1
131           then call syserr (Log_message,
132                     "lap_simplex(^a): Failure, Link state: ^a, Current action: ^a, in ^a, Primary state: ^a, Secondary state: ^a",
133                     lap_data.name, FRAME_STATE_ARRAY (lap_down_status.main_state),
134                     FRAME_FUNCTION_CODE (lap_down_status.last_function_process),
135                     FRAME_SUB_STATE_ARRAY (lap_down_status.which_state_process),
136                     FRAME_SUB_STATE_ARRAY (lap_down_status.primary_sub_state),
137                     FRAME_SUB_STATE_ARRAY (lap_down_status.secondary_sub_state));
138 
139           else if lap_cmdr_status.cmdr_status = 3
140           then call syserr (Log_message,
141                     "lap_simplex(^a): Link disconnected due to mis-matched frame sizes. CMDR/FRMR frame: ^( ^.4b^).",
142                     lap_data.name, lap_cmdr_status.cmdr_bytes.byte (*));
143 
144           else goto BAD_INTERRUPT;                          /* We don't know this status. */
145 
146           return;                                           /* FNP will send hangup itself. */
147 
148 
149 INTERRUPT (10):                                             /* DIAL STATUS - ignore */
150 INTERRUPT (11):                                             /* WRU TIMEOUT - ignore */
151           goto BAD_INTERRUPT;
152 
153 
154 INTERRUPT (12):                                             /* SPACE AVAILABLE - some buffer space was freed that we need */
155           call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, ""b);
156           return;                                           /* If we didn't ask, ignore it */
157 
158 
159 INTERRUPT (13):                                             /* ACKNOWLEDGE_ECHNEGO_INIT */
160 INTERRUPT (14):                                             /* ACKNOWLEDGE_ECHNEGO_STOP */
161           return;                                           /* Ignore both of these */
162 
163 
164 INTERRUPT (15):                                             /* TIMER */
165 INTERRUPT (16):                                             /* USER_INTERRUPT */
166           goto BAD_INTERRUPT;
167 
168 
169 INTERRUPT (17):                                             /* MASKED - treat like HANGUP but use different wakeup message */
170           call pxss$ring_0_wakeup (lap_data.load_process_id, lap_data.load_event_channel, MPX_MASKED, code);
171           call crash (MASKED);
172           lap_data.state = LAP_HUNGUP;
173           return;
174 %page;
175 /* * * * * * * * * * * WRITE * * * * * * * * * * */
176 
177 lap_simplex$write:
178      entry (P_lap_data_ptr, P_subchan_idx, P_chain_ptr, P_code);
179 
180           call setup ();
181 
182           code = 0;
183           chain_ptr = P_chain_ptr;
184           next_block = binary (rel (chain_ptr), 18);
185 
186           do while ((next_block ^= 0) & lap_data.send_output);
187                blockp = pointer (chain_ptr, next_block);
188 
189 /*
190    The following statement generates miserable code, in that it invokes the pessimal search operator.
191    Clearly, it could be optimized, and, indeed, it turns out that search (XXX, collate) is thusly
192    optimized, so it's probably not even that hard to fix.
193 */
194 
195                frame_end = search (substr (string (buffer.chars), 1, buffer.tally), substr (collate9 (), 257, 256));
196 
197                if frame_end = 0 then do;                    /* Buffer contains the middle of a frame */
198                     next_block = buffer.next;               /* Just add it on and try the next buffer */
199                     call add_buffer_to_frame ();            /* in the chain */
200                     end;
201 
202                else if frame_end = buffer.tally then do;    /* Buffer ends a frame. Add it on, try to write */
203                     next_block = buffer.next;               /* it out, and go on to the next buffer */
204                     lap_data.frame_ready = "1"b;
205                     call add_buffer_to_frame ();
206                     end;
207 
208                else do;                                     /* Frame ends in the middle of a buffer. */
209                     call split_buffer ();
210                     lap_data.frame_ready = "1"b;            /* Guaranteed to be ready after splitting */
211                     call add_buffer_to_frame ();            /* This adds on only the old half */
212                     end;
213 
214                if lap_data.frame_ready then call write_frame ();
215           end;
216 
217 WRITE_FINISHES:
218           if (next_block = 0)
219           then P_chain_ptr = null ();
220           else P_chain_ptr = pointer (chain_ptr, next_block);
221 
222           if lap_data.send_output then call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, ""b);
223 
224           P_code = code;
225           return;
226 %page;
227 /* * * * * * * * * * * ADD_BUFFER_TO_FRAME * * * * * * * * * * */
228 
229 add_buffer_to_frame:
230      procedure ();
231 
232           if (buffer.tally + lap_data.frame_size) > lap_data.max_frame_size then do;
233                call syserr (Log_message, "lap_simplex(^a): Attempt to write overlength frame.", lap_data.name);
234                call crash (HANGUP);
235                call free_pending_frame ();
236                end;
237 
238           lap_data.frame_size = lap_data.frame_size + buffer.tally;
239           buffer.next = 0;                                  /* Break the chain before adding on */
240           string (buffer.flags) = ""b;
241 
242           if (lap_data.frame_start ^= null ())
243           then                                              /* Add it to the end if there's something there */
244                lap_data.frame_end -> buffer.next = binary (rel (blockp), 18);
245           else lap_data.frame_start = blockp;               /* Otherwise, remember the first */
246 
247           lap_data.frame_end = blockp;                      /* And always remember the end */
248 
249           return;
250      end add_buffer_to_frame;
251 %page;
252 /* * * * * * * * * * SPLIT_BUFFER * * * * * * * * * * */
253 
254 split_buffer:
255      procedure ();
256 
257 dcl  leftover_chars fixed bin;
258 dcl  new_buf_size fixed bin;
259 dcl  new_bufp pointer;
260 
261 /*
262    This procedure is invoked when a frame terminator is found in the middle of a buffer. It splits
263    the buffer in two, copies the extra characters into the new one, shrinks the old one, and
264    adjusts next_block so that the new one will be the next one considered.
265 */
266 
267           leftover_chars = buffer.tally - frame_end;
268 
269           new_buf_size = 16 * (1 + divide ((leftover_chars + 7), 64, 17, 0));
270           call tty_space_man$get_buffer (lap_data.subchannel, new_buf_size, OUTPUT, new_bufp);
271           if (new_bufp = null ()) then do;                  /* If this fails, it means we return the buffer we split */
272                call tty_space_man$needs_space (lap_data.devx);
273                                                             /* to our caller, and let him ship it back to us some */
274                lap_data.send_output = "0"b;                 /* other time. It gets shipped back because, at this */
275                goto WRITE_FINISHES;                         /* point, next_block still indicates the buffer being */
276                end;                                         /* considered for splitting. */
277 
278           substr (string (new_bufp -> buffer.chars), 1, leftover_chars) =
279                substr (string (buffer.chars), frame_end + 1, leftover_chars);
280           new_bufp -> buffer.next = buffer.next;
281           new_bufp -> buffer.tally = leftover_chars;
282           string (new_bufp -> buffer.flags) = ""b;
283 
284           next_block = binary (rel (new_bufp), 18);         /* Now, the new buffer will be the one we look at next */
285 
286           buffer.tally = buffer.tally - leftover_chars;     /* Shrink the old one, and return */
287 
288           return;
289      end split_buffer;
290 %page;
291 /* * * * * * * * * * WRITE_FRAME * * * * * * * * * * */
292 
293 write_frame:
294      procedure ();
295 
296 dcl  bufp pointer;
297 dcl  bufl fixed bin;
298 
299 
300           lap_data.frame_end -> buffer.break = "1"b;        /* Since this IS the end */
301 
302           bufp = lap_data.frame_start;                      /* Shift first buffer right to make room for the */
303           bufl = bufp -> buffer.tally;                      /* LAP header */
304 
305           begin;                                            /* copy the characters over, avoiding overlap */
306 dcl  old_string char (bufl) automatic;
307 dcl  new_string char (bufl) defined (bufp -> buffer.chars (L2_HEADER_PAD));
308                old_string = substr (string (bufp -> buffer.chars), 1, bufl);
309                new_string = old_string;
310           end;
311 
312           bufp -> buffer.tally = bufp -> buffer.tally + L2_HEADER_PAD;
313                                                             /* Update the tally to say that the  */
314                                                             /* header is there */
315 
316           call tty_space_man$switch_chain (lap_data.subchannel, lap_data.devx, OUTPUT, OUTPUT, lap_data.frame_start);
317 
318           call channel_manager$write (lap_data.devx, lap_data.frame_start, code);
319           if (code ^= 0) then do;
320                call syserr$error_code (Log_message, code, "lap_simplex(^a): Error from write of ^d chars.", lap_data.name,
321                     lap_data.frame_size);
322                call free_pending_frame ();
323                call channel_manager$control (lap_data.devx, "hangup", null (), ignore_code);
324                return;
325                end;
326 
327           if (lap_data.frame_start ^= null ()) & (lap_data.frame_start ^= bufp) then do;
328                call syserr (Log_message, "lap_simplex(^a): Write failed to take whole frame, discarding rest.",
329                     lap_data.name);
330                call free_pending_frame ();
331                return;
332                end;
333 
334           if (lap_data.frame_start = null ()) then do;
335                lap_data.frame_end = null ();
336                lap_data.frame_size = 0;
337                lap_data.frame_ready = "0"b;
338                lap_data.send_output = "1"b;                 /* Try it over again */
339                end;
340           else lap_data.send_output = "0"b;                 /* Didn't take the frame, so wait */
341 
342           return;
343      end write_frame;
344 %page;
345 /* * * * * * * * * * * CONTROL * * * * * * * * * * */
346 
347 lap_simplex$control:
348      entry (P_lap_data_ptr, P_subchan_idx, P_order, P_info_ptr, P_code);
349 
350           call setup ();
351 
352           order = P_order;
353           info_ptr = P_info_ptr;
354           code = 0;
355 
356           if (order = "hangup") then do;
357                if (lap_data.state = LAP_HUNGUP)
358                then code = error_table_$invalid_state;
359                else call channel_manager$control (lap_data.devx, "hangup", null (), code);
360                end;
361 
362           else if (order = "listen") then do;
363                if (lap_data.state ^= LAP_ACTIVE)
364                then code = error_table_$invalid_state;
365                else do;
366                     call channel_manager$interrupt (lap_data.subchannel, DIALUP, unspec (lap_data.sc_dialup_info));
367                     call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, ""b);
368                     end;
369                end;
370 
371           else if (order = "abort") then do;
372                if (info_ptr = null ())
373                then code = error_table_$null_info_ptr;
374                else call free_pending_frame ();
375                end;
376 
377           else if (order = "write_status") then do;
378                if (info_ptr = null ())
379                then code = error_table_$null_info_ptr;
380                else do;
381                     if (lap_data.frame_size ^= 0)
382                     then info_ptr -> tty_write_status_info.output_pending = "1"b;
383                     else call channel_manager$control (lap_data.devx, "write_status", info_ptr, code);
384                     end;
385                end;
386 
387           else if (order = "wru") then do;
388                if (lap_data.state ^= LAP_ACTIVE)
389                then code = error_table_$invalid_state;
390                else call channel_manager$interrupt (lap_data.subchannel, WRU_TIMEOUT, ""b);
391                end;
392 
393           else code = error_table_$undefined_order_request;
394 
395           P_code = code;
396           return;
397 %page;
398 /* * * * * * * * * * * CHECK_MODES * * * * * * * * * */
399 
400 lap_simplex$check_modes:
401      entry (P_lap_data_ptr, P_subchan_idx, P_mcl_info_ptr, P_code);
402 
403           call do_modes ("0"b);
404           return;
405 
406 /* * * * * * * * * * SET_MODES * * * * * * * * * */
407 
408 lap_simplex$set_modes:
409      entry (P_lap_data_ptr, P_subchan_idx, P_mcl_info_ptr, P_code);
410 
411           call do_modes ("1"b);
412           return;
413 
414 /* * * * * * * * * * * GET_MODES * * * * * * * * * * */
415 
416 lap_simplex$get_modes:
417      entry (P_lap_data_ptr, P_subchan_idx, P_modes, P_code);
418 
419           call setup ();
420           P_code = 0;
421           P_modes = "";
422           return;
423 %page;
424 /* * * * * * * * * * * DO_MODES * * * * * * * * * * */
425 
426 do_modes:
427      procedure (P_set_sw);
428 
429 dcl  P_set_sw bit (1) aligned parameter;
430 dcl  mode_error fixed bin (35);
431 
432 
433           call setup ();
434           mclp = P_mcl_info_ptr;
435 
436           if mcl.version ^= mcl_version_2 then do;
437                P_code = error_table_$unimplemented_version;
438                return;
439                end;
440 
441           mode_error = 0;                                   /* The only modes we implement are rawo and rawi, and they */
442                                                             /* must always be turned on */
443           do mode_idx = 1 to mcl.n_entries;
444                mclep = addr (mcl.entries (mode_idx));
445                if (mcle.mode_name = "rawo") | (mcle.mode_name = "rawi") then do;
446                     if ^P_set_sw then mcle.mpx_mode = "1"b;
447                     else if (mcle.mode_switch = "0"b) then do;
448                                                             /* They can only be turned on */
449                          mode_error = error_table_$bad_mode;
450                          mcle.error = "1"b;
451                          end;
452                     end;
453 
454                else if P_set_sw
455                then if (mcle.mpx_mode & ^mcle.force) then do;
456                          mode_error = error_table_$bad_mode;
457                          mcle.error = "1"b;
458                          end;
459 
460                     else mcle.mpx_mode = "0"b;
461           end;
462 
463           P_code = mode_error;
464           return;
465      end do_modes;
466 %page;
467 /* * * * * * * * * * SETUP_SUBCHAN * * * * * * * * * */
468 
469 setup:
470      procedure ();
471 
472           lap_data_ptr = P_lap_data_ptr;
473           if (P_subchan_idx ^= 1) then do;
474                call syserr (Write_with_alarm, "lap_simplex(^a): Invalid subchannel index ^d", lap_data.name, P_subchan_idx);
475                P_code = error_table_$bad_arg;
476                goto SETUP_RETURNS_FOR_ERROR;
477                end;
478 
479           return;
480      end setup;
481 
482 SETUP_RETURNS_FOR_ERROR:
483           return;                                           /* from lap_simplex */
484 
485 
486 /* * * * * * * * * * CRASH * * * * * * * * * */
487 
488 crash:
489      procedure (P_type);
490 
491 dcl  P_type fixed bin parameter;
492 
493 
494           call free_pending_frame ();
495 
496           call channel_manager$interrupt (lap_data.subchannel, P_type, ""b);
497 
498           if (P_type ^= CRASH)
499           then                                              /* Unless he's already obviously aware, */
500                call pxss$ring_0_wakeup (lap_data.load_process_id, lap_data.load_event_channel, MPX_DOWN, code);
501                                                             /* we'd better let daddy know we've been bad */
502           lap_data.state = LAP_HUNGUP;
503 
504           return;
505      end crash;
506 
507 /* * * * * * * * * * FREE_PENDING_FRAME * * * * * * * * * */
508 
509 free_pending_frame:
510      procedure ();
511 
512           if (lap_data.frame_start = null ()) then return;
513 
514           call tty_space_man$free_chain (lap_data.devx, OUTPUT, lap_data.frame_start);
515 
516           lap_data.frame_start = null ();
517           lap_data.frame_end = null ();
518           lap_data.frame_size = 0;
519           lap_data.frame_ready = "0"b;
520 
521           return;
522      end free_pending_frame;
523 %page;
524 /*
525    All the "unwired" entries are below; they share no important code with the operational
526    parts of the multiplexer, only declarations, and are here for packaging reasons only.
527 */
528 
529 /* * * * * * * * * * INIT_MULTIPLEXER * * * * * * * * * */
530 
531 /* Entry to allocate and initialize the multiplexer data base for a given major channel */
532 
533 lap_simplex$init_multiplexer:
534      entry (P_devx, P_miip, P_lap_data_ptr, P_code);
535 
536           devx = P_devx;
537           miip = P_miip;
538           P_lap_data_ptr = null ();
539 
540           if ^init_sw then do;
541                call wire_proc$wire_me;                      /* Chomp on the memories */
542                init_sw = "1"b;
543                end;
544 
545           lap_data_ptr = null ();
546           on cleanup
547                begin;
548                if lap_data_ptr ^= null () then call tty_space_man$free_space (size (lap_data), lap_data_ptr);
549           end;
550 
551           call tty_space_man$get_space (size (lap_data), lap_data_ptr);
552           if lap_data_ptr = null () then do;                /* allocate space for multiplexer data base */
553                P_code = error_table_$noalloc;
554                return;
555                end;
556 
557           lap_data.name = reverse (after (reverse (mux_init_info.channels (1).name), "."));
558           lap_data.devx = devx;
559           lap_data.subchannel = mux_init_info.channels (1).devx;
560           lap_data.state = LAP_HUNGUP;
561           lap_data.frame_start = null ();
562           lap_data.frame_end = null ();
563 
564           lctp = tty_buf$lct_ptr;
565           lctep = addr (lct.lcte_array (lap_data.subchannel));
566           lcte.subchannel = 1;
567 
568           P_lap_data_ptr = lap_data_ptr;
569           P_code = 0;
570           return;
571 %page;
572 /* * * * * * * * * * TERMINATE_MULTIPLEXER * * * * * * * * * */
573 
574 /* Entry to discard the multiplexer data base for a given major channel */
575 
576 lap_simplex$terminate_multiplexer:
577      entry (P_lap_data_ptr, P_code);
578 
579           lap_data_ptr = P_lap_data_ptr;
580           call tty_space_man$free_space (currentsize (lap_data), lap_data_ptr);
581 
582           P_lap_data_ptr = null ();
583           P_code = 0;
584           return;
585 
586 /* * * * * * * * * START * * * * * * * * * */
587 
588 /* Entry to allow dialups on multiplexer subchannels */
589 
590 lap_simplex$start:
591      entry (P_lap_data_ptr, P_code);
592 
593           lap_data_ptr = P_lap_data_ptr;
594           lap_data.simplex_started = "1"b;
595           P_code = 0;
596           return;
597 
598 /* * * * * * * * * * STOP * * * * * * * * * */
599 
600 /* Entry to forbid dialups on multiplexer subchannels */
601 
602 lap_simplex$stop:
603      entry (P_lap_data_ptr, P_code);
604 
605           lap_data_ptr = P_lap_data_ptr;
606           lap_data.simplex_started = "0"b;
607           P_code = 0;
608           return;
609 
610 /* * * * * * * * * * SHUTDOWN * * * * * * * * * */
611 
612 /*
613    Entry to shut down the multiplexer (equivalent to a crash)
614    instead of just hangup. It should be a disconnect order and
615    then a deactivate order for any state greater than listening
616 */
617 
618 lap_simplex$shutdown:
619      entry (P_lap_data_ptr, P_code);
620 
621           lap_data_ptr = P_lap_data_ptr;
622           if (lap_data.state > LAP_HUNGUP) then call channel_manager$control (lap_data.devx, "hangup", null (), code);
623           return;
624 
625 /* * * * * * * * * PRIV_CONTROL * * * * * * * * * * */
626 
627 /* Entry to perform privileged control orders */
628 
629 lap_simplex$priv_control:
630      entry (P_lap_data_ptr, P_order, P_info_ptr, P_code);
631 
632           lap_data_ptr = P_lap_data_ptr;
633           order = P_order;
634           P_code = 0;
635 
636           if /* case */ order = "copy_meters" then do;
637                call channel_manager$control (lap_data.devx, order, P_info_ptr, P_code);
638                end;
639 
640           else if order = "get_meters" then do;
641                call channel_manager$control (lap_data.devx, order, P_info_ptr, P_code);
642                end;
643 
644           else P_code = error_table_$undefined_order_request;
645 
646           return;
647 
648 /* * * * * * * * * * HPRIV_CONTROL * * * * * * * * * */
649 
650 /* Entry to perform highly privileged control orders */
651 
652 lap_simplex$hpriv_control:
653      entry (P_lap_data_ptr, P_order, P_info_ptr, P_code);
654 
655           lap_data_ptr = P_lap_data_ptr;
656           order = P_order;
657           code = 0;
658 
659           if /* case */ order = "load_mpx" then do;         /* bootload the multiplexed device */
660                lap_load_info_ptr = P_info_ptr;              /* save load info */
661 
662                if lap_load_info.version ^= LAP_LOAD_INFO_VERSION_1 then do;
663                     P_code = error_table_$unimplemented_version;
664                     return;
665                     end;
666 
667                if lap_data.state > LAP_HUNGUP then do;      /* one at a time please */
668                     P_code = error_table_$action_not_performed;
669                     return;
670                     end;
671 
672                string (lap_data.flags) = ""b;
673                lap_data.load_process_id = lap_load_info.process_id;
674                lap_data.load_event_channel = lap_load_info.event_channel;
675                lap_data.activate_order = lap_load_info.activate_order;
676 
677                lap_data.activate_order.pad = ""b;           /* Just in case */
678                lap_data.activate_order.command = ACTIVATE_COMMAND;
679 
680                lap_data.max_frame_size = divide (lap_data.activate_order.frame_size + 7, 8, 17, 0);
681 
682                call channel_manager$control (lap_data.devx, "line_control", addr (lap_data.activate_order), code);
683                if code ^= 0 then do;
684                     P_code = code;
685                     return;
686                     end;
687 
688                call channel_manager$control (lap_data.devx, "listen", null (), code);
689                if code ^= 0 then do;
690                     P_code = code;
691                     return;
692                     end;
693 
694                lap_data.state = LAP_LISTENING;
695                end;
696 
697           else code = error_table_$undefined_order_request;
698 
699           P_code = code;
700           return;
701 %page;
702 dcl  P_devx fixed bin parameter;                            /* device (LCT) index */
703 dcl  P_info_ptr pointer parameter;                          /* ptr to control order info structure */
704 dcl  P_miip pointer parameter;                              /* ptr to mux_init_info structure */
705 dcl  P_order char (*) parameter;                            /* control order name */
706 dcl  P_lap_data_ptr pointer parameter;                      /* ptr to lap_data (lap multiplexer data base) */
707 dcl  P_subchan_idx fixed bin parameter;                     /* Subchannel index (should always be 1) */
708 dcl  P_int_type fixed bin parameter;
709 dcl  P_int_data bit (72) aligned parameter;
710 dcl  P_chain_ptr pointer parameter;
711 dcl  P_mcl_info_ptr pointer parameter;                      /* Mode change list and modes */
712 dcl  P_modes char (*) parameter;
713 dcl  P_code fixed bin (35) parameter;                       /* error code */
714 
715 dcl  code fixed bin (35);
716 dcl  ignore_code fixed bin (35);
717 dcl  devx fixed bin;
718 dcl  info_ptr pointer;
719 dcl  order char (32);
720 dcl  int_type fixed bin;
721 dcl  int_data bit (72) aligned;
722 dcl  chain_ptr pointer;
723 dcl  next_block fixed bin (18);
724 dcl  frame_end fixed bin;
725 dcl  real_buffer_lth fixed bin;
726 dcl  mode_idx fixed bin;
727 
728 dcl  1 lap_down_status aligned like lap_line_status_info automatic;
729 
730 dcl  1 lap_cmdr_status aligned based (addr (int_data)),
731        2 cmdr_status uns fixed bin (18) unaligned,          /* constant 3 */
732        2 cmdr_bytes (3) unaligned,                          /* I-frame at fault */
733          3 pad bit (1) unaligned,                           /* N(s) & N(r) */
734          3 byte bit (8) unaligned,                          /* flags w,x,y,z */
735        2 pad bit (27) unaligned;
736 
737 dcl  init_sw bit (1) aligned static init ("0"b);            /* Whether proc has been wired */
738 
739 dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
740 dcl  syserr entry options (variable);
741 dcl  syserr$error_code entry options (variable);
742 dcl  wire_proc$wire_me entry;
743 
744 dcl  error_table_$action_not_performed fixed bin (35) external static;
745 dcl  error_table_$bad_arg fixed bin (35) external static;
746 dcl  error_table_$bad_mode fixed bin (35) external static;
747 dcl  error_table_$invalid_state fixed bin (35) external static;
748 dcl  error_table_$noalloc fixed bin (35) external static;
749 dcl  error_table_$null_info_ptr fixed bin (35) external static;
750 dcl  error_table_$undefined_order_request fixed bin (35) external static;
751 dcl  error_table_$unimplemented_version fixed bin (35) external static;
752 
753 dcl  tty_buf$lct_ptr pointer external static;
754 
755 dcl  MPX_UP fixed bin (71) static options (constant) init (1);
756 dcl  MPX_DOWN fixed bin (71) static options (constant) init (2);
757 dcl  MPX_MASKED fixed bin (71) static options (constant) init (3);
758 
759 dcl  cleanup condition;
760 
761 dcl  (addr, after, binary, collate9, currentsize, divide, hbound, lbound, pointer, null, rel, reverse, search, size,
762      string, substr, unspec) builtin;
763 %page;
764 %include lap_simplex_data;
765 %page;
766 %include lap_line_info;
767 %page;
768 %include mux_init_info;
769 %page;
770 %include lct;
771 %page;
772 %include channel_manager_dcls;
773 %page;
774 %include tty_space_man_dcls;
775 %page;
776 %include mcs_modes_change_list;
777 %page;
778 %include mode_string_info;
779 %page;
780 %include tty_buffer_block;
781 %page;
782 %include mcs_interrupt_info;
783 %page;
784 %include line_types;
785 %page;
786 %include tty_read_status_info;
787 %page;
788 %include syserr_codes;
789 %page;
790 /* BEGIN MESSAGE DOCUMENTATION
791 
792    Message:
793    lap_simplex(CHN): Unexpected interrupt TYPE DATA received.
794 
795    S: $log
796 
797    T: $run
798 
799    M: An unexpected MCM interrupt was processed.
800 
801    A: $notify
802 
803    Message:
804    lap_simplex(CHN): Failure, Link state: STATE, Current Action: FUNCTION, in ESTATE, Primary state: PSTATE, Secondary state: SSTATE.
805 
806    S: $log
807 
808    T: $run
809 
810    M: Normal request to crash the line when the link has been disconnected by
811    the FNP.  STATE is the main state of the link. FUNCTION is the last
812    function the link processed. The ESTATE is the execution state of the
813    last function. PSTATE and SSTATE are the link up substate.
814 
815    A: $notify
816 
817    Message:
818    lap_simplex(CHN): Link disconnected due to mis-matched frame sizes. CMDR/FRMR frame: FRAME.
819 
820    S: $log
821 
822    T: $run
823 
824    M: The FNP has received a command reject (LAPB) or frame reject (LAP) which
825    specified a reason of "wide frame" on channel CHN.  The actual level 2
826    command is FRAME.  This means the frame received by the other end was too
827    long.  Instead of looping continuously trying to send this frame, the link
828    will be disconnected.  The maximum frame size in the Multics TTF for this
829    link should be checked against the size expected by the other end of the
830    link, and corrected.
831 
832    A: $notify
833 
834    Message:
835    lap_simplex(CHN): Attempt to write overlength frame.
836 
837    S: $log
838 
839    T: $run
840 
841    M: An attempt was made to add a buffer to a frame which didn't have room
842    for it.  The connection will be crashed.
843 
844    A: $notify
845 
846    Message:
847    x25_mpx(CHN): Error from write of XXX chars. ERROR
848 
849    S: $log
850 
851    T: $run
852 
853    M: The ERROR occurred writing XXX characters to the LAP channel.
854    The LAP channel will be disconnected.
855 
856    A: $notify
857 
858    Message:
859    lap_simplex(CHN): Write failed to take whole frame, discarding rest.
860 
861    S: $log
862 
863    T: $run
864 
865    M: A attempt to write a whole frame failed, only a part of it was taken.
866    An attempt will be made to continue.
867 
868    A: $notify
869 
870    Message:
871    lap_simplex(CHN): Invalid subchannel index XXX
872 
873    S: $alarm
874 
875    T: $run
876 
877    M: Some call which attempted to write, process a control order or process
878    a modes operation specified a subchannel other than 1.
879 
880    A: $notify
881 
882    END MESSAGE DOCUMENTATION */
883 
884      end lap_simplex;