get_mcm_meters.pl1 11/11/89 1100.7r w 11/11/89 0802.3 84213 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ get_mcm_meters: proc (pm_chan_name, pm_info_ptr, pm_code); /* this procedure is called through phcs_ to get meters on MCM channels */ /* Written December 1980 by Robert Coren */ /* Modified February 1981 by Robert Coren to add chan_star_list entry */ /* PARAMETERS */ dcl pm_chan_name char (*); dcl pm_info_ptr ptr; dcl pm_star_name char (*); dcl pm_version fixed bin; dcl pm_areap ptr; dcl pm_list_ptr ptr; dcl pm_code fixed bin (35); /* AUTOMATIC */ dcl devx fixed bin; dcl info_ptr ptr; dcl code fixed bin (35); dcl chan_name char (32); dcl state fixed bin; dcl star_name char (32); dcl version fixed bin; dcl star_areap ptr; dcl devx_listp ptr; dcl continue bit (1); dcl only_one bit (1); dcl all bit (1); dcl total_channels fixed bin; dcl actual_count fixed bin; dcl extra_count fixed bin; dcl i fixed bin; /* BASED */ dcl star_area area (100) based (star_areap); dcl devx_list (total_channels) fixed bin based (devx_listp); dcl 1 extra_channels (extra_count) based aligned like chan_star_info.chan_entry; /* ENTRIES */ dcl check_star_name_$entry entry (char (*), fixed bin (35)); dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl priv_channel_manager$get_devx entry (char (*), fixed bin, fixed bin (35)); dcl priv_channel_manager$priv_control entry (char (*), char (*), ptr, fixed bin (35)); dcl tty_index$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35)); /* EXTERNAL STATIC */ dcl error_table_$unimplemented_version fixed bin (35) external static; dcl error_table_$noalloc fixed bin (35) external static; dcl error_table_$nomatch fixed bin (35) external static; dcl error_table_$no_operation fixed bin (35) external static; dcl error_table_$undefined_order_request fixed bin (35) external static; /* BUILTINS */ dcl (addr, null) builtin; /* CONDITIONS */ dcl (cleanup, area) condition; %include tty_buf; %include lct; %include multiplexer_types; %include line_types; %include dn355_data; %include pcb; %include get_comm_meters_info; %include chan_star_info; chan_name = pm_chan_name; call priv_channel_manager$get_devx (chan_name, devx, code); if code ^= 0 then do; pm_code = code; return; end; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; lctep = addr (lct.lcte_array (devx)); info_ptr = pm_info_ptr; if info_ptr -> get_comm_meters_info.version ^= GET_COMM_METERS_INFO_VERSION_1 then do; pm_code = error_table_$unimplemented_version; return; end; info_ptr -> get_comm_meters_info.subchan_type = lcte.channel_type; if lcte.channel_type = TTY_MPX then call tty_index$tty_order (devx, "get_meters", info_ptr, state, code); else call priv_channel_manager$priv_control (chan_name, "get_meters", info_ptr, code); if code = error_table_$undefined_order_request | code = error_table_$no_operation /* some multiplexer couldn't handle this */ then do; info_ptr -> get_comm_meters_info.subchan_ptr = null (); info_ptr -> get_comm_meters_info.parent_ptr = null (); code = 0; end; pm_code = code; return; chan_star_list: entry (pm_star_name, pm_version, pm_areap, pm_list_ptr, pm_code); /* This entry returns a list of channel names that match a given star name. Additional information is also passed back for each channel. */ star_name = pm_star_name; version = pm_version; star_areap = pm_areap; if version ^= CHAN_STAR_INFO_VERSION_1 then do; pm_code = error_table_$unimplemented_version; return; end; devx_listp = null (); chan_star_list_ptr = null (); chan_star_count = 0; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; lcntp = lct.lcnt_ptr; total_channels = lct.max_no_lctes; only_one, all = "0"b; /* find out if we're to match one, some, or all names */ call check_star_name_$entry (star_name, code); if code = 0 /* simple (non-star) name */ then do; only_one = "1"b; chan_star_count = 1; end; else if code = 2 /* name is ** or the equivalent */ then do; all = "1"b; chan_star_count = total_channels; actual_count = 0; end; else if code ^= 1 /* code = 1 means starname */ then do; /* anything else is bad */ pm_code = code; return; end; on cleanup call cleanup_proc; on area begin; call cleanup_proc; pm_code = error_table_$noalloc; go to exit; end; continue = "1"b; /* initialize the loop flag */ if all | only_one /* we know how many we're going to get */ then allocate chan_star_info in (star_area) set (chan_star_list_ptr); else allocate devx_list in (star_area) set (devx_listp); /* we'll count 'em now and allocate star structure later */ do devx = 1 to total_channels while (continue); lctep = addr (lct.lcte_array (devx)); if lcte.entry_in_use /* if this is a real one */ then do; if all then do; actual_count = actual_count + 1; call fill_chan_info (actual_count, devx); end; else if only_one then if lcnt.names (devx) = star_name /* this is the one */ then do; call fill_chan_info (1, devx); continue = "0"b; /* loop no more */ end; else ; else do; call match_star_name_ (lcnt.names (devx), star_name, code); if code = 0 /* this is one */ then do; chan_star_count = chan_star_count + 1; devx_list (chan_star_count) = devx; end; else if code ^= error_table_$nomatch /* this is the only other thing we would expect */ then do; free devx_list in (star_area); pm_code = code; return; end; end; end; end; code = 0; /* reasonable assumption */ if ^all & ^only_one /* we had to do some matching */ then do; if chan_star_count = 0 /* only we didn't find any */ then code = error_table_$nomatch; else do; allocate chan_star_info in (star_area) set (chan_star_list_ptr); do i = 1 to chan_star_count; lctep = addr (lct.lcte_array (devx_list (i))); call fill_chan_info (i, devx_list (i)); end; end; free devx_list in (star_area); /* we're through with this anyway */ devx_listp = null (); /* so cleanup handler will work right */ end; if only_one then if continue /* there was only one and we didn't find it */ then do; free chan_star_info in (star_area); code = error_table_$nomatch; end; if all then if actual_count < chan_star_count /* we left out some unused LCTEs */ then do; extra_count = chan_star_count - actual_count; /* free the leftover ones */ free addr (chan_star_info.chan_entry (actual_count + 1)) -> extra_channels; chan_star_info.n_channels = actual_count; end; if code = 0 then do; chan_star_info.version = version; pm_list_ptr = chan_star_list_ptr; end; pm_code = code; exit: return; /* FILL_CHAN_INFO -- procedure called by chan_star_list entry to fill in the structure for a channel that's been matched */ fill_chan_info: proc (a_element, a_chanx); dcl a_element fixed bin; /* index in chan_star_list array of structure to be filled in */ dcl a_chanx fixed bin; /* devx of channel to be described */ dcl element fixed bin; dcl chanx fixed bin; dcl parent_lctep ptr; /* pointer to lcte of current channel's parent */ element = a_element; chanx = a_chanx; chan_star_info.chan_entry (element).name = lcnt.names (chanx); chan_star_info.chan_entry (element).mpx_type = lcte.channel_type; if lcte.major_channel_devx <= 0 /* top-level multiplexer, no parent */ then do; chan_star_info.chan_entry (element).parent_type = -1; chan_star_info.chan_entry (element).line_type = LINE_UNKNOWN; end; else do; parent_lctep = addr (lct.lcte_array (lcte.major_channel_devx)); if parent_lctep -> lcte.channel_type = MCS_MPX /* it's a physical channel */ then do; /* get its line type from the PCB */ fnpp = parent_lctep -> lcte.data_base_ptr; pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (lcte.subchannel)); chan_star_info.chan_entry (element).line_type = pcb.line_type; end; else chan_star_info.chan_entry (element).line_type = LINE_UNKNOWN; chan_star_info.chan_entry (element).parent_type = parent_lctep -> lcte.channel_type; end; return; end fill_chan_info; /* CLEANUP_PROC -- cleanup handler for chan_star_list. Frees anything it allocated */ cleanup_proc: proc; if devx_listp ^= null () then free devx_list in (star_area); if chan_star_list_ptr ^= null () then free chan_star_info in (star_area); return; end cleanup_proc; end get_mcm_meters;  priv_channel_manager.pl1 11/11/89 1100.7r w 11/11/89 0800.0 148770 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ priv_channel_manager: procedure; /* This procedure accepts calls to perform privileged channel management functions. Each such call is directed through a transfer vector to the appropriate module according to channel type and functional type. The specified channel is locked before forwarding the call and unlocked upon return. */ /* Coded 7/31/78 by J. Stern */ /* MCM tracing added by C. Hornig, January 1980 */ /* Metering added by C. Hornig, April 1980 */ /* allocation of unwired saved logical channel meters added by Robert Coren, December 1980 */ /* Modified November 1984 by Robert Coren to use tty_area_manager entries */ /* Parameters */ dcl pm_lct_size fixed bin; dcl pm_devx fixed bin; dcl pm_chan_type fixed bin; dcl pm_info_ptr ptr; dcl pm_mii_ptr ptr; dcl pm_chan_name char (*); dcl pm_control_type char (*); dcl pm_code fixed bin (35); /* Automatic */ dcl i fixed bin; dcl found bit (1); dcl devx fixed bin; dcl chan_type fixed bin; dcl db_ptr ptr; dcl locked bit (1) aligned; dcl code fixed bin (35); dcl chan_name char (32); dcl time_in fixed bin (71); /* Conditions */ dcl cleanup condition; dcl area condition; /* External static */ dcl pds$virtual_delta fixed bin (71) ext; dcl error_table_$invalid_state fixed bin (35) ext; dcl error_table_$no_operation fixed bin (35) ext; dcl error_table_$invalid_mpx_type fixed bin (35) ext; dcl error_table_$bad_index fixed bin (35) ext; dcl error_table_$id_not_found fixed bin (35) ext; dcl error_table_$notalloc fixed bin (35) ext; dcl error_table_$smallarg fixed bin (35) ext; /* Builtins */ dcl (addr, clock, codeptr, index, null, unspec, hbound, size) builtin; /* Entries */ dcl create_hproc entry (char (*), bit (1) aligned, ptr, ptr, fixed bin (35)); dcl mcs_timer_daemon entry; dcl tty_area_manager$allocate entry (fixed bin, ptr); dcl tty_area_manager$free entry (fixed bin, ptr); dcl tty_lock$lock_channel entry (fixed bin, fixed bin (35)); dcl tty_lock$unlock_channel entry (fixed bin); dcl tty_lock$flush_queue entry (fixed bin); dcl mcs_trace entry options (variable); %page; /* * * * * * * * * * LCT_INIT * * * * * * * * * */ lct_init: entry (pm_lct_size, pm_code); lct_size = pm_lct_size; ttybp = addr (tty_buf$); if tty_buf.timer_process = ""b then do; call create_hproc ("MCS_Timer_Daemon.SysDaemon.z", "0"b, aptep, codeptr (mcs_timer_daemon), pm_code); if pm_code ^= 0 then return; unspec (tty_buf.timer_ev_chn) = "007777000001000000000001"b3; tty_buf.timer_process = apte.processid; end; if lct_size < 0 then do; pm_code = error_table_$smallarg; return; end; lctp = null; call tty_space_man$get_perm_space (size (lct), lctp); if lctp = null then do; lct_notalloc: pm_code = error_table_$notalloc; return; end; lct.max_no_lctes = lct_size; on area go to lct_notalloc; call tty_area_manager$allocate (size (lcnt), lcntp); revert area; lcnt.names (*) = ""; lct.lcnt_ptr = lcntp; tty_buf.lct_ptr = lctp; pm_code = 0; return; /* * * * * * * * * * INIT_CHANNEL * * * * * * * * * */ init_channel: entry (pm_devx, pm_info_ptr, pm_code); call setup (); if tty_buf.trace.enable then if tty_buf.trace.init then call mcs_trace (devx, "init_channel: ^p", pm_info_ptr); if lcte.initialized | ^lcte.entry_in_use then go to invalid_state; init_channel_ev = make_entry (INIT_CHANNEL, 0); call init_channel_ev (devx, pm_info_ptr, db_ptr, code); if code = 0 then do; lcte.channel_type = 0; lcte.data_base_ptr = db_ptr; lcte.initialized = "1"b; end; pm_code = code; call meter; return; /* * * * * * * * * TERMINATE_CHANNEL * * * * * * * * * */ terminate_channel: entry (pm_devx, pm_code); call setup (); if tty_buf.trace.enable then if tty_buf.trace.init then call mcs_trace (devx, "terminate_channel"); if lcte.channel_type ^= 0 then go to invalid_state; on cleanup call unlock_channel (); call lock_channel (); terminate_channel_ev = make_entry (TERMINATE_CHANNEL, 0); call terminate_channel_ev ((lcte.data_base_ptr), code); if code = 0 then do; lcte.data_base_ptr = null; lcte.initialized = "0"b; lcte.space_needed = "0"b; if ^lcte.special_lock then call tty_lock$flush_queue (devx); /* unlocks the channel lock */ end; else call unlock_channel (); pm_code = code; call meter; return; /* * * * * * * * * INIT_MULTIPLEXER * * * * * * * * * */ init_multiplexer: entry (pm_devx, pm_chan_type, pm_mii_ptr, pm_code); call setup (); chan_type = pm_chan_type; if tty_buf.trace.enable then if tty_buf.trace.init then call mcs_trace (devx, "init_multiplexer: ^a (^p).", mpx_types (pm_chan_type), pm_mii_ptr); if chan_type < 1 | chan_type > hbound (cmtv.chan_type_index, 1) then do; bad_chan_type: pm_code = error_table_$invalid_mpx_type; return; end; if cmtv.chan_type_index (chan_type) < 1 | cmtv.chan_type_index (chan_type) > cmtv.no_channel_types then go to bad_chan_type; miip = pm_mii_ptr; call find_subchan_lctes (); init_multiplexer_ev = make_entry (INIT_MULTIPLEXER, chan_type); call init_multiplexer_ev (devx, miip, db_ptr, code); if code = 0 then do; call allocate_subchan_lctes (); if code = 0 then do; lcte.channel_type = chan_type; lcte.data_base_ptr = db_ptr; lcte.special_lock = mpx_special_lock (chan_type); lcte.initialized = "1"b; end; end; pm_code = code; call meter; return; /* * * * * * * * * * * TERMINATE_MULTIPLEXER * * * * * * * * * */ terminate_multiplexer: entry (pm_devx, pm_code); call setup (); if tty_buf.trace.enable then if tty_buf.trace.init then call mcs_trace (devx, "terminate_multiplexer"); if lcte.channel_type = 0 then go to invalid_state; call check_subchan_lctes (); on cleanup call unlock_channel (); call lock_channel (); terminate_multiplexer_ev = make_entry (TERMINATE_MULTIPLEXER, (lcte.channel_type)); call terminate_multiplexer_ev ((lcte.data_base_ptr), code); if code = 0 then do; lcte.data_base_ptr = null; call free_subchan_lctes (); lcte.initialized = "0"b; lcte.space_needed = "0"b; if ^lcte.special_lock then call tty_lock$flush_queue (devx); /* unlocks channel lock */ end; else call unlock_channel (); pm_code = code; call meter; return; /* * * * * * * * * * * START * * * * * * * * * * */ start: entry (pm_devx, pm_code); call setup (); if tty_buf.trace.enable then if tty_buf.trace.start then call mcs_trace (devx, "start"); on cleanup call unlock_channel (); call lock_channel (); start_ev = make_entry (START, (lcte.channel_type)); call start_ev ((lcte.data_base_ptr), pm_code); call unlock_channel (); call meter; return; /* * * * * * * * * * STOP * * * * * * * * * * */ stop: entry (pm_devx, pm_code); call setup (); if tty_buf.trace.enable then if tty_buf.trace.start then call mcs_trace (devx, "stop"); on cleanup call unlock_channel (); call lock_channel (); stop_ev = make_entry (STOP, (lcte.channel_type)); call stop_ev ((lcte.data_base_ptr), pm_code); call unlock_channel (); call meter; return; /* * * * * * * * * * * SHUTDOWN * * * * * * * * * */ shutdown: entry (pm_devx, pm_code); call setup (); if tty_buf.trace.enable then if tty_buf.trace.shutdown then call mcs_trace (devx, "shutdown"); on cleanup call unlock_channel (); call lock_channel (); shutdown_ev = make_entry (SHUTDOWN, (lcte.channel_type)); call shutdown_ev ((lcte.data_base_ptr), pm_code); call unlock_channel (); call meter; return; /* * * * * * * * * * GET_DEVX * * * * * * * * * * */ get_devx: entry (pm_chan_name, pm_devx, pm_code); call setup_name (); if code = 0 then do; pm_devx = devx; pm_code = 0; return; end; else if index (chan_name, ".") ^= 0 /* not a level-1 multiplexer */ then do; pm_code = code; return; end; /* come here to create lct entry for level-1 multiplexer */ found = "0"b; do i = 1 to lct.max_no_lctes while (^found); devx = i; lctep = addr (lct.lcte_array (devx)); if ^lcte.entry_in_use then found = "1"b; end; if found /* found a free lct entry */ then do; lcte.entry_in_use = "1"b; lcte.data_base_ptr = null; lcnt.names (devx) = chan_name; on area go to get_devx_notalloc; call tty_area_manager$allocate (size (saved_meters), lcte.saved_meters_ptr); pm_code = 0; pm_devx = devx; end; else do; get_devx_notalloc: pm_code = error_table_$notalloc; end; return; /* * * * * * * * * * * * PRIV_CONTROL * * * * * * * * * * */ priv_control: entry (pm_chan_name, pm_control_type, pm_info_ptr, pm_code); call setup_name (); if code ^= 0 then do; pm_code = code; return; end; if tty_buf.trace.enable then if tty_buf.trace.control then call mcs_trace (devx, "priv_control: ^a (^p)", pm_control_type, pm_info_ptr); call lock_channel (); if lcnt.names (devx) ^= chan_name /* name changed before channel was locked */ then pm_code = error_table_$id_not_found; else do; priv_control_ev = make_entry (PRIV_CONTROL, (lcte.channel_type)); call priv_control_ev ((lcte.data_base_ptr), pm_control_type, pm_info_ptr, pm_code); end; call unlock_channel (); call meter; return; /* * * * * * * * * * * * HPRIV_CONTROL * * * * * * * * * * */ hpriv_control: entry (pm_chan_name, pm_control_type, pm_info_ptr, pm_code); call setup_name (); if code ^= 0 then do; pm_code = code; return; end; if tty_buf.trace.enable then if tty_buf.trace.control then call mcs_trace (devx, "hpriv_control: ^a (^p)", pm_control_type, pm_info_ptr); call lock_channel (); if lcnt.names (devx) ^= chan_name /* name changed before channel was locked */ then pm_code = error_table_$id_not_found; else do; hpriv_control_ev = make_entry (HPRIV_CONTROL, (lcte.channel_type)); call hpriv_control_ev ((lcte.data_base_ptr), pm_control_type, pm_info_ptr, pm_code); end; call unlock_channel (); call meter; return; invalid_state: code = error_table_$invalid_state; error_exit: call unlock_channel (); pm_code = code; return; /* * * * * * * * * * SETUP * * * * * * * * * * */ setup: procedure; time_in = clock () - pds$virtual_delta; locked = "0"b; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; if lctp = null then go to no_devx; devx = pm_devx; if devx < 1 | devx > lct.max_no_lctes then do; no_devx: code = error_table_$bad_index; go to error_exit; end; lctep = addr (lct.lcte_array (devx)); cmtvp = addr (cmtv$cmtv); end setup; /* setup */ /* * * * * * * * * * * SETUP_NAME * * * * * * * * * * * * */ setup_name: procedure; time_in = clock () - pds$virtual_delta; code = 0; locked = "0"b; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; if lctp = null then do; no_name: code = error_table_$id_not_found; go to error_exit; end; lcntp = lct.lcnt_ptr; chan_name = pm_chan_name; if chan_name = "" then go to no_name; do devx = 1 to lct.max_no_lctes while (lcnt.names (devx) ^= chan_name); end; if devx > lct.max_no_lctes then do; code = error_table_$id_not_found; return; end; lctep = addr (lct.lcte_array (devx)); cmtvp = addr (cmtv$cmtv); end setup_name; /* setup_name */ /* * * * * * * * * * METER * * * * * * * * * */ meter: procedure; lcte.meters.control.calls = lcte.meters.control.calls + 1; lcte.meters.control.call_time = lcte.meters.control.call_time + clock () - pds$virtual_delta - time_in; end meter; /* * * * * * * * * * * MAKE_ENTRY * * * * * * * * * * */ make_entry: proc (entry_type, chan_type) returns (entry variable); /* kludges together an entry variable */ dcl entry_type fixed bin; dcl chan_type fixed bin; dcl code_ptr ptr; dcl code_word fixed bin based (code_ptr); dcl new_entry entry variable; dcl 1 entry_var aligned, 2 code_ptr ptr, 2 env_ptr ptr; code_ptr = addr (cmtv.entries (entry_type, cmtv.chan_type_index (chan_type))); if code_word = 0 /* undefined entry point */ then do; code = error_table_$no_operation; go to error_exit; end; entry_var.code_ptr = code_ptr; entry_var.env_ptr = null; unspec (new_entry) = unspec (entry_var); return (new_entry); end; /* get_entry */ /* * * * * * * * * * * LOCK_CHANNEL * * * * * * * * * * */ lock_channel: procedure; if ^lcte.entry_in_use then go to invalid_state; if lcte.special_lock /* not for us to lock */ then return; call tty_lock$lock_channel (devx, code); if code ^= 0 then go to error_exit; locked = "1"b; end lock_channel; /* lock_channel */ /* * * * * * * * * * * * UNLOCK_CHANNEL * * * * * * * * * * * */ unlock_channel: procedure; if locked then call tty_lock$unlock_channel (devx); locked = "0"b; end unlock_channel; /* unlock_channel */ /* * * * * * * * * * CHECK_SUBCHAN_LCTES * * * * * * * * * */ check_subchan_lctes: procedure; dcl lctx fixed bin; dcl p ptr; do lctx = 1 to lct.max_no_lctes; p = addr (lct.lcte_array (lctx)); if p -> lcte.major_channel_devx = devx then if p -> lcte.initialized then go to invalid_state; end; end; /* check_subchan_lctes */ /* * * * * * * * * * * * * FREE_SUBCHAN_LCTES * * * * * * * * * * */ free_subchan_lctes: procedure; dcl lctx fixed bin; dcl p ptr; lcntp = lct.lcnt_ptr; do lctx = 1 to lct.max_no_lctes; p = addr (lct.lcte_array (lctx)); if p -> lcte.major_channel_devx = devx then do; lcnt.names (lctx) = ""; call tty_area_manager$free (size (saved_meters), p -> lcte.saved_meters_ptr); unspec (p -> lcte.meters) = "0"b; /* to avoid confusion later */ p -> lcte.major_channel_devx = 0; p -> lcte.entry_in_use = "0"b; end; end; end; /* free_subchan_lctes */ /* * * * * * * * * * FIND_SUBCHAN_LCTES * * * * * * * * * * * */ find_subchan_lctes: procedure; /* finds unused lct entries */ dcl (lctx, sbchx) fixed bin; dcl p ptr; sbchx = 0; do lctx = 1 to lct.max_no_lctes while (sbchx < mux_init_info.no_channels); p = addr (lct.lcte_array (lctx)); if ^p -> lcte.entry_in_use then do; sbchx = sbchx + 1; mux_init_info.channels (sbchx).devx = lctx; end; end; if sbchx < mux_init_info.no_channels then do; code = error_table_$notalloc; go to error_exit; end; end; /* find_subchan_lctes */ /* * * * * * * * * * * * ALLOCATE_SUBCHAN_LCTES * * * * * * * * * * */ allocate_subchan_lctes: proc; /* marks previously found lct entries "in use" */ dcl (lctx, sbchx) fixed bin; dcl p ptr; lcntp = lct.lcnt_ptr; do sbchx = 1 to mux_init_info.no_channels; lctx = mux_init_info.channels (sbchx).devx; lcnt.names (lctx) = mux_init_info.channels (sbchx).name; p = addr (lct.lcte_array (lctx)); p -> lcte.major_channel_devx = devx; if lcte.physical_channel_devx = 0 /* major channel is an FNP */ then p -> lcte.physical_channel_devx = lctx; /* FNP subchan is its own physical channel */ else p -> lcte.physical_channel_devx = lcte.physical_channel_devx; /* same as major channel */ p -> lcte.entry_in_use = "1"b; on area go to subchan_not_alloc; call tty_area_manager$allocate (size (saved_meters), p -> lcte.saved_meters_ptr); end; return; subchan_not_alloc: code = error_table_$notalloc; return; end; /* allocate_subchan_lctes */ %page; %include lct; %include cmtv; %include mux_init_info; %include multiplexer_types; %include tty_space_man_dcls; %include tty_buf; %include apte; end priv_channel_manager; /* priv_channel_manager */  priv_mcs_trace.pl1 11/11/89 1100.7r w 11/11/89 0802.3 55602 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ priv_mcs_trace: procedure; /* Control entrypoints for the MCM tracing software. */ /* Written by C. Hornig, March 1980 */ /* Updated for set_channel_trace, set_global_trace, 10 March 82, W. Olin Sibert */ declare Table_size fixed bin parameter; /* entries in trace table */ declare Global_trace_flags bit (*) parameter; declare Devx fixed bin parameter; declare Channel_trace_flags bit (2) aligned parameter; declare Code fixed bin (35) parameter; declare 1 trace_flags unaligned automatic like tty_buf.trace.flags; declare devx fixed bin; declare channel_trace_flags bit (2) aligned; declare (addr, binary, bit, currentsize, mod, null, pointer, rel, size, stacq, string, substr, unspec) builtin; %include mcs_trace_data; declare (error_table_$invalid_state, error_table_$invalid_device, error_table_$noalloc) fixed bin (35) external static; declare bit_offset_ entry (pointer) returns (fixed bin (24)); %page; /* * * * * * * * * * SET_TRACE_TABLE_SIZE * * * * * * * * * */ set_trace_table_size: entry (Table_size, Code); Code = 0; trace_array_size = Table_size; call find_stuff; if trace_array_size <= 0 then do; /* wants to delete table */ if trace_array_ptr = null () then return; if tty_buf.trace.enable then do; /* must be disabled */ Code = error_table_$invalid_state; return; end; tty_buf.trace.data_offset = ""b; call tty_space_man$free_space (currentsize (trace_array), trace_array_ptr); /* free the array */ end; else do; /* allocate a table */ if trace_array_ptr ^= null () then do; Code = error_table_$invalid_state; return; end; call tty_space_man$get_space (size (trace_array), trace_array_ptr); if trace_array_ptr = null () then do; Code = error_table_$noalloc; return; end; trace_array.num_entries = trace_array_size; trace_array.idx = bit (binary (1, 36)); unspec (trace_array.entry) = ""b; tty_buf.trace.data_offset = rel (trace_array_ptr); string (tty_buf.trace.flags) = ""b; /* Turn it all off to start with */ end; return; %page; /* * * * * * * * * * GET_TRACE_TABLE_SIZE * * * * * * * * * */ get_trace_table_size: entry (Table_size, Code); Code, Table_size = 0; call find_stuff; if trace_array_ptr ^= null () then Table_size = trace_array.num_entries; else Table_size = 0; return; %page; /* * * * * * * * * * * SET_GLOBAL_TRACE * * * * * * * * * * */ set_global_trace: entry (Global_trace_flags, Code); call find_stuff; if trace_array_ptr = null () then do; Code = error_table_$invalid_state; return; end; string (trace_flags) = Global_trace_flags; tty_buf.trace.flags = trace_flags; Code = 0; return; %page; /* * * * * * * * * * * SET_CHANNEL_TRACE * * * * * * * * * * */ /* Turns on tracing for an individual channel entry. Note that the channel does not have to be currently in use or anything like that. The word containing the trace flags is updated with stacq for precisely this reason, since we don't lock the channel here, either. */ set_channel_trace: entry (Devx, Channel_trace_flags, Code); call find_stuff; devx = Devx; channel_trace_flags = Channel_trace_flags; Code = 0; if (devx < 1) | (devx > lct.max_no_lctes) then do; Code = error_table_$invalid_device; return; end; lctep = addr (lct.lcte_array (devx)); call setbit (lcte.trace, substr (channel_trace_flags, 1, 1)); call setbit (lcte.trace_force, substr (channel_trace_flags, 2, 1)); Code = 0; return; %page; /* * * * * * * * * * * SETBIT * * * * * * * * * * */ setbit: procedure (P_bit, P_value); declare P_bit bit (1) unaligned parameter; declare P_value bit (1) unaligned parameter; declare word_ptr pointer; declare based_word bit (36) aligned based; declare old_value bit (36) aligned; declare new_value bit (36) aligned; declare bit_number fixed bin; /* This procedure is used to set the bits in the lcte flag word which control tracing. It uses stacq in this fashion because it doesn't want to try locking the lcte, since it might be uninitialized or something like that, and tracing is supposed to be completely independent of the rest of MCS. */ /* ***** Note that the use of stacq here depends on the ability for stacq to interlock with RAR type instructions (ansa, orsa) which are used elsewhere to set bits. */ word_ptr = addr (P_bit); /* Find the word, and which bit we're to set */ bit_number = 1 + mod (bit_offset_ (word_ptr), 36); word_ptr = pointer (word_ptr, rel (word_ptr)); /* Align to word boundary */ old_value = word_ptr -> based_word; /* Set the requested bit */ new_value = old_value; substr (new_value, bit_number, 1) = P_value; do while (^stacq (word_ptr -> based_word, new_value, old_value)); old_value = word_ptr -> based_word; /* Keep trying to update indivisibly */ new_value = old_value; substr (new_value, bit_number, 1) = P_value; end; return; end setbit; %page; /* * * * * * * * * * * FIND_STUFF * * * * * * * * * * */ find_stuff: procedure; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; if tty_buf.trace.data_offset = ""b then trace_array_ptr = null (); else trace_array_ptr = pointer (ttybp, tty_buf.trace.data_offset); end find_stuff; /* * * * * * * * * * * * * * * * * * * */ %include tty_buf; %include lct; %include tty_space_man_dcls; end priv_mcs_trace;  tty_area_manager.pl1 11/11/89 1100.7r w 11/11/89 0802.3 25551 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ tty_area_manager: procedure (); /* Set of entries for allocating and freeing in tty_area under control of a lock, kept in tty_buf. The lock_fast mechanism is used. */ /* Written November 1984 by Robert Coren */ dcl Size fixed bin parameter; dcl Result_ptr pointer parameter; dcl Free_ptr pointer parameter; dcl locked bit (1); dcl alloc_size fixed bin; dcl alloc_ptr pointer; dcl tty_area$ area external static; dcl 1 tty_buf$tty_area_lock like hc_fast_lock external static; dcl words (alloc_size) based (alloc_ptr); dcl lock$lock_fast entry (pointer); dcl lock$unlock_fast entry (pointer); dcl cleanup condition; dcl (addr, null) builtin; %page; /* allocate: allocates space of a specified size in tty_area */ /* it's up to the caller to handle area conditions */ allocate: entry (Size, Result_ptr); locked = "0"b; on cleanup call UNLOCK (locked); call LOCK (locked); alloc_size = Size; allocate words in (tty_area$) set (alloc_ptr); call UNLOCK (locked); Result_ptr = alloc_ptr; return; %page; /* free: frees the specified number of words in tty_area */ free: entry (Size, Free_ptr); locked = "0"b; on cleanup call UNLOCK (locked); call LOCK (locked); alloc_size = Size; alloc_ptr = Free_ptr; free words in (tty_area$); call UNLOCK (locked); Free_ptr = null (); return; %page; /* lock_area and unlock_area: called by programs that aren't just doing a single allocate or free operation (e.g., sty_mpx, whose allocations are done within calls to mode_string_$parse) */ lock_area: entry (); locked = "0"b; call LOCK (locked); return; unlock_area: entry (); locked = "1"b; call UNLOCK (locked); return; %page; /* LOCK and UNLOCK: the internal procedures that actually call the hc_lock entries */ LOCK: procedure (locked); dcl locked bit (1) parameter; call lock$lock_fast (addr (tty_buf$tty_area_lock)); locked = "1"b; return; /* short and sweet */ end LOCK; UNLOCK: procedure (locked); dcl locked bit (1) parameter; if locked then do; /* this test is in case the cleanup handler ran when we weren't locked */ call lock$unlock_fast (addr (tty_buf$tty_area_lock)); locked = "0"b; end; return; end UNLOCK; %page; %include hc_fast_lock; end tty_area_manager; 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