



		    ncp_interface_.pl1              07/24/78  1452.7rew 07/24/78  1206.9       95634



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

ncp_interface_:
          procedure ();

/*             "ncp_interface_" -- this procedure interfaces the      */
/*        calls provided to the user by the "ncp_" dispatch module    */
/*        to the miscellaneous calls (generally order calls) to the   */
/*        actual NCP running in an Inner ring.                        */

/*        Originally coded by D. M. Wells, October, 1974.             */

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_socket_state fixed binary (6),
          P_bytesize fixed binary (8),
          P_host_num fixed binary (32),
          P_socket_num fixed binary (32),
          P_error_code fixed binary (35),
          P_event_channel fixed binary (71),
          P_ncp_indx bit (36))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          foreign_socket bit (64)
               automatic;

     declare
          1 net_info aligned automatic like network_status;           /* struc returned by ncp_network_status */

     declare
          1 ncp_socket_info aligned automatic,
             2 it (2),
                3 idx fixed binary (17),
                3 len fixed binary (17),
             2 socket like socket,
             2 rfc (10) like rcvd_rfc;

          /* * * * * INTERNAL STATIC DECLARATIONS  * * * * */

     declare
          r1_global_chn fixed binary (71) initial (0)
               internal static;

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (error_table_$area_too_small,
	error_table_$imp_down,
	error_table_$net_not_up)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          ipc_$decl_ev_call_chn constant entry (fixed bin (71), entry, ptr, fixed bin (17), fixed bin (35)),
          ipc_$reset_ev_call_chn constant entry (fixed bin (71), fixed bin (35)),
          net_$ncp_network_status constant entry (fixed bin (17), ptr, fixed bin (35)),
          net_$ncp_order constant entry (bit (36), fixed bin (12), ptr, fixed bin (6), fixed bin (35)),
          net_$ncp_state constant entry (bit (36), bit (64), fixed bin (6), fixed bin (35)),
          net_$ncp_status constant entry (fixed bin (12), fixed bin (18), ptr, fixed bin (19), fixed bin (35)),
          net_ring1_user_$add_global_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          net_ring1_user_$check_ncp_global_state constant entry (),
          net_ring1_user_$remove_global_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          net_ring1_user_$set_global_notify_channel constant entry (fixed bin (71), fixed bin (35));

     declare
          (addr, binary, null, size, substr)
               builtin;

          /* * * * * STACK REFERENCES  * * * * * * * * * * */

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include ncp_connection_dcls;
          % include ncp_status_dcls;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

get_socket_state:
          entry (P_ncp_indx, P_socket_state, P_error_code);

          call net_$ncp_state (P_ncp_indx, (""b), P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

get_foreign_socket:
          entry (P_ncp_indx, P_host_num, P_socket_num, P_socket_state, P_error_code);

          P_host_num = -1;
          P_socket_num = -1;

          call net_$ncp_state (P_ncp_indx, foreign_socket, P_socket_state, P_error_code);
          if P_error_code ^= 0
          then return;

          if foreign_socket ^= ""b
          then do;
               P_host_num = binary (substr (foreign_socket, 1, 32), 32);
               P_socket_num = binary (substr (foreign_socket, 33, 32));
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

get_local_socket:
          entry (P_ncp_indx, P_host_num, P_socket_num, P_socket_state, P_error_code);

          P_host_num = -1;
          P_socket_num = -1;
          P_socket_state = 0;

          call fillin_socket_structure (P_ncp_indx, P_error_code);
          if P_error_code ^= 0
          then return;

	P_host_num = binary (string (ncp_socket_info.socket.local_socket.host), 32);
          P_socket_num = binary (ncp_socket_info.socket.local_socket.socket_num, 32);
          P_socket_state = binary (ncp_socket_info.socket.state, 6);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

local_host_number:
          entry (P_host_num, P_error_code);
          P_host_num = -1;                                  /* make the value illegal first                   */

          call net_$ncp_network_status ((0), addr (net_info), P_error_code);
          if P_error_code ^= 0
          then return;

          P_host_num = net_info.local_host_id;

	if net_info.ncp_state ^= 2
	then do;
	     if net_info.ncp_state = 1
	     then P_error_code = error_table_$imp_down;
	     else P_error_code = error_table_$net_not_up;
	     end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

accept_connection:
          entry (P_ncp_indx, P_socket_state, P_error_code);

          call net_$ncp_order (P_ncp_indx, 2, null (), P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

reject_connection:
          entry (P_ncp_indx, P_socket_state, P_error_code);

          call net_$ncp_order (P_ncp_indx, 1, null (), P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

close_connection:
          entry (P_ncp_indx, P_socket_state, P_error_code);

          call net_$ncp_order (P_ncp_indx, 3, null (), P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

clear_connection:
          entry (P_ncp_indx, P_socket_state, P_error_code);

          call net_$ncp_order (P_ncp_indx, 12, null (), P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

disable_interrupts:
          entry (P_ncp_indx, P_error_code);

          call net_$ncp_order (P_ncp_indx, 7, null (), (0), P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

enable_interrupts:
          entry (P_ncp_indx, P_event_channel, P_error_code);

          if P_event_channel = 0
          then call net_$ncp_order (P_ncp_indx, 6, null (), (0), P_error_code);
          else call net_$ncp_order (P_ncp_indx, 6, addr (P_event_channel), (0), P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

force_deactivate_socket:
          entry (P_ncp_indx, P_error_code);

          call net_$ncp_order (P_ncp_indx, 4, null (), (0), P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

get_bytesize:
          entry (P_ncp_indx, P_bytesize, P_error_code);

          call net_$ncp_order (P_ncp_indx, 9, addr (P_bytesize), (0), P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

listen_for_connection:
          entry (P_ncp_indx, P_socket_state, P_error_code);

          call net_$ncp_order (P_ncp_indx, 0, null (), P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

send_interrupt:
          entry (P_ncp_indx, P_socket_state, P_error_code);

          call net_$ncp_order (P_ncp_indx, 5, null (), P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

set_bytesize:
          entry (P_ncp_indx, P_bytesize, P_error_code);

          call net_$ncp_order (P_ncp_indx, 8, addr (P_bytesize), (0), P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

add_global_ev_chn:
          entry (P_event_channel, P_error_code);

          if r1_global_chn = 0
          then do;
               call ipc_$create_ev_chn (r1_global_chn, P_error_code);
               if P_error_code ^= 0
               then return;
               end;

          call ipc_$decl_ev_call_chn (r1_global_chn, net_ring1_user_$check_ncp_global_state,
                    null (), 1, P_error_code);
          if P_error_code ^= 0
          then do;
               r1_global_chn = 0;
               return;
               end;

          call ipc_$reset_ev_call_chn (r1_global_chn, (0));

          call net_ring1_user_$set_global_notify_channel (r1_global_chn, P_error_code);
          if P_error_code ^= 0
          then do;
               r1_global_chn = 0;
               return;
               end;

          call net_ring1_user_$add_global_ev_chn (P_event_channel, P_error_code);

          return;
          /* * * * * * * * * * * * * * * * * * * * * * * * */

remove_global_ev_chn:
          entry (P_event_channel, P_error_code);

          call ipc_$reset_ev_call_chn (r1_global_chn, (0));

          call net_ring1_user_$remove_global_ev_chn (P_event_channel, P_error_code);

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

fillin_socket_structure:
          procedure (p_sock_indx, p_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_err_code fixed binary (35),
          p_sock_indx bit (36))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          call net_$ncp_status (6, binary (substr (p_sock_indx, 19, 18)), addr (ncp_socket_info), size (ncp_socket_info), p_err_code);
          if p_err_code ^= 0
          then if p_err_code = error_table_$area_too_small
               then p_err_code = 0;

          return;

end;      /* end fillin_socket_structure                   */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end ncp_interface_                            */
end;




		    ncp_r1_interface_.pl1           07/24/78  1452.7rew 07/24/78  1206.1      122886



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

ncp_r1_interface_:
          procedure ();

/*             This module implements the Ring-1 portion of the NCP.            */

/*        Originally coded by D. M. Wells, October, 1976.                       */

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_socket_state fixed binary (6),
          P_pin_num fixed binary (8),
          P_host_num fixed binary (32),
          P_sock_grp_id fixed binary (24),
          P_socket_num fixed binary (32),
          P_error_code fixed binary (35),
          P_event_channel fixed binary (71),
          P_ncp_indx bit (36),
          P_process_id bit (36) aligned,
          P_restriction_bits bit (*),
          P_access_dir character (*))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (validation_level fixed binary (3),
	temp_segname char (32),
          pin_num fixed binary (8),
          host_num fixed binary (32),
          indx fixed binary (17),
          sock_grp_id fixed binary (24),
          socket_num fixed binary (32),
          err_code fixed binary (35),
          event_channel fixed binary (71),
          (old_sock_grp_id, temp_sock_grp_id) bit (24),
          seg_access bit (36),
          ncp_indx bit (36),
          foreign_socket bit (64))
               automatic;

          /* * * * * INTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (notify_val_level fixed binary (3) initial (7),
          global_channel_array (60) fixed binary (71) initial ((60)0))
               internal static;

     declare
          NCP_DIR character (168) initial (">system_control_1>ncp")
               internal static;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
          READ_ACCESS bit (36) initial ("1"b)
               internal static options (constant);

          /* * * * * BASED & TEMPLARE DECLARATIONS * * * * */

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (error_table_$bad_index,
          error_table_$io_no_permission,
          error_table_$net_no_connect_permission,
          error_table_$noentry)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          convert_binary_integer_$decimal_string constant entry (fixed bin (35)) returns (char (12) varying),
          cu_$level_get constant entry () returns (fixed bin (3)),
          get_group_id_ constant entry () returns (char (32)),
          get_process_id_ constant entry () returns (bit (36) aligned),
	ioa_$rsnnl entry options (variable),
          hcs_$get_user_effmode constant entry (char (*), char (*), char (*), fixed bin (3), fixed bin (5), fixed bin (35)),
          hcs_$wakeup constant entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)),
          net_$ncp_socket_state constant entry (fixed bin (24), fixed bin (8), bit (36), fixed bin (6), ptr, fixed bin (35)),
          net_ring0_admin_$get_userid constant entry (bit (24), fixed bin (35)),
          net_ring0_admin_$ncp_activate constant entry (fixed bin (8), fixed bin (71), bit (36), fixed bin (35)),
          net_ring0_admin_$ncp_connect_ constant entry (bit (36), bit (64), fixed bin (6), fixed bin (35)),
          net_ring0_admin_$ncp_deactivate constant entry (bit (36), fixed bin (35)),
          net_ring0_admin_$ncp_passoff constant entry (bit (36), bit (36) aligned, fixed bin (35)),
          net_ring0_admin_$ncp_priv_activate constant entry (fixed bin (24), fixed bin (8), fixed bin (71), bit (36), fixed bin (35)),
          net_ring0_admin_$ncp_set_global_evchn constant entry (fixed bin (71), fixed bin (35)),
          net_ring0_admin_$set_userid constant entry (bit (24), fixed bin (35));

     declare
          (binary, bit, hbound, lbound, length, reverse, rtrim, substr, verify)
               builtin;

          /* * * * * STACK REFERENCES  * * * * * * * * * * */

     declare
          cleanup condition;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

get_access_dir:
          entry (P_access_dir, P_error_code);

          P_error_code = 0;

          P_access_dir = NCP_DIR;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

set_access_dir:
          entry (P_access_dir, P_error_code);

          P_error_code = 0;

          NCP_DIR = P_access_dir;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

attach_socket:
          entry (P_pin_num, P_event_channel, P_ncp_indx, P_error_code);

          P_ncp_indx = ""b;
          P_error_code = 0;

          call net_ring0_admin_$ncp_activate (P_pin_num, P_event_channel, P_ncp_indx, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * */

attach_priv_socket:
          entry (P_sock_grp_id, P_pin_num, P_event_channel, P_ncp_indx, P_error_code);

          P_ncp_indx = ""b;
          P_error_code = 0;

          sock_grp_id = P_sock_grp_id;
          pin_num = P_pin_num;

          socket_num = sock_grp_id * 256 + pin_num;

          seg_access = get_access ("socket." || convert_binary_integer_$decimal_string ((socket_num)));
          if (seg_access & READ_ACCESS) ^= READ_ACCESS
          then do;
               seg_access = get_access ("socket_group." || convert_binary_integer_$decimal_string ((sock_grp_id)));
               end;

          if (seg_access & READ_ACCESS)^= READ_ACCESS
          then do;
               P_error_code = error_table_$io_no_permission;
               return;
               end;

          call net_ring0_admin_$ncp_priv_activate (sock_grp_id, pin_num, P_event_channel, P_ncp_indx, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

detach_socket:
          entry (P_ncp_indx, P_error_code);

          call net_ring0_admin_$ncp_deactivate (P_ncp_indx, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

initiate_connection:
          entry (P_ncp_indx, P_host_num, P_socket_num, P_socket_state, P_error_code);

          P_socket_state = 0;
          P_error_code = 0;

          host_num = P_host_num;
          socket_num = P_socket_num;
                                                  /*      There is no need to check bounds on these values    */
                                                  /* as if they are out of range, there should not be an      */
                                                  /* "acs" segment for the incorrect value.                   */

          foreign_socket = bit (binary (host_num, 32)) || bit (binary (socket_num, 32));

          seg_access = get_access ("connect");
          if (seg_access & READ_ACCESS) ^= READ_ACCESS
          then do;
	     call ioa_$rsnnl ("host.&^8.4b", temp_segname, (0), bit (fixed (host_num, 32), 32));
	     seg_access = get_access (temp_segname);
               end;

          if (seg_access & READ_ACCESS) ^= READ_ACCESS
          then do;
               P_error_code = error_table_$net_no_connect_permission;
               return;
               end;

          call net_ring0_admin_$ncp_connect_ (P_ncp_indx, foreign_socket, P_socket_state, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

get_socket_group_id:
          entry (P_sock_grp_id, P_error_code);

          P_error_code = 0;
          P_sock_grp_id = -1;

          call net_ring0_admin_$get_userid (temp_sock_grp_id, err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               return;
               end;

          P_sock_grp_id = binary (temp_sock_grp_id, 24);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

set_socket_group_id:
          entry (P_sock_grp_id, P_error_code);

          P_error_code = 0;

          temp_sock_grp_id = bit (binary (P_sock_grp_id, 24));

          call net_ring0_admin_$set_userid (temp_sock_grp_id, err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               return;
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

accept_passoff:
          entry (P_sock_grp_id, P_pin_num, P_event_channel, P_ncp_indx, P_error_code);

          P_error_code = 0;
          P_ncp_indx = ""b;

          temp_sock_grp_id = bit (binary (P_sock_grp_id, 24));
          pin_num = P_pin_num;
          event_channel = P_event_channel;

          call net_$ncp_socket_state (binary (temp_sock_grp_id, 24), pin_num, (""b), (0), null (), err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               return;
               end;

          call net_ring0_admin_$get_userid (old_sock_grp_id, err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               return;
               end;

          on cleanup
               call net_ring0_admin_$set_userid (old_sock_grp_id, (0));

          call net_ring0_admin_$set_userid (temp_sock_grp_id, err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               return;
               end;

          call net_ring0_admin_$ncp_activate (pin_num, event_channel, ncp_indx, err_code);

          call net_ring0_admin_$set_userid (old_sock_grp_id, (0));

          P_ncp_indx = ncp_indx;

          P_error_code = err_code;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

passoff_socket:
          entry (P_ncp_indx, P_process_id, P_restriction_bits, P_error_code);

          call net_ring0_admin_$ncp_passoff (P_ncp_indx, P_process_id, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */
r1_add_global_ev_chn:
          entry (P_event_channel, P_error_code);

          P_error_code = 0;
          event_channel = P_event_channel;

          if event_channel = 0
          then do;
               P_error_code = error_table_$bad_index;
               return;
               end;

          do indx = lbound (global_channel_array, 1) by 1 to hbound (global_channel_array, 1);
               if global_channel_array (indx) = 0
               then do;
                    global_channel_array (indx) = event_channel;
                    return;
                    end;
               end;

          P_error_code = error_table_$noentry;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

r1_remove_global_ev_chn:
          entry (P_event_channel, P_error_code);

          P_error_code = 0;
          event_channel = P_event_channel;

          do indx = lbound (global_channel_array, 1) by 1 to hbound (global_channel_array, 1);
               if global_channel_array (indx) = event_channel
               then do;
                    global_channel_array (indx) = 0;
                    return;
                    end;
               end;

          P_error_code = error_table_$noentry;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

r1_check_ncp_global_state:
          entry ();

          do indx = lbound (global_channel_array, 1) by 1 to hbound (global_channel_array, 1);
               if global_channel_array (indx) ^= 0
               then call hcs_$wakeup (get_process_id_ (), global_channel_array (indx), 0, (0));
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

r1_set_global_notify_channel:
          entry (P_event_channel, P_error_code);

          P_error_code = 0;

          event_channel = P_event_channel;
          validation_level = cu_$level_get ();

          if validation_level > notify_val_level
          then return;

          call net_ring0_admin_$ncp_set_global_evchn (event_channel, err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               return;
               end;

          notify_val_level = validation_level;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

get_access:
          procedure (p_access_item) returns (bit (36));

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          p_access_item character (*)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (user_mode fixed binary (5),
          seg_name character (32))
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */


	seg_name = rtrim (p_access_item) || ".acs";

          call hcs_$get_user_effmode (NCP_DIR, seg_name, get_group_id_ (), cu_$level_get (), user_mode, err_code);
          if err_code ^= 0
          then return (""b);

          return (substr (bit (binary (user_mode, 5)), 2));           /* map to new ACL form of access        */

end;      /* end get_access                                */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end ncp_r1_interface_                         */
end;




		    net_pin_manager_.pl1            07/24/78  1452.7rew 07/24/78  1207.0      102123



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1974 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_pin_manager_:
          procedure ();

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         ((P_num_pins, P_first_pin) fixed binary (8),
          P_error_code fixed binary (35))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         ((indx, num_pins_to_allocate, pin_boundary_modulus, start_loc) fixed binary (8),
          (havent_failed_yet, havent_salvaged) bit (1))
               automatic;

          /* * * * * INTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (initialized bit (1) initial ("0"b),
          on_bits bit (256))
               internal static;

     declare
          1 pin_status aligned internal static,
             2 net_sock_group fixed binary (24),            /* the assigned socket group of this user         */
             2 reserved aligned,
                3 r_pin (0 : 255) bit (1) unaligned,
             2 unavailable aligned,
                3 u_pin (0 : 255) bit (1) unaligned;

          /* * * * * DEFINED REFERENCES  * * * * * * * * * */

     declare
          reserved_pins_as_string bit (256) unaligned defined (pin_status.reserved.r_pin (0)),
          unavailable_pins_as_string bit (256) unaligned defined (pin_status.unavailable.u_pin (0));

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (error_table_$bad_segment,
          error_table_$bad_index,
          error_table_$badcall,
          error_table_$no_device,
          error_table_$not_attached,
          error_table_$out_of_bounds)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
         (addr, addrel, binary, dimension, divide, hbound, lbound, size, substr)
               builtin;

          /* * * * * STACK REFERENCES  * * * * * * * * * * */

     declare
          error condition;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

allocate_pins:
          entry (P_num_pins, P_first_pin, P_error_code);

          havent_salvaged = "1"b;

          if ^ initialized
          then call initialize ();

          num_pins_to_allocate = P_num_pins;
          pin_boundary_modulus = round_to_power_of_two (num_pins_to_allocate);

          havent_failed_yet = "1"b;
          do while (havent_failed_yet);
               do indx = 0 by 1 to divide (256, pin_boundary_modulus, 8, 0) - 1;
                    start_loc = indx * pin_boundary_modulus;

                    if substr (unavailable_pins_as_string, start_loc + 1, num_pins_to_allocate) = ""b
                    then do;
                         substr (unavailable_pins_as_string, start_loc + 1, num_pins_to_allocate) = on_bits;

                         if substr (reserved_pins_as_string, start_loc + 1, num_pins_to_allocate) = ""b
                         then do;
                              substr (reserved_pins_as_string, start_loc + 1, num_pins_to_allocate) = on_bits;

                              P_first_pin = start_loc;

                              P_error_code = 0;
                              return;
                              end;
                         end;
                    end;

               if havent_salvaged
               then call salvage ();
               else havent_failed_yet = "0"b;
               end;

          P_error_code = error_table_$no_device;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

free_pins:
          entry (P_num_pins, P_first_pin, P_error_code);

          if ^ initialized
          then do;
               P_error_code = error_table_$not_attached;
               return;
               end;

          start_loc = P_first_pin;
          num_pins_to_allocate = P_num_pins;

          if (start_loc < lbound (pin_status.reserved.r_pin, 1)) | (start_loc > hbound (pin_status.reserved.r_pin, 1))
          then do;
               P_error_code = error_table_$bad_index;
               return;
               end;

          if (num_pins_to_allocate <= 0) | (num_pins_to_allocate > dimension (pin_status.reserved.r_pin, 1))
          then do;
               P_error_code = error_table_$badcall;
               return;
               end;

          if substr (reserved_pins_as_string, start_loc + 1, num_pins_to_allocate) ^= substr (on_bits, 1, num_pins_to_allocate)
          then do;                                          /* guy wants to return non-used pins              */
               P_error_code = error_table_$not_attached;

               return;
               end;

          substr (reserved_pins_as_string, start_loc + 1, num_pins_to_allocate) = ""b;

          P_error_code = 0;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

error_return_label:
          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      This procedure is responsible for rounding up the number of   */
                                        /* pins that a caller asks for to the next power of two boundary.     */
                                        /* Furthermore, this boundary must be a reasonable number that will   */
                                        /* fit within the pin space -- thus the bounds of 2 and 128 for the   */
                                        /* number of pins that may be asked for.                              */

round_to_power_of_two:
          procedure (p_num_to_round) returns (fixed bin (8));

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          p_num_to_round fixed binary (8)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          table_indx fixed binary (8)
               automatic;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
          powers_of_two (1 : 7) fixed binary (8) initial (2, 4, 8, 16, 32, 64, 128)
               internal static options (constant);

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if (p_num_to_round < 2) | (p_num_to_round > 128)
          then do;
               P_error_code = error_table_$out_of_bounds;  /* caller tried to give us a bad number of pins   */
               goto error_return_label;
               end;

          do table_indx = lbound (powers_of_two, 1) by 1 to hbound (powers_of_two, 1);
               if p_num_to_round <= powers_of_two (table_indx)
               then return (powers_of_two (table_indx));
               end;

          P_error_code = error_table_$bad_segment;

          goto error_return_label;

end;      /* end round_to_power_of_two                     */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

initialize:
          procedure ();

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (pin_number fixed binary (8),
         (indx, num_sockets) fixed binary (24),
          this_socket_group fixed binary (24),
          err_code fixed binary (35),
          (ncp_indx_arr_ptr, sock_ptr, socket_table_ptr) pointer)
               automatic;

     declare
          1 info_struc aligned automatic,
             2 table_info (2),
                3 offset fixed binary (18),
                3 length fixed binary (18),
             2 buffer (2048) bit (36);


          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
          1 socket_table (1) aligned like socket based;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          ncp_$get_socket_group_id constant entry (fixed bin (24), fixed bin (35)),
          net_$ncp_status constant entry (fixed bin (12), fixed bin (17), ptr, fixed bin (18), fixed bin (35));

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include ncp_connection_dcls;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          on_bits = ""b;
          on_bits = ^ on_bits;

          reserved_pins_as_string = ""b;

salvage:
          entry ();

          revert error;

          initialized = "0"b;                               /* if anyone comes in while we are working, get   */
                                                            /* them to come in and finish our job -- then     */
                                                            /* when we resume, we will be doing this work     */
                                                            /* redundantly.                                   */

          unavailable_pins_as_string = ""b;
          substr (unavailable_pins_as_string, 1, 32) = on_bits;       /* reserve lower 32 pins for system and user      */

          call ncp_$get_socket_group_id (pin_status.net_sock_group, err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;

               goto error_return_label;
               end;

          call net_$ncp_status (5, 0, addr (info_struc), size (info_struc), err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               goto error_return_label;
               end;

          num_sockets = info_struc.table_info (1).length;
          socket_table_ptr = addrel (addr (info_struc), info_struc.table_info (1).offset);
          ncp_indx_arr_ptr = addrel (addr (info_struc), info_struc.table_info (2).offset);

          do indx = 1 by 1 to num_sockets;
               sock_ptr = addr (socket_table_ptr -> socket_table (indx));

               this_socket_group = binary (substr (sock_ptr -> socket.local_socket.socket_num, 1, 24));
               if this_socket_group = pin_status.net_sock_group
               then do;
                    pin_number = binary (substr (sock_ptr -> socket.local_socket.socket_num, 25, 8), 8);

                    pin_status.unavailable.u_pin (pin_number) = "1"b;
                    end;
               end;

          unavailable_pins_as_string = unavailable_pins_as_string | reserved_pins_as_string;

          havent_salvaged = "0"b;
          initialized = "1"b;

          return;

end;      /* end initialize                                */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end net_pin_manager_                          */
end;




		    net_signal_handler_.pl1         09/23/77  1032.4rew 09/22/77  1725.3      103365



net_signal_handler_:
          procedure () options (support);

/*             "net_signal_handler_" -- manager for the special IPS processing  */
/*        that the Network typewriter interface must do in order to support the */
/*        Network Virtual Terminal.                                             */


/*        Created by D. M. Wells on 17 December, 1973.                          */
/*        Last modified by D. M. Wells on 2 April, 1974 to allow interrupts to  */
/*                  be identified on a per NCP pin basis (thus allowing IOSIMS  */
/*                  to identify QUITs on a per stream basis).                   */
/*        Last modified by D. M. Wells, August, 1975, to prepare for change     */
/*                  to the "neti" signal (instead of "quit")                    */
/*        Last modified by D. M. Wells, March, 1976, to use the SCT mechanism   */
/*        Last modified by D. M. Wells, October, 1976, to remove pre-MR4.0      */
/*             compatability code -- notably patching of stack signal ptr.      */

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_ncp_indx bit (36),
          P_error_code fixed binary (35),
          P_continue_switch bit (1) aligned,
          P_condition_name character (*),
          P_data_ptr pointer,
          (P_crawlout_ptr, P_info_ptr, P_mc_ptr) pointer,
          P_signal_handler entry (char (*), ptr, ptr, ptr, bit (1) aligned))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (indx fixed binary (12),
          arg_ncp_indx bit (36) aligned,
          previous_ips_mask bit (36) aligned,
          arg_data_ptr pointer,
          arg_signal_handler variable entry (ptr, char (*), ptr, ptr, bit (1) aligned))
               automatic;

          /* * * * * INTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (count_of_handler_data_slots_used fixed binary (12) initial (0),
          signal_notify_channel fixed binary (71) initial (0))
               internal static;

     declare
          1 handler_data (1 : 40) aligned internal static,
             2 data_ptr pointer,
             2 ncp_indx bit (36) aligned initial ((40)(36)"0"b),
             2 signal_count fixed binary (30),
             2 signal_procedure entry (char (*), ptr, ptr, ptr, bit (1) aligned);

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
         (EMPTY_ENTRY         initial ((36)"0"b),
          CHANGING_ENTRY      initial ((36)"1"b))
               bit (36) aligned internal static options (constant);

     declare
          MASK_EVERYTHING initial ((36)"0"b)
               bit (36) aligned internal static options (constant);


          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (error_table_$bad_index,
          error_table_$noalloc,
          error_table_$noentry)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          hcs_$set_ips_mask constant entry (bit (36) aligned, bit (36) aligned),
          ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          ipc_$delete_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          ipc_$read_ev_chn constant entry (fixed bin (71), fixed bin (1), ptr, fixed bin (35)),
          ncp_$disable_interrupts constant entry (bit (36), fixed bin (35)),
          ncp_$enable_interrupts constant entry (bit (36), fixed bin (71), fixed bin (35)),
          sct_manager_$set constant entry (fixed bin (17), entry (ptr, char (*), ptr, ptr, bit (1) aligned), fixed bin (35)),
          stacq constant entry (ptr, bit (36) aligned, bit (36) aligned) returns (bit (1) aligned);

     declare
         (addr, hbound, lbound, stac, substr)
               builtin;

          /* * * * * STACK REFERENCES  * * * * * * * * * * */

     declare
          net_stacq_error_
               condition;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include net_event_template;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

setup_signal_handler:
          entry (P_ncp_indx, P_signal_handler, P_data_ptr, P_error_code);

          P_error_code = 0;

          arg_ncp_indx = P_ncp_indx;
          arg_signal_handler = P_signal_handler;
          arg_data_ptr = P_data_ptr;

          if (arg_ncp_indx = EMPTY_ENTRY) | (arg_ncp_indx = CHANGING_ENTRY)
          then do;
               P_error_code = error_table_$bad_index;
               return;
               end;

          call hcs_$set_ips_mask (MASK_EVERYTHING, previous_ips_mask);

          do indx = lbound (handler_data, 1) by 1 to hbound (handler_data, 1);
               if stacq (addr (handler_data (indx).ncp_indx), arg_ncp_indx, CHANGING_ENTRY)
               then do;
                    handler_data (indx).signal_procedure = arg_signal_handler;
                    handler_data (indx).data_ptr = arg_data_ptr;

		call allow_network_signals (arg_ncp_indx, (0));

                    if ^ stacq (addr (handler_data (indx).ncp_indx), CHANGING_ENTRY, arg_ncp_indx)
                    then signal net_stacq_error_;

                    call hcs_$set_ips_mask (previous_ips_mask, (""b));
                    return;
                    end;
               end;

          do indx = lbound (handler_data, 1) by 1 to hbound (handler_data, 1)
                    while (^ stac (addr (handler_data (indx).ncp_indx), CHANGING_ENTRY));
               end;

          if indx > hbound (handler_data, 1)
          then do;
               call hcs_$set_ips_mask (previous_ips_mask, (""b));

               P_error_code = error_table_$noalloc;
               return;
               end;

          handler_data (indx).data_ptr = arg_data_ptr;
          handler_data (indx).signal_procedure = arg_signal_handler;
          handler_data (indx).signal_count = 0;             /* reset the signal count for this socket to zero */


          if ^ stacq (addr (handler_data (indx).ncp_indx), CHANGING_ENTRY, arg_ncp_indx)
          then signal net_stacq_error_;

          count_of_handler_data_slots_used = count_of_handler_data_slots_used + 1;

          call allow_network_signals (arg_ncp_indx, (0));

          call hcs_$set_ips_mask (previous_ips_mask, (""b));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

remove_signal_handler:
          entry (P_ncp_indx, P_error_code);

          P_error_code = 0;

          arg_ncp_indx = P_ncp_indx;

          if (arg_ncp_indx = EMPTY_ENTRY) | (arg_ncp_indx = CHANGING_ENTRY)
          then do;
               P_error_code = error_table_$bad_index;
               return;
               end;

          call hcs_$set_ips_mask (MASK_EVERYTHING, previous_ips_mask);

          do indx = lbound (handler_data, 1) by 1 to hbound (handler_data, 1)
                    while (^ stacq (addr (handler_data (indx).ncp_indx), arg_ncp_indx, CHANGING_ENTRY));
               end;

          if indx > hbound (handler_data, 1)
          then do;
               call hcs_$set_ips_mask (previous_ips_mask, (""b));

               P_error_code = error_table_$noentry;
               return;
               end;

          if ^ stacq (addr (handler_data (indx).ncp_indx), CHANGING_ENTRY, EMPTY_ENTRY)
          then signal net_stacq_error_;

          count_of_handler_data_slots_used = count_of_handler_data_slots_used - 1;

          call disallow_network_signals (arg_ncp_indx, (0));

          call hcs_$set_ips_mask (previous_ips_mask, (""b));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

neti_signal_handler:
          entry (P_mc_ptr, P_condition_name, P_info_ptr, P_crawlout_ptr, P_continue_switch);

          do while (network_signal_received (arg_ncp_indx, (0)));
               do indx = lbound (handler_data, 1) by 1 to hbound (handler_data, 1)
                         while (handler_data (indx).ncp_indx ^= arg_ncp_indx);
                    end;

               if indx <= hbound (handler_data, 1)
               then do;
                    arg_signal_handler = handler_data (indx).signal_procedure;
                    call arg_signal_handler (P_mc_ptr, P_condition_name, (handler_data (indx).data_ptr), P_crawlout_ptr, ("0"b));
                    end;
               end;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

allow_network_signals:
          procedure (p_ncp_indx_of_pin, p_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_err_code fixed binary (35),
          p_ncp_indx_of_pin bit (36) aligned)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * * */

     declare
          valid_event fixed binary (1)
               automatic;

     declare
          1 event_message aligned automatic like event_message_template;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if signal_notify_channel = 0
          then do;
               call setup_environment (p_err_code);
               if p_err_code ^= 0
               then return;
               end;

          call ncp_$enable_interrupts ((p_ncp_indx_of_pin), signal_notify_channel, p_err_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

disallow_network_signals:
          entry (p_ncp_indx_of_pin, p_err_code);

          call ncp_$disable_interrupts ((p_ncp_indx_of_pin), (0));

          if count_of_handler_data_slots_used = 0
          then call remove_environment ((0));

          p_err_code = 0;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

network_signal_received:
          entry (p_ncp_indx_of_pin, p_err_code) returns (bit (1) aligned);

          call ipc_$read_ev_chn (signal_notify_channel, valid_event, addr (event_message), p_err_code);
          if p_err_code ^= 0
          then do;
               signal_notify_channel = 0;
               return ("0"b);
               end;

          if valid_event = 0
          then return ("0"b);

          p_ncp_indx_of_pin = substr (event_message.message, 37, 36);

          return ("1"b);

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

setup_environment:
          procedure (p_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          p_err_code fixed binary (35)
               parameter;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include static_handlers;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          call ipc_$create_ev_chn (signal_notify_channel, p_err_code);
          if p_err_code ^= 0
          then return;

          call sct_manager_$set (neti_sct_index, neti_signal_handler, p_err_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

remove_environment:
          entry (p_err_code);

          p_err_code = 0;

          call ipc_$delete_ev_chn (signal_notify_channel, (0));

          signal_notify_channel = 0;

          return;

end;      /* end setup_environment                         */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

end;      /* end allow_network_signals                     */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end net_signal_handler_                       */
end;






		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
