call_bce.pl1 11/11/89 1133.2r w 11/11/89 0825.5 13977 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* CALL_BCE - Program to call the bootload command environment (bce). recoded 9/30/76 by Noel I. Morris converted from call_bos 8/83 by Keith Loepere */ call_bce: proc; dcl privileged_mode_ut$bce_and_return entry, syserr entry options (variable); dcl addr builtin; % include flagbox; fgbxp = addr (flagbox$); /* Get pointer to flagbox segment. */ fgbx.call_bce = "1"b; /* Turn on the bce call flag. */ call syserr (0, "call_bce: bce called from Multics."); call privileged_mode_ut$bce_and_return; /* Transfer control to bce. It will return after continue is typed at the operator's console. */ fgbx.call_bce = "0"b; /* Turn off flag now. */ return; /* Return to caller */ /* BEGIN MESSAGE DOCUMENTATION Message: call_bce: bce called from Multics. S: $info T: $run M: An outer ring program has called hphcs_$call_bce. This is usually done after printing an explanatory message. The system will resume operation if continue is typed. A: $recover END MESSAGE DOCUMENTATION */ end;  dbr_util_.pl1 11/11/89 1133.2r w 11/11/89 0825.5 14787 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ dbr_util_: proc; /* Routine to take apart (and assemble?) dbr (descriptor segment base register) values. Initially coded by Keith Loepere, October 1983. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl dbr_ptr ptr parameter; dcl p_dbr_info_ptr ptr parameter; dcl sys_info$system_type fixed bin external static; %page; dissect: entry (dbr_ptr, p_dbr_info_ptr); dbr_info_ptr = p_dbr_info_ptr; if sys_info$system_type = ADP_SYSTEM then do; dbr_info.address = bin (dbr_ptr -> adp_dbr.add, 26); dbr_info.bound = (bin (dbr_ptr -> adp_dbr.bound, 14) + 1) * 16; dbr_info.stack_base_segnum = dbr_ptr -> adp_dbr.stack_base_segno * 8; dbr_info.paged = ^ dbr_ptr -> adp_dbr.unpaged; end; else do; dbr_info.address = bin (dbr_ptr -> l68_dbr.add, 24); dbr_info.bound = (bin (dbr_ptr -> l68_dbr.bound, 14) + 1) * 16; dbr_info.stack_base_segnum = dbr_ptr -> l68_dbr.stack_base_segno * 8; dbr_info.paged = ^ dbr_ptr -> l68_dbr.unpaged; end; return; %page; %include "dbr.adp"; %page; %include "dbr.l68"; %page; %include dbr_info; %page; %include system_types; end;  delete_segs.pl1 11/11/89 1133.2r w 11/11/89 0825.5 35667 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * *********************************************************** */ delete_segs: procedure; /* RE Mullen, v2pl1 oct 1973 */ /* Modified by Andre Bensoussan for new storage system - Feb 1975 */ /* 5/13/76 by BSG for prewithdrawing */ /* Modified March 1982, J. Bongiovanni, not to deposit addresses for init and temp segs */ /* Modified August 1982, J. Bongiovanni, to eliminate RLV parasites */ /* Modified November 1982 by C. Hornig to zero LOT entries */ /* Modified October 1983 to properly handle abs-segs */ /* Modified December 1983 by Keith Loepere for breakpoint page processing */ dcl list bit (18) unaligned based (aste_list_ptr); dcl seg_size fixed bin (26); dcl segno fixed bin (15); dcl ptsi fixed bin (2); /* page table size index (0-3 => 4k-256k) */ dcl aste_list_ptr ptr; dcl pc$cleanup entry (ptr); dcl pc$truncate entry (ptr, fixed bin); dcl ptw_util_$make_null entry (ptr, bit (22) aligned); dcl sdw_util_$get_size entry (ptr, fixed bin (26)); dcl thread$cin entry (ptr, bit (18)); dcl thread$out entry (ptr, bit (18)); dcl dseg$ (0:4095) fixed bin (71) external; dcl lot$ (0:4095) fixed bin (35) external; dcl slt$ external; dcl sst$ external; dcl sst$ainitp bit (18) unaligned external; dcl sst$atempp bit (18) unaligned external; dcl 1 sst$level (0:3) aligned external, 2 ausedp bit (18) unaligned, 2 no_aste bit (18) unaligned; dcl (addr, addrel, divide, ptr, rel, size, fixed) builtin; %page; /* * * * * * * * * TEMP * * * * * * * * * */ temp: entry; sltp = addr (slt$); aste_list_ptr = addr (sst$atempp); call expunge_segs; return; /* * * * * * * * * * * DELETE_SEGS_INIT * * * * * * * * * */ delete_segs_init: entry; sltp = addr (slt$); /* Get pointer to the SLT. */ aste_list_ptr = addr (sst$ainitp); call expunge_segs; do segno = slt.first_init_seg to slt.last_init_seg; /* Iterate through the SLT init segs. */ dseg$ (segno) = 0; /* Clear the SDW. */ lot$ (segno) = 0; end; return; expunge_segs: proc; /* delete segs in sst list */ do while (aste_list_ptr -> list ^= "0"b); /* Loop over all entries on list. */ astep = ptr (addr (sst$), aste_list_ptr -> list); /* Set AST pointer to next (top) entry. */ segno = fixed (astep -> aste.strp, 15); /* Get segment number from AST entry */ sltep = addr (slt.seg (segno)); if slte.breakpointable & slte.wired then do; /* don't truncate breakpoint_page */ call sdw_util_$get_size (addr (dseg$ (segno)), seg_size); call ptw_util_$make_null (addrel (astep, size (aste) + divide (seg_size, 1024, 17) - 1), make_sdw_null_addr); end; dseg$ (segno) = 0; /* Zero the SDW. */ lot$ (segno) = 0; ptsi = fixed (astep -> aste.ptsi, 2); astep -> aste.ddnp = "0"b; /* Uninhibit depositable address reporting */ if slte.abs_seg then call pc$cleanup (astep);/* Just flush pages not in hc part */ else call pc$truncate (astep, 0); /* free hc part pages */ call thread$out (astep, aste_list_ptr -> list); /* Thread entry out of its list. */ call thread$cin (astep, sst$level.ausedp (ptsi)); /* thread the entry into the used list */ sst$level.ausedp (ptsi) = rel (astep); astep -> aste_part.two = "0"b; /* Zero the ASTE except fp, bp, ptsi and marker */ end; return; end; %page; %include aste; %include null_addresses; %include slt; %include slte; end delete_segs;  fast_connect_init.alm 11/11/89 1133.2r w 11/11/89 0825.5 139095 " *********************************************************** " * * " * 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. * " * * " *********************************************************** """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " fast_connect_init " " " " This routine is called during initialization of the prds " " to initialize the connect fault handling code. " " " " The code is copied to the prds, and is called directly on " " a connect fault via the connect fault vector. Its " " purpose is to optimize the most frequent type of connect " " fault (to clear cam/cache) by doing so with minimal " " context saving/restoring. It also checks for other types " " of connects, and transfers to wired_fim if necessary to " " handle these. Otherwise, it returns to the interrupted " " process. " " " " This routine does the following: " " " " 1. copies the fast connect code (contained " " herein) to the prds " " 2. fills in its pointers needed by this code " " 3. adjusts its pointers for per-processor arrays " " to point to the correct array elements " " " " Calling sequence: " " " " call fast_connect_init (prds_ptr, processor_tag, code) " " " " prds_ptr = pointer to prds being initialized " " processor_tag = cpu tag for cpu being initialized" " code = status code (0=>OK, ^0=>incorrect code " " size) " " " " " " Written February 1981 by J. Bongiovanni " " Modified 84-01-10 by SGH (UNCA) to fix cam_wait race. " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" name fast_connect_init entry fast_connect_init " include apte include scs include fault_vector include mc " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " This is the fast connect code which is copied to the prds " " " " This code does the following " " " " 1. As quickly as possible, check for cam/cache-clear " " pending and do it " " " " 2. With minimal register usage, check for other types of " " connects (saving all registers it uses). To speed " " things up, skip checks for this processor (e.g., check " " for sys_trouble_pending on any processor). The real " " connect handler will straighten things out. Also check " " for tracing machine conditions. " " " " 3. If no other type of connect pending, restore all " " registers it uses (hopefully not many), and return to " " the interrupted process directly " " " " 4. If any other type of connect pending, restore all " " registers it uses, and transfer to the connect fault " " handler " " " " If the size of this code changes, this must be reflected " " in the prds " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" inhibit on <+><+><+><+><+><+><+><+><+><+><+><+><+><+><+><+> even fast_connect_code: staq save_aq_temp-*,ic we only use/restore a and q szn fast_cam_pending_cpu-*,ic* cam/cache pending this cpu tze next-*,ic no--check for other connects szn cam_wait-*,ic* cam with wait tnz continue_quick-*,ic yes--go to connect handler xed cam_pair-*,ic* cam/cache clear stz fast_cam_pending_cpu-*,ic* flag that we cleared next: staq save_aq_temp-*,ic we only use/restore a and q szn sys_trouble_pending-*,ic* sys_trouble action going down tnz continue-*,ic yes--go to connect handler szn processor_start_wait-*,ic* waiting for cpu to start tnz continue-*,ic yes--go to connect handler lda processor_data_cpu-*,ic* processor data this cpu cana processor_data.delete_cpu,du should this cpu delete self tnz continue-*,ic yes--go to connect handler lda apte.flags,du au=offset into apte to check apte_ptr_au_1: ldq 0,*au ldq with my apte.flags canq apte.pre_empt_pending+apte.stop_pending,du tnz continue-*,ic pre-empt or stop lda apte.ips_message,du au=offset into apte to check apte_ptr_au_2: ldq 0,*au ldq with my apte.ips_message tnz continue-*,ic ips message pending szn pds_mc_trace_sw-*,ic* are we tracing machine conditions tmi continue-*,ic yes--go to connect handler lda scu.indicators_word,du check whether EIS instruction lda scu_info_au-*,ic* was interrupted cana scu.ir.mif,dl in mid-stream tze skip_spl_lpl-*,ic transfer if not lda mc.eis_info-mc.scu,du we must reset the EIS box spl scu_info_au-*,ic* thusly lpl scu_info_au-*,ic* skip_spl_lpl: lda scu.cpu_no_word,du get offset of SCU2 in AU lda scu_info_au-*,ic* load A with SCU2 ana scu.cpu_no_mask,dl mask unwanted bits als 7+12 right justify in AU, multiply by 128 aos fault_counters_connect-*,ic* bump count of connect faults ldaq save_aq_temp-*,ic restore what we used cache_luf_reg: lcpr 0,02 turn on cache (prds$cache_luf_reg) mode_reg_enabled: lcpr 0,04 and history registers (prds$mode_reg_enabled) rcu scu_info-*,ic* and restart continue: continue_quick: lda scu.cpu_no_word,du get offset of SCU2 in AU lda scu_info_au-*,ic* load A with SCU2 ana scu.cpu_no_mask,dl mask unwanted bits als 7+12 right justify in AU, multiply by 128 aos fault_counters_connect-*,ic* bump count of connect faults ldaq save_aq_temp-*,ic restore what we used tra connect_handler-*,ic* do full connect fault inhibit off <-><-><-><-><-><-><-><-><-><-><-><-><-><-><-> " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " its pointers and data for fast connect code " " This also lives on the prds " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" even save_aq_temp: bss ,2 temp storage for a and q fast_cam_pending_cpu: its -1,1 scs$fast_cam_pending+ cam_pair: its -1,1 scs$cam_pair cam_wait: its -1,1 scs$cam_wait fault_counters_connect: its -1,1 wired_hardcore_data$fault_counters " +FAULT_NO_CON mod by AU sys_trouble_pending: its -1,1 scs$sys_trouble_pending processor_start_wait: its -1,1 scs$processor_start_wait processor_data_cpu: its -1,1 scs$processor_data+ scu_info: its -1,1 copy of its pointer for scu in fault_vector scu_info_au: its -1,1 its pointer for scu in FV mod by au connect_handler: its -1,1 wired_fim$connect_handler pds_mc_trace_sw: its -1,1 pds$mc_trace_sw equ fast_connect_code_words,*-fast_connect_code equ fast_connect_code_chars,4*fast_connect_code_words """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " End of fast connect code copied to prds " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " link fast_cam_pending_cpu_link,scs$fast_cam_pending link cam_pair_link,scs$cam_pair link cam_wait_link,scs$cam_wait link fault_counters_connect_link,wired_hardcore_data$cpu_a_flt_ctr_array+FAULT_NO_CON,au link sys_trouble_pending_link,scs$sys_trouble_pending link processor_start_wait_link,scs$processor_start_wait link processor_data_cpu_link,scs$processor_data link apte_ptr_au_1_link,prds$apt_ptr link apte_ptr_au_2_link,prds$apt_ptr link cache_luf_reg_link,prds$cache_luf_reg link mode_reg_enabled_link,prds$mode_reg_enabled link fast_connect_code_link,prds$fast_connect_code link fast_connect_code_end_link,prds$fast_connect_code_end link scu_info_link,fault_vector$0+fv.f_scu_ptr+2*FAULT_NO_CON,* link connect_handler_link,wired_fim$connect_handler link scu_info_au_link,fault_vector$0+fv.f_scu_ptr+2*FAULT_NO_CON,*au link pds_mc_trace_sw_link,pds$mc_trace_sw equ pr2,2 equ pr4,4 " so that symbolic itp works " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Table to define its pointers in prds to be filled in " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" macro its_link itp pr4,&1_link itp pr2,&1-fast_connect_code &end even its_link_table: its_link fast_cam_pending_cpu its_link cam_pair its_link cam_wait its_link fault_counters_connect its_link sys_trouble_pending its_link processor_start_wait its_link processor_data_cpu its_link scu_info its_link scu_info_au its_link connect_handler its_link pds_mc_trace_sw its_link_table_end: equ its_link_table_entry,4 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Table of its pointers which refer to per-processor arrays " " These pointers are adjusted by cpu tag " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" macro cpu_reloc itp pr2,&1_cpu-fast_connect_code+1 &end cpu_tag_reloc_table: cpu_reloc fast_cam_pending cpu_reloc processor_data cpu_tag_reloc_table_end: equ cpu_tag_reloc_entry,2 " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Table of instructions which refer to prds locations " " outside of the fast connect code. These will be " " set appropriately. " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" macro prds_rel itp pr4,&1_link itp pr2,&1-fast_connect_code &end prds_rel_table: prds_rel apte_ptr_au_1 prds_rel apte_ptr_au_2 prds_rel cache_luf_reg prds_rel mode_reg_enabled prds_rel_table_end: equ prds_rel_table_entry,4 " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Make sure the space reserved in the prds is the " " right size " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" fast_connect_init: stz pr0|6,* clear return code eaa pr4|fast_connect_code_link,* au=offset of begin of code in prds neg eax0 pr4|fast_connect_code_end_link,*au x0=length of area for code cmpx0 fast_connect_code_words,du expected length tze copy_fast_connect_code correct stc1 pr0|6,* return non-zero error code short_return (no error_table_ yet) """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Move the fast connect code to the prds " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" copy_fast_connect_code: epp1 pr0|2,* epp1 pr1|0,* pr1 -> base of new prds epaq pr4|fast_connect_code_link,* its pointer to prds$fast_connect_code epp2 pr1|0,qu pr2->fast connect code in new prds mlr (),(pr) desc9a fast_connect_code,fast_connect_code_chars desc9a pr2|0,fast_connect_code_chars " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Fill in its pointers " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" ldx0 its_link_table_end-its_link_table,du next_its: eax0 -its_link_table_entry,x0 bump to next entry tmi its_done done table ldaq its_link_table,x0* proper its pointer staq its_link_table+2,x0* fill it in tra next_its its_done: """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Adjust its pointers which refer to per-processor arrays " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" ldx0 cpu_tag_reloc_table_end-cpu_tag_reloc_table,du lxl1 pr0|4,* cpu tag for new processor next_cpu_tag: eax0 -cpu_tag_reloc_entry,x0 bump to next table entry tmi cpu_tag_done done table asx1 cpu_tag_reloc_table,x0* adjust pointer by cpu tag tra next_cpu_tag cpu_tag_done: " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Adjust addresses of instructions which refer to prds " " cells outside of the fast connect code " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" ldx0 prds_rel_table_end-prds_rel_table,du next_prds_rel: eax0 -prds_rel_table_entry,x0 bump to next table entry tmi prds_rel_done done table ldaq prds_rel_table,x0* its pointer into prds eax1 0,qu offset into prds stx1 prds_rel_table+2,x0* into address field of instruction tra next_prds_rel prds_rel_done: short_return end  flagbox_mgr.pl1 11/11/89 1133.2r w 11/11/89 0825.5 14202 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ /* Modified '83 by Keith Loepere for (get set)_bce_command */ flagbox_mgr: proc; /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl addr builtin; dcl string builtin; set: entry (turnon, turnoff); dcl turnon bit (36); dcl turnoff bit (36); fgbxp = addr (flagbox$); string (fgbx.flags) = string (fgbx.flags) & ^turnoff; string (fgbx.flags) = string (fgbx.flags) | turnon; return; get: entry (sws); dcl sws bit (36); fgbxp = addr (flagbox$); sws = string (fgbx.flags); return; set_bce_command: entry (bce_command); dcl bce_command char (128); fgbxp = addr (flagbox$); fgbx.return_to_bce_command = bce_command; return; get_bce_command: entry (bce_command); fgbxp = addr (flagbox$); bce_command = fgbx.return_to_bce_command; return; %page; %include flagbox; end flagbox_mgr;  freecore.pl1 11/11/89 1133.2rew 11/11/89 0825.5 45333 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* This is an procedure to add a block of free core to the used list. This is called during initialization and reconfiguration Modified 3/2/76 by Noel I. Morris for new reconfig Modified 6/21/82 by E. N. Kittlitz to move core map. Modified 4/11/84 by Keith Loepere for thread entrypoint. Modified 1985-03-11, BIM: call check_parity_for_add. */ freecore: proc (page_no); dcl page_no fixed bin, /* number of the page being added */ page fixed bin, /* copy of page number */ code fixed bin (35), saved_mask fixed bin (71), /* saved interrupt mask */ stk_ptwp ptr, /* pointer to wired stack page page table word */ usedptr ptr; /* pointer to first entry on used list */ dcl pmut$lock_ptl entry (fixed bin (71), ptr), syserr entry options (variable), pmut$check_parity_for_add entry (fixed bin, fixed bin (35)), pmut$unlock_ptl entry (fixed bin (71), ptr), wire_proc$wire_me entry, wire_proc$unwire_me entry; dcl (addr, bin, ptr, rel) builtin; dcl sst$cmp ptr ext; dcl sst$first_core_block fixed bin ext; dcl sst$last_core_block fixed bin ext; dcl sst$nused fixed bin ext; dcl sst$usedp bit (18) ext; dcl sst$wusedp bit (18) aligned ext; %page; %include scs; %page; %include cmp; %page; %include syserr_constants; %page; page = page_no; /* copy argument to (soon to be wired) stack */ call wire_proc$wire_me; /* wire ourself down before we lock page table */ call pmut$lock_ptl (saved_mask, stk_ptwp); /* lock and mask */ cmep = addr (sst$cmp -> cma (page)); /* get pointer to core map entry */ if cme.bp = (18)"1"b then do; /* only free what's not being used */ /* Check for any parity errors reading the memory */ call pmut$check_parity_for_add (page, code); if code ^= 0 then call syserr (ANNOUNCE, "freecore: parity error in frame ^o of memory.", page); else do; call thread_into_cmes; cmep -> cme.ptwp = (18)"0"b; /* mark this entry as free */ cmep -> cme.abs_w, cmep -> cme.removing = "0"b; /* clear flags for entry */ if scs$controller_data (bin (cmep -> cme.contr)).abs_wired /* check if pages in this controller are abs_wired */ then cmep -> cme.abs_usable = "1"b; /* mark this page */ end; end; call pmut$unlock_ptl (saved_mask, stk_ptwp); /* unlock and unmask */ call wire_proc$unwire_me; /* unwire this procedure */ return; %page; thread_into_cmes: proc; if sst$usedp /* check if list has any entries */ then do; /* add block to existing list */ usedptr = ptr (sst$cmp, sst$usedp); /* get pointer to first entry */ cmep -> cme.bp = usedptr -> cme.bp; /* thread at end of list */ cmep -> cme.fp = rel (usedptr); ptr (sst$cmp, usedptr -> cme.bp) -> cme.fp, usedptr -> cme.bp = rel (cmep); if page > sst$last_core_block then sst$last_core_block = page; else if page < sst$first_core_block then sst$first_core_block = page; end; else do; /* first entry to go on the list */ cmep -> cme.bp, cmep -> cme.fp = rel (cmep); /* thread first entry to self */ sst$first_core_block, sst$last_core_block = page; /* initialize core bounds */ sst$wusedp = rel (cmep); /* init write pointer */ end; if sst$usedp = sst$wusedp then sst$wusedp = rel (cmep); /* dont let wusedp get out of sync */ sst$usedp = rel (cmep); /* update list pointer to start here */ sst$nused = sst$nused + 1; /* record that one page was added */ return; end; %page; thread: entry (page_no); /* Don't fiddle with page or cme, just thread into cme list */ page = page_no; /* copy argument to (soon to be wired) stack */ call wire_proc$wire_me; /* wire ourself down before we lock page table */ call pmut$lock_ptl (saved_mask, stk_ptwp); /* lock and mask */ cmep = addr (sst$cmp -> cma (page)); /* get pointer to core map entry */ call thread_into_cmes; call pmut$unlock_ptl (saved_mask, stk_ptwp); /* unlock and unmask */ call wire_proc$unwire_me; /* unwire this procedure */ return; %page; /* BEGIN MESSAGE DOCUMENTATION Message: freecore: parity error in frame XXX of memory. S: $info T: $init M: A memory parity error has been detected in page XXX of memory. The page will not be put in use. A: $ignore END MESSAGE DOCUMENTATION */ end freecore;  get_main.pl1 11/11/89 1133.2rew 11/11/89 0825.5 75069 /****^ *********************************************************** * * * 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,tree,ifthenstmt,indnoniterend */ get_main: procedure (Segp, Size, Tsdw); /* * Subroutine to provide a wired, contiguous buffer/working segment for its caller. * If this subroutine is called before paging is enabled (or at least before init_sst * is called) the buffer/working segment will be allocated from the storage between * the perm-wired segments and the paged segments. Otherwise pc_abs is called to * find the necessary storage. * * If the SLTE for the specified segment indicates it is paged, the storage is * acquired fron that just below the paged segments, otherwise the storage * just after the wired segments is used. * * call get_main (Segp, size, Tsdw); * * 1. Segp is a pointer to the segment wanted. (Input) * * 2. size is the size of the segment wanted (in words) * The parameter is returned as the next higher 0 mod 1024 value. (Input/Ouput) * * 3. Tsdw is a returned SDW for the segment. It is up to the caller to place * this SDW in the descriptor segment. (Output) * * Last Modified (date and reason): * * 01/27/76, S. Webber (Initial coding) * 05/17/76, N. Morris for 28-5 compatibility * 11/08/80, W. Olin Sibert, to zero storage before returning August 1981 C. Hornig for new pc_abs. * 04/04/81, W. Olin Sibert, to use sdw_util * September 1983, Keith Loepere, for paged wired segment. */ dcl Segp pointer parameter; dcl Size fixed bin (18) parameter; dcl Memory_address fixed bin (26) parameter; dcl Tsdw fixed bin (71) parameter; dcl cl fixed bin (9); dcl code fixed bin (35); dcl ptp ptr; dcl astep ptr; dcl segno fixed bin (18); dcl save_sdw fixed bin (71); /* For keeping the SDW until we're done clearing the seg */ dcl memory_address fixed bin (26); dcl page_no fixed bin; dcl size fixed bin (18); dcl size_mod_1024 fixed bin (18, -10); dcl 1 sdwi aligned like sdw_info automatic; dcl dseg$ (0:1023) fixed bin (71) external static; dcl int_unpaged_page_tables$ external static; dcl slt$ fixed bin external static; dcl unpaged_page_tables$ external static; dcl absadr entry (ptr, fixed bin (35)) returns (fixed bin (26)); dcl make_sdw$unthreaded entry (fixed bin (18), fixed bin (71), ptr, ptr); dcl ptw_util_$make_core entry (ptr, fixed bin (26)); dcl pc_abs$wire_abs_contig entry (ptr, fixed bin (9), fixed bin (9), fixed bin (35)); dcl privileged_mode_ut$swap_sdw entry (ptr, ptr); dcl sdw_util_$construct entry (pointer, pointer); dcl sdw_util_$set_access entry (pointer, bit (4) unaligned); dcl syserr entry options (variable); dcl syserr$error_code entry options (variable); dcl (addr, addrel, baseno, bin, bit, divide, mod, null, string) builtin; segno = bin (baseno (Segp), 18); sltp = addr (slt$); sltep = addr (slt.seg (segno)); size_mod_1024 = fixed (Size + 1023, 18, -10); size = size_mod_1024; /* variables have different precisions */ slte_uns.bit_count = size * 36; cl = divide (size_mod_1024, 1024, 18, 0); slte_uns.cur_length = cl; if slt.free_core_start = 0 then do; /* must call pc_contig */ call make_sdw$unthreaded (segno, Tsdw, astep, ptp); call pc_abs$wire_abs_contig (astep, 0, cl, code); if code ^= 0 then no_room: do; namep = addrel (slt.name_seg_ptr, slte.names_ptr); call syserr$error_code (CRASH, code, "get_main: Insufficient storage available for ^a", segnam.names (1).name); end; call privileged_mode_ut$swap_sdw (Segp, addr (Tsdw)); return; /* All done for the after-init_sst case */ end; /* Check for no more room */ if slt.free_core_size < size then do; code = 0; go to no_room; end; if slte.paged then memory_address = slt.free_core_start + slt.free_core_size - size; else do; memory_address = slt.free_core_start; slt.free_core_start = slt.free_core_start + size; end; slt.free_core_size = slt.free_core_size - size; generate: if slte.paged then upt_ptr = addr (int_unpaged_page_tables$); /* seg will get real page table when make_segs_paged is run */ else upt_ptr = addr (unpaged_page_tables$); /* Now fill in SDW */ unspec (sdwi) = ""b; /* Prepare to call sdw_util to build the SDW */ string (sdwi.access) = "1010"b; /* Start out with RW access for clearing */ sdwi.size = size; /* Segment is unpaged by default */ sdwi.flags.paged = "1"b; upt_entry_ptr = ptr (upt_ptr, upt.current_length); upt.current_length = upt.current_length + 2 + round (cl, -1); if upt.current_length > upt.max_length then do; namep = addrel (slt.name_seg_ptr, slte.names_ptr); call syserr (CRASH, "get_main: not enough room to allocate unpaged page table for ^a.", segnam.names (1).name); end; upt_entry.size = cl; upt_entry.segno = segno; do page_no = 1 to cl; call ptw_util_$make_core (addr (upt_entry.ptws (page_no)), memory_address); memory_address = memory_address + 1024; end; sdwi.address = absadr (addr (upt_entry.ptws), (0)); call sdw_util_$construct (addr (Tsdw), addr (sdwi)); /* Make an SDW */ save_sdw = dseg$ (segno); /* Save the current SDW for this segment */ call privileged_mode_ut$swap_sdw (Segp, addr (Tsdw)); /* and prepare to zero the segment */ /* Even though memory is supposed to be clear, some of the "allocate-free" tricks used for firmware may leave gruft around. */ begin; declare segment_overlay (size) bit (36) aligned based (Segp); segment_overlay = ""b; end; call sdw_util_$set_access (addr (Tsdw), slte.access); /* Set the real access */ call privileged_mode_ut$swap_sdw (Segp, addr (save_sdw)); /* and replace it with what was there before */ return; /* Our caller will actually swap in the new SDW */ /* when it is needed; some callers require both for a while */ %page; given_address: entry (Segp, Memory_address, Size, Tsdw); /* Construct a memory segment as above, but use callers memory address. */ segno = bin (baseno (Segp), 18); sltp = addr (slt$); sltep = addr (slt.seg (segno)); size_mod_1024 = fixed (Size + 1023, 18, -10); size = size_mod_1024; /* variables have different precisions */ slte_uns.bit_count = size * 36; cl = divide (size_mod_1024, 1024, 18, 0); slte_uns.cur_length = cl; memory_address = Memory_address; go to generate; /* format: off */ %page; %include slt; %page; %include slte; %page; %include sdw_info; %page; %include syserr_constants; %page; %include unpaged_page_tables; /* BEGIN MESSAGE DOCUMENTATION Message: get_main: insufficient storage available for NAME S: $crash T: $init M: Insufficient wired memory was available to create the segment NAME during initialization. The system tape may be bad, or the configuration may be too small, or the system parameters specified in the configuration deck may be incorrect or inconsistent with the amount of main storage available. A: $recover Check the configuration and the CONFIG deck. $boot_tape Message: get_main: not enough room to allocate unpaged page table for NAME. S: $crash T: $init M: Either the segment unpaged_page_tables or int_unpaged_page_tables was not big enough so as to have the page table for segment NAME allocated within it. The system tape may be bad, or changes made to the mst require bigger unpaged page tables. A: $recover Try another tape. If bigger unpaged page tables are in order, a change must be made to bootload_equs.incl.alm and collection 0 recompiled. $boot_tape END MESSAGE DOCUMENTATION */ end get_main;  init_scu.pl1 11/11/89 1133.2rew 11/11/89 0825.5 89721 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style1 */ init_scu: proc (P_tag, P_errtag, P_code); /* * INIT_SCU - Initialize a System Controller. * * History: * Modified 4/84, Keith Loepere for collection_1_phase. * Modified '82 for early initialization operation * Modified 01/09/81, W. Olin Sibert, for scs$scas_page_table. * Modified 12/01/79, Mike Grady, to improve mem config size checks. * Modified 07/14/79, Mike Grady, to improve config checks. * Modified sometime, BSG, for 8 cpu port expander. * Coded 03/01/76, Noel I. Morris */ /****^ HISTORY COMMENTS: 1) change(88-07-27,Farley), approve(88-10-05,MCR7968), audit(88-10-10,Beattie), install(88-10-14,MR12.2-1166): Added code to check for memory address overlap conditions. This adds a call to pmut$check_for_mem_overlap and a new error code, rcerr_addscu_memoverlap. END HISTORY COMMENTS */ dcl P_tag fixed bin (3) parameter; /* system controller tag */ dcl P_errtag fixed bin (3) parameter; /* CPU or mask in error */ dcl P_code fixed bin (35) parameter; /* error code */ dcl code fixed bin (35); /* error code */ dcl tag fixed bin (3); /* tag of SCU we are working on */ dcl ptp pointer; /* Pointer to current SCAS PTW */ dcl i fixed bin (3); /* iteration index */ dcl j fixed bin (3); /* iteration index */ dcl x fixed bin (5); /* SCAS index */ dcl low_base fixed bin; /* for overlap check */ dcl high_base fixed bin; /* for overlap check */ dcl mem_size fixed bin; /* real mem size */ dcl found bit (1) aligned; /* used to check mask assignments */ dcl unfound_mask (4) bit (1) unal; /* used to check mask assignments also */ dcl cdp ptr; dcl pdp ptr; dcl 1 cdata based (cdp) like scs$controller_data aligned; /* single element of controller data */ dcl 1 pdata based (pdp) like scs$processor_data aligned; /* single element of processor data */ dcl privileged_mode_ut$check_for_mem_overlap entry (fixed bin, fixed bin, fixed bin (35)); dcl scr_util$read_cfg entry (fixed bin (3)); dcl scr_util$set_mask entry (fixed bin (3), fixed bin (3), fixed bin (71)); dcl syserr entry options (variable); dcl tag_letter (0:7) char (1) aligned static init ("A", "B", "C", "D", "E", "F", "G", "H"); /* for message */ dcl (addr, bit, divide, index, string) builtin; tag = P_tag; /* Copy parameter */ cdp = addr (scs$controller_data (tag)); /* Get pointer to data for this controller. */ call set_scas_ptw ((tag), (cdata.base)); /* Set scas entry for this controller. */ /* Read CFG data from the controller and fill in data pertaining to the configuration of store units connected to the controller. */ call scr_util$read_cfg (tag); /* Now, do RSCR CFG from controller. */ mem_size = cdata.lower_store_size + cdata.upper_store_size; if cdata.size < mem_size then /* Processor and controller sizes disagree. */ call init_error (rcerr_addscu_size, 0); if scs$controller_config_size (tag) > mem_size then call init_error (rcerr_addscu_bigconfig, 0); if ^cdata.program then /* Must be in programmable mode. */ call init_error (rcerr_addscu_manual, 0); if (cdata.type < "0010"b) & (string (scs$expanded_ports) ^= ""b) then call init_error (rcerr_addscu_oldexpand, 0); /* Can't have expanders on old SCU's */ /* Set up any additional SCAS PTWs */ if (cdata.store_b_is_lower & cdata.store_a_online) | (^cdata.store_b_is_lower & cdata.store_b_online) then call set_scas_ptw (tag + 8, cdata.base + cdata.lower_store_size); if (cdata.store_b_is_lower & cdata.store_b1_online) | (^cdata.store_b_is_lower & cdata.store_a1_online) then call set_scas_ptw (tag + 16, cdata.base + divide (cdata.lower_store_size, 2, 17, 0)); if (cdata.store_b_is_lower & cdata.store_a1_online) | (^cdata.store_b_is_lower & cdata.store_b1_online) then call set_scas_ptw (tag + 24, cdata.base + cdata.lower_store_size + divide (cdata.lower_store_size, 2, 17, 0)); /**** Check for possible memory address overlap, which can occur when stores A & A1 (and/or B & B1) should be enabled, but only A (and/or B) is actually enabled. */ /** first check for overlap in lower store */ if (cdata.store_b_is_lower & cdata.store_b_online & ^cdata.store_b1_online) | (^cdata.store_b_is_lower & cdata.store_a_online & ^cdata.store_a1_online) then do; low_base = cdata.base; high_base = cdata.base + divide (cdata.lower_store_size, 2, 17, 0); call privileged_mode_ut$check_for_mem_overlap (low_base, high_base, code); if code ^= 0 then call init_error (rcerr_addscu_memoverlap, 0); end; /** now check for overlap in lower store */ if (cdata.lower_store_size = cdata.upper_store_size) then if (cdata.store_b_is_lower & cdata.store_b_online & cdata.store_a_online & ^cdata.store_a1_online) | (^cdata.store_b_is_lower & cdata.store_a_online & cdata.store_b_online & ^cdata.store_b1_online) then do; low_base = cdata.base + cdata.lower_store_size; high_base = cdata.base + cdata.lower_store_size + divide (cdata.lower_store_size, 2, 17, 0); call privileged_mode_ut$check_for_mem_overlap (low_base, high_base, code); if code ^= 0 then call init_error (rcerr_addscu_memoverlap, 0); end; /* Make sure that each assigned controller mask is assigned to a processor, and that at most one controller mask is assigned to each processor. */ string (unfound_mask) = "1111"b; /* Mark all masks as not yet found. */ do i = 0 to 7; /* Look at all CPU's. */ pdp = addr (scs$processor_data (i)); /* Get pointer to data for this CPU. */ if ^(pdata.offline | pdata.online) then /* Is CPU in the configuration ? */ goto NEXT_CPU_LOOP; found = "0"b; /* Have not yet found mask for this processor. */ do j = 1 to 4; /* Look at all mask assignments. */ if cdata.eima_data (j).mask_assigned then do; if pdata.controller_port = cdata.eima_data (j).mask_assignment then do; if ^found then do; /* Make sure neither mask nor port duplicates */ unfound_mask (j) = "0"b; /* Found a mask for this CPU. */ found = "1"b; call scr_util$set_mask (tag, (pdata.controller_port), 0); end; else call init_error (rcerr_addscu_dup_mask, i); /* Found more than one mask. */ end; /* Two masks are assigned to one port. */ end; /* Of case for assigned mask */ else unfound_mask (j) = "0"b; /* No assignment for this mask. */ end; /* Of loop through possible masks */ if (cdata.type < "0010"b) & ^found then /* If not 4MW SCU ... */ call init_error (rcerr_addscu_no_mask, i); /* Every processor must have an assigned mask. */ NEXT_CPU_LOOP: end; /* Of loop through processors */ if string (unfound_mask) ^= ""b then /* If some mask not accounted for ... */ call init_error (rcerr_addscu_bad_mask, (index (string (unfound_mask), "1"b) - 1)); /* Mask not assigned to a processor port. */ if ^(sys_info$collection_1_phase = EARLY_INITIALIZATION | sys_info$collection_1_phase > SERVICE_INITIALIZATION) then if scs$controller_config_size (tag) < mem_size then call syserr (0, "init_scu: Warning - Not all of MEM ^a will be used.", tag_letter (tag)); P_code = 0; /* Indicate success */ P_errtag = 0; ERROR_RETURN: return; /* End of code for init_scu */ final_scu: entry (P_tag); tag = P_tag; /* Copy parameter */ do x = tag by 8 while (x < 32); /* Fault out all entries in SCAS for this controller. */ call reset_scas_ptw (x); end; return; /* End of code for init_scu$final_scu */ init_error: proc (return_code, error_tag); dcl return_code fixed bin parameter; dcl error_tag fixed bin (3) parameter; call final_scu (tag); /* Finish this SCU */ P_code = return_code; /* and return error parameters */ P_errtag = error_tag; goto ERROR_RETURN; end init_error; set_scas_ptw: proc (scasx, base); /* procedure to set PTW in scas. */ dcl scasx fixed bin (5) parameter; /* index into the scas */ dcl base fixed bin (14) parameter; /* absolute address (in 1024 word blocks) for PTW */ ptp = addr (scs$scas_page_table (scasx)); /* Find our PTW */ ptp -> l68_ptw.add = bit (base); /* Insert base address in PTW. */ ptp -> l68_ptw.phu = "1"b; /* Turn on used bit in PTW. */ ptp -> l68_ptw.valid = "1"b; /* Turn off directed fault in PTW. */ return; end set_scas_ptw; reset_scas_ptw: proc (scasx); /* proc to reset PTW in scas. */ dcl scasx fixed bin (5) parameter; /* index into the scas */ ptp = addr (scs$scas_page_table (scasx)); /* Find our PTW */ ptp -> l68_ptw.valid = "0"b; /* Turn on directed fault in PTW. */ return; end reset_scas_ptw; %page; %include collection_1_phases; %page; %include scs; %page; %include "ptw.l68"; %page; %include rcerr; /* BEGIN MESSAGE DOCUMENTATION Message: init_scu: Warning - Not all of MEM Y will be used. S: $info T: $init M: The actual amount of memory present in MEM Y does not agree with the config deck. Only as much as the configuration deck specifies will be used. A: If this is an unintentional error, correct the configuration deck before the next bootload. END MESSAGE DOCUMENTATION */ end init_scu;  initializer.pl1 11/11/89 1133.2r w 11/11/89 0825.5 15273 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ initializer: proc (); /* * INITIALIZER * * This program is the driving procedure of Multics Initialization. * It receives control from bootstrap2, and never returns. It must * be separate from bootstrap2, and, in fact, be part of the permanent * supervisor, because it makes the call to delete all the initialization * segments. However, it does little else, and just calls real_initializer * (which is an init-seg, and therefore gets deleted) to do the * real work of initialization. * * Remodeled, 12/21/80 by W. Olin Sibert * Changed 10/27/84 by Allen Ball to set slt.(first last)_init_seg = 32768 after deleting them. */ dcl addr builtin; dcl delete_segs$delete_segs_init entry (); dcl init_proc entry (); dcl real_initializer entry (); dcl slt$ external; sltp = addr (slt$); call real_initializer; /* Call the real thing */ call delete_segs$delete_segs_init; /* Clean up after the previous call */ slt.first_init_seg = 32768; /* These segs are no more. */ slt.last_init_seg = 32768; /* 32768 is > possible valid segno */ call init_proc; /* And call out to ring 1, never to return */ %include slt; end initializer;  mask_instruction.alm 11/11/89 1133.2rew 11/11/89 0825.5 10341 " *********************************************************** " * * " * 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. * " * * " *********************************************************** name mask_instruction entry smcm entry rmcm entry staq entry ldaq " smcm: lda smcm_instruction sta ap|2,* short_return rmcm: lda rmcm_instruction sta ap|2,* short_return staq: lda staq_instruction sta ap|2,* short_return ldaq: lda ldaq_instruction sta ap|2,* short_return inhibit on <+><+><+><+><+><+><+><+><+><+><+><+> smcm_instruction: smcm ab|0,* rmcm_instruction: rmcm ab|0,* staq_instruction: staq ab|0 ldaq_instruction: ldaq ab|0 inhibit off <-><-><-><-><-><-><-><-><-><-><-><-> end  prds_init.pl1 11/11/89 1133.2r w 11/11/89 0825.5 24507 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ /* PRDS_INIT - Copy Template Info into new PRDS. Modified 2/11/76 by Noel I. Morris Modified 2/22/81 by J. Bongiovanni for fast connect code initialization and to move some initializations from prds.cds */ prds_init: proc (pp, tag, idle_ptr); dcl pp ptr, idle_ptr ptr, tag fixed bin (3); dcl p1 ptr, code fixed bin (35), basedptr ptr based (pp), basedbit36 bit (36) aligned based (pp), basedfixed fixed bin(17) based (pp) ; dcl fast_connect_init entry (ptr, fixed bin (3), fixed bin (35)); dcl syserr entry options (variable); dcl prds$ fixed bin ext, prds$cache_luf_reg bit (36) aligned ext, prds$processor_tag ext bit (36) aligned, prds$idle_ptr ptr ext; dcl (addr, null, ptr, rel, size) builtin; % include stack_header; /* Copy the stack header from the top of the prds. Then set up the stack pointer. */ sb = addr (prds$); pp -> stack_header_overlay = sb -> stack_header_overlay; pp -> stack_header.signal_ptr = null (); pp -> stack_header.sct_ptr = null (); p1 = ptr (pp, rel (addr (prds$cache_luf_reg))); p1 -> basedbit36 = "000000000003"b3; p1 = ptr (pp, rel (addr (prds$processor_tag))); p1 -> basedfixed = tag; p1 = ptr (pp, rel (addr (prds$idle_ptr))); p1 -> basedptr = idle_ptr; call fast_connect_init (pp, tag, code); if code^=0 then call syserr (1, "prds_init: Invalid size for prds$fast_connect_code"); return; /* BEGIN MESSAGE DOCUMENTATION Message: prds_init: Invalid size for prds$fast_connect_code S: $crash T: $init M: There is an inconsistency between modules prds and fast_connect_init on the boot tape. Specifically, the amount of space allocated for fast connect code in the prds does not agree with the size of the code in fast_connect_init. The most likely cause is that one of these modules is not up to date. A: $contact_sa A new boot tape must be generated with the proper versions of modules prds and fast_connect_init. END MESSAGE DOCUMENTATION */ end prds_init;  ptw_util_.pl1 11/11/89 1133.2r w 11/11/89 0825.5 88227 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ ptw_util_: proc (); /* * PTW_UTIL_ * * A utility for manipulating PTWs in a format appropriate to the * running system. It is for data manipulation only; if used to * modify live PTWs, the appropriate cam/cache functions must * be performed by the caller. * * April, 1981, W. Olin Sibert * October 1983, Keith Loepere for $dissect and $set_phm */ return; /* Not an entrypoint */ dcl P_ptw_ptr pointer parameter; dcl P_ptw_info_ptr pointer parameter; dcl P_coreadd fixed bin (26) parameter; dcl P_add_type bit (4) unaligned parameter; dcl P_diskadd fixed bin (20) parameter; dcl P_nulladd bit (22) aligned parameter; dcl P_pdadd fixed bin (16) parameter; dcl P_modified_bit bit (1) aligned; dcl ptp pointer; /* Can't be declared in the include file */ dcl null_flag bit (1) aligned; dcl 1 null_ptw aligned based (ptp), 2 devadd bit (22) unaligned, 2 pad bit (14) unaligned; dcl sst$cmp pointer external static; dcl sst$cmesize fixed bin external static; dcl sys_info$system_type fixed bin external static; dcl (addr, divide, unspec) builtin; /* */ ptw_util_$make_core: entry (P_ptw_ptr, P_coreadd); /* This entry fabricates a PTW which describes the specified core frame */ ptp = P_ptw_ptr; if sys_info$system_type = ADP_SYSTEM then do; unspec (adp_ptw) = ""b; adp_core_ptw.frame = divide (P_coreadd, 1024, 16, 0); adp_ptw.add_type = add_type.core; adp_ptw.write = "1"b; /* Always supposed to be writable */ adp_ptw.valid = "1"b; /* And make it valid, too */ end; else do; /* Ordinary Level 68 */ unspec (l68_ptw) = ""b; l68_core_ptw.frame = divide (P_coreadd, 1024, 16, 0); l68_ptw.add_type = add_type.core; l68_ptw.df_no = "01"b; /* Set the DF number correctly for initialization */ l68_ptw.valid = "1"b; /* And make it valid, too */ end; return; /* End of ptw_util_$make_core */ /* */ ptw_util_$get_coreadd: entry (P_ptw_ptr, P_coreadd); /* This entry returns the core address described by the PTW, if it is valid, or returns -1 */ ptp = P_ptw_ptr; if sys_info$system_type = ADP_SYSTEM then if ^adp_ptw.valid then P_coreadd = -1; else P_coreadd = 1024 * adp_core_ptw.frame; else if ^l68_ptw.valid then /* Ordinary Level 68 */ P_coreadd = -1; else P_coreadd = 1024 * l68_core_ptw.frame; return; /* End of ptw_util_$get_coreadd */ ptw_util_$get_add_type: entry (P_ptw_ptr, P_add_type); /* This entry returns the add_type from the PTW */ ptp = P_ptw_ptr; if sys_info$system_type = ADP_SYSTEM then P_add_type = adp_ptw.add_type; else P_add_type = l68_ptw.add_type; return; /* End of ptw_util_$get_add_type */ /* */ ptw_util_$make_disk: entry (P_ptw_ptr, P_diskadd); /* This entry fabricates a PTW which describes a specified disk record */ null_flag = "0"b; goto MAKE_DISK_COMMON; ptw_util_$make_null_disk: entry (P_ptw_ptr, P_diskadd); /* This entry fabricates a PTW which describes a specified, not yet written, disk record */ null_flag = "1"b; goto MAKE_DISK_COMMON; MAKE_DISK_COMMON: ptp = P_ptw_ptr; if sys_info$system_type = ADP_SYSTEM then do; unspec (adp_ptw) = ""b; adp_ptw.add = substr (bit (binary (P_diskadd, 20), 20), 3, 18); /* Only 18 bits for now */ adp_ptw.add_type = add_type.disk; substr (adp_ptw.add, 1, 1) = null_flag; /* First bit in disk address */ adp_ptw.write = "1"b; /* Always supposed to be writable */ end; else do; /* Ordinary Level 68 */ unspec (l68_ptw) = ""b; adp_ptw.add = substr (bit (binary (P_diskadd, 20), 20), 3, 18); /* Only 18 bits for now */ l68_ptw.add_type = add_type.disk; substr (l68_ptw.add, 1, 1) = null_flag; /* First bit in disk address */ l68_ptw.df_no = "01"b; /* Set the DF number correctly for initialization */ end; return; /* End of ptw_util_$make_disk */ /* */ ptw_util_$make_null: entry (P_ptw_ptr, P_nulladd); /* This entry fabricates a PTW containing a standard form 22 bit null address */ ptp = P_ptw_ptr; if sys_info$system_type = ADP_SYSTEM then do; unspec (adp_ptw) = ""b; null_ptw.devadd = P_nulladd; adp_ptw.write = "1"b; /* Always supposed to be writable */ end; else do; /* Ordinary Level 68 */ unspec (l68_ptw) = ""b; null_ptw.devadd = P_nulladd; l68_ptw.df_no = "01"b; /* Set the DF number correctly for initialization */ end; return; /* End of ptw_util_$make_null */ /* */ ptw_util_$make_pd: entry (P_ptw_ptr, P_pdadd); /* This entry fabricates a PTW which describes a specified disk record */ ptp = P_ptw_ptr; if sys_info$system_type = ADP_SYSTEM then do; unspec (adp_ptw) = ""b; adp_ptw.add = bit (binary (P_pdadd, 18), 18); adp_ptw.add_type = add_type.pd; adp_ptw.write = "1"b; /* Always supposed to be writable */ end; else do; /* Ordinary Level 68 */ unspec (l68_ptw) = ""b; adp_ptw.add = bit (binary (P_pdadd, 18), 18); l68_ptw.add_type = add_type.pd; l68_ptw.df_no = "01"b; /* Set the DF number correctly for initialization */ end; return; /* End of ptw_util_$make_disk */ /* */ ptw_util_$set_valid: entry (P_ptw_ptr); /* This entry sets a PTW to be "valid"; that is, not faulted. No validation is performed. */ ptp = P_ptw_ptr; /* Make it addressable */ if sys_info$system_type = ADP_SYSTEM then do; adp_ptw.valid = "1"b; adp_ptw.unusable1 = ""b; /* Clear out hardware padding, just in case */ adp_ptw.unusable2 = ""b; end; else do; /* Set valid, and set DF1, too */ l68_ptw.valid = "1"b; l68_ptw.df_no = "01"b; end; return; /* End of ptw_util_$set_valid */ ptw_util_$set_faulted: entry (P_ptw_ptr); /* This entry sets a PTW to be "faulted"; that is, not valid. No validation is performed. */ ptp = P_ptw_ptr; /* Make it addressable */ if sys_info$system_type = ADP_SYSTEM then do; adp_ptw.valid = "0"b; adp_ptw.unusable1 = ""b; /* Clear out hardware padding, just in case */ adp_ptw.unusable2 = ""b; end; else do; l68_ptw.valid = "0"b; l68_ptw.df_no = "01"b; /* Refresh these bits, just in case */ end; return; /* End of ptw_util_$set_faulted */ /* */ ptw_util_$set_wired: entry (P_ptw_ptr); /* This entry makes a PTW be "wired" */ ptp = P_ptw_ptr; /* Make it addressable */ if sys_info$system_type = ADP_SYSTEM then adp_ptw.wired = "1"b; else l68_ptw.wired = "1"b; return; /* End of ptw_util_$set_wired */ ptw_util_$set_unwired: entry (P_ptw_ptr); /* This entry makes a PTW be "unwired" */ ptp = P_ptw_ptr; /* Make it addressable */ if sys_info$system_type = ADP_SYSTEM then adp_ptw.wired = "0"b; else l68_ptw.wired = "0"b; return; /* End of ptw_util_$set_wired */ ptw_util_$set_phm: entry (P_ptw_ptr); /* This entry marks a PTW as modified. */ ptp = P_ptw_ptr; /* Make it addressable */ if sys_info$system_type = ADP_SYSTEM then adp_ptw.phm = "1"b; else l68_ptw.phm = "1"b; return; /* End of ptw_util_$set_phm */ ptw_util_$reset_phm: entry (P_ptw_ptr); /* This entry marks a PTW as unmodified. */ ptp = P_ptw_ptr; /* Make it addressable */ if sys_info$system_type = ADP_SYSTEM then adp_ptw.phm, adp_ptw.phm1 = "0"b; else l68_ptw.phm, l68_ptw.phm1 = "0"b; return; /* End of ptw_util_$reset_phm */ ptw_util_$get_phm: entry (P_ptw_ptr, P_modified_bit); /* This entry returns the state (phm | phm1) of the cumulative phm bit */ ptp = P_ptw_ptr; if sys_info$system_type = ADP_SYSTEM then P_modified_bit = adp_ptw.phm | adp_ptw.phm1; else P_modified_bit = l68_ptw.phm | l68_ptw.phm1; return; /* End of ptw_util_$get_phm */ dissect: entry (P_ptw_ptr, P_ptw_info_ptr); ptp = P_ptw_ptr; ptw_info_ptr = P_ptw_info_ptr; if sys_info$system_type = ADP_SYSTEM then do; if adp_ptw.add_type = add_type.core then do; ptw_info.address = adp_core_ptw.frame * 1024; ptw_info.null_disk = "0"b; end; else if adp_ptw.add_type = add_type.disk then do; ptw_info.address = bin (substr (adp_ptw.add, 2, 17), 17); ptw_info.null_disk = substr (adp_ptw.add, 1, 1); end; else do; ptw_info.address = bin (adp_ptw.add, 18); ptw_info.null_disk = "0"b; end; ptw_info = adp_ptw.flags, by name; end; else do; if l68_ptw.add_type = add_type.core then do; ptw_info.address = l68_core_ptw.frame * 1024; ptw_info.null_disk = "0"b; end; else if l68_ptw.add_type = add_type.disk then do; ptw_info.address = bin (substr (l68_ptw.add, 2, 17), 17); ptw_info.null_disk = substr (l68_ptw.add, 1, 1); end; else do; ptw_info.address = bin (l68_ptw.add, 18); ptw_info.null_disk = "0"b; end; ptw_info = l68_ptw.flags, by name; end; return; /* end of ptw_util_$dissect */ %page; %include "ptw.adp"; %page; %include "ptw.l68"; %page; %include add_type; %page; %include ptw_info; %page; %include system_types; end ptw_util_;  rsw_util.pl1 11/11/89 1133.2rew 11/11/89 0825.5 51246 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* RSW_UTIL - Procedures to Read and Interpret the Processor Switches. coded 4/12/76 by Noel I. Morris Modfified 9/04/80 by J. A. Bush for the DPS8/70M CPU */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ rsw_util: proc; dcl tag fixed bin (3), /* system controller tag */ enabled bit (1) aligned, /* "1"b if processor port enabled */ base fixed bin (17), /* base address of memory in controller */ size fixed bin (17), /* size of memory in controller */ interlace fixed bin (3); /* memory interlace type */ dcl rsw_1_3_data bit (36) aligned, rsw_2_data bit (36) aligned, rsw_4_data bit (36) aligned, (rsw2p, rsw4p) ptr, rsw fixed bin (3); dcl privileged_mode_ut$rsw entry (fixed bin (3), bit (36) aligned); dcl (addr, bin, divide) builtin; dcl pip ptr; /* pointer to port info */ dcl 1 pi like rsw_1_3.port_info based (pip) unal; /* port info */ % include rsw; % include scs; port_info: entry (tag, enabled, base, size, interlace); /* entry to return info about a port */ rsw2p = addr (rsw_2_data); /* Set pointer. */ rswp = addr (rsw_1_3_data); /* Set pointer. */ call privileged_mode_ut$rsw (2, rsw_2_data); /* get the cpu type. */ if rsw2p -> dps8_rsw_2.cpu_type = 1 then do; /* if DPS8 cpu... */ if tag > 3 then do; /* can't have for than 4 scus on dps8 so... */ enabled = "0"b; /* tell caller this port disabled */ return; end; pip = addr (rsw_1_3.port_info (tag)); /* there can only be 4 SCUs... */ call privileged_mode_ut$rsw (1, rsw_1_3_data); /* Read port info. */ size = divide (dps8_mem_size_table (pi.mem_size), 1024, 17, 0); base = bin (pi.port_assignment, 3) * size; /* Compute base address of memory. */ if pi.interlace_enable then /* If interlace is enabled ... */ if rsw2p -> dps8_rsw_2.interlace_info (tag) then /* If two-word interlace... */ interlace = 2; else interlace = 4; /* If four-word interlace ... */ else interlace = 0; /* If no interlace ... */ end; else do; /* must be a DPS or L68 cpu */ rsw4p = addr (rsw_4_data); /* Set pointer to data. */ if tag < 4 then do; /* Decide on RSW 1 or RSW 3 data. */ rsw = 1; pip = addr (rsw_1_3.port_info (tag)); end; else do; rsw = 3; pip = addr (rsw_1_3.port_info (tag - 4)); end; call privileged_mode_ut$rsw (rsw, rsw_1_3_data); /* Read port info. */ call privileged_mode_ut$rsw (4, rsw_4_data); /* Read half/full and interlace type data. */ size = divide (dps_mem_size_table (pi.mem_size), 1024, 17, 0); base = bin (pi.port_assignment, 3) * size; /* Compute base address of memory. */ if rsw4p -> rsw_4.half (tag) then size = divide (size, 2, 17, 0); /* Halve the size if so indicated. */ if pi.interlace_enable then /* If interlace is enabled ... */ if rsw4p -> rsw_4.four (tag) then /* If two-word interlace ... */ interlace = 2; else interlace = 4; /* If four-word interlace ... */ else interlace = 0; /* If no interlace ... */ end; enabled = pi.port_enable; /* Return port enabled bit. */ return; set_rsw_mask: entry (tag, enabled); /* entry to set mask for checking CPU switches */ if tag < 4 then do; /* Set appropriate RSW data. */ rswp = addr (scs$processor_switch_mask (1)); pip = addr (rsw_1_3.port_info (tag)); end; else do; rswp = addr (scs$processor_switch_mask (3)); pip = addr (rsw_1_3.port_info (tag - 4)); end; pi.port_enable = enabled; /* Set or clear enabled bit. */ return; init_rsw_mask: entry (tag, enabled); /* entry to set initial mask for switch checking */ if tag < 4 then do; /* Set appropriate RSW data. */ rswp = addr (scs$processor_switch_mask (1)); pip = addr (rsw_1_3.port_info (tag)); end; else do; rswp = addr (scs$processor_switch_mask (3)); pip = addr (rsw_1_3.port_info (tag - 4)); end; pi.port_assignment = "111"b; /* Compare port assignment switches. */ pi.interlace_enable = "1"b; /* Compare interlace enable switches. */ pi.mem_size = 7; /* Compare mem size switches. */ pi.port_enable = enabled; /* Compare enable switch only if enabled. */ rswp = addr (scs$processor_switch_mask (4)); rsw_4.four (tag) = "1"b; /* Compare four-word interlace switches. */ rsw_4.half (tag) = "1"b; /* Compare half/full switches. */ if tag < 4 then do; /* Set appropriate RSW data. */ rswp = addr (scs$processor_switch_template (1)); pip = addr (rsw_1_3.port_info (tag)); end; else do; rswp = addr (scs$processor_switch_template (3)); pip = addr (rsw_1_3.port_info (tag - 4)); end; pi.port_enable = "1"b; /* If compared, this bit must be ON. */ return; end rsw_util;  sdw_util_.pl1 11/11/89 1133.2rew 11/11/89 0825.5 120672 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ sdw_util_: proc (); return; /* Not an entrypoint */ /* * SDW_UTIL_ * * This procedure is used to construct and modify SDWs. It uses the structure * appropriate for the running system, or whichever one was requested, so that * its callers need not be aware of multiple formats for SDWs. This procedure * manipulates data only. Its caller is responsible for doing any cam/cache clearing * which may be required for the modification to take effect. * * The sdw_info structure is used to describe SDWs in a system independent fashion. * * Every entrypoint comes in three varieties: XXX, XXX_l68, and XXX_adp. The * unsuffixed entrypoints treat SDWs as appropriate for the running system. * This is the only form which should be used in the hardcore. The XXX_l68 * and XXX_adp entrypoints manipulate Level 68 and ADP SDWs, respectively. * * Entrypoints: * * construct, construct_adp, construct_l68: * construct an SDW from the information in an sdw_info. * * dissect, dissect_l68, dissect_adp * construct an sdw_info from a supplied SDW. * * set_address, get_address, set_address_l68, get_address_l68, set_address_adp, get_address_adp * set/return the main memory address from the SDW. * * set_access, get_access, set_access_l68, get_access_l68, set_access_adp, get_access_adp * set/return the access information in the SDW. * * set_size, get_size, set_size_l68, get_size_l68, set_size_adp, get_size_adp * set/return the access information in the SDW. * * set_faulted, set_valid, set_faulted_l68, set_valid_l68, set_faulted_adp, set_valid_adp * set the SDW either valid or faulted. * * get_valid, get_valid_l68, get_valid_adp * return the state of the valid bit * * 03/10/81, W. Olin Sibert */ /* */ dcl P_sdw_ptr pointer parameter; dcl P_sdw_info_ptr pointer parameter; dcl P_address fixed bin (26) parameter; dcl P_size fixed bin (19) parameter; dcl P_access bit (4) unaligned parameter; dcl P_valid_bit bit (1) aligned parameter; dcl sdwp pointer; /* Can't be declared in include file */ dcl seg_size fixed bin (14); dcl system_type fixed bin; dcl sys_info$system_type fixed bin external static; dcl (binary, bit, divide, max, string, substr, unspec) builtin; /* */ sdw_util_$construct: entry (P_sdw_ptr, P_sdw_info_ptr); system_type = sys_info$system_type; goto CONSTRUCT_COMMON; sdw_util_$construct_l68: entry (P_sdw_ptr, P_sdw_info_ptr); system_type = L68_SYSTEM; goto CONSTRUCT_COMMON; sdw_util_$construct_adp: entry (P_sdw_ptr, P_sdw_info_ptr); system_type = ADP_SYSTEM; goto CONSTRUCT_COMMON; CONSTRUCT_COMMON: sdw_info_ptr = P_sdw_info_ptr; sdwp = P_sdw_ptr; /* Make the sdws addressable */ if system_type = ADP_SYSTEM then do; unspec (adp_sdw) = ""b; /* Start out empty, with all bits off */ string (adp_sdw.access) = string (sdw_info.access); string (adp_sdw.rings) = string (sdw_info.rings); adp_sdw.valid = ^sdw_info.faulted; /* Bits are different in state */ adp_sdw.unpaged = ^sdw_info.paged; if sdw_info.gate_entry_bound > 0 then /* not_a_gate is already zero */ adp_sdw.entry_bound = bit (binary (sdw_info.gate_entry_bound - 1, 14), 14); else adp_sdw.not_a_gate = "1"b; /* entry bound is already zero */ adp_sdw.add = bit (binary (sdw_info.address, 26, 26)); if adp_sdw.unpaged then substr (adp_sdw.add, 26 - 3, 4) = "0000"b; if ^adp_sdw.unpaged then /* Set the paged size */ seg_size = 64 * divide (sdw_info.size + 1023, 1024, 17, 0); else seg_size = divide (sdw_info.size + 15, 16, 17, 0); adp_sdw.bound = bit (binary (max (seg_size - 1, 0), 14), 14); end; else do; /* Ordinary Level 68 */ unspec (l68_sdw) = ""b; /* Start out empty, with all bits off */ string (l68_sdw.access) = string (sdw_info.access); string (l68_sdw.rings) = string (sdw_info.rings); l68_sdw.valid = ^sdw_info.faulted; /* Bits are different in state */ l68_sdw.unpaged = ^sdw_info.paged; l68_sdw.cache = sdw_info.cache; /* Only on the Level 68 */ if sdw_info.gate_entry_bound > 0 then /* not_a_gate is already zero */ l68_sdw.entry_bound = bit (binary (sdw_info.gate_entry_bound - 1, 14), 14); else l68_sdw.not_a_gate = "1"b; /* entry bound is already zero */ l68_sdw.add = bit (binary (sdw_info.address, 24), 24); seg_size = divide (sdw_info.size + 15, 16, 17, 0); l68_sdw.bound = bit (binary (max (0, seg_size - 1), 14), 14); end; return; /* End of sdw_util_$construct */ /* */ sdw_util_$dissect: entry (P_sdw_ptr, P_sdw_info_ptr); system_type = sys_info$system_type; goto DISSECT_COMMON; sdw_util_$dissect_l68: entry (P_sdw_ptr, P_sdw_info_ptr); system_type = L68_SYSTEM; goto DISSECT_COMMON; sdw_util_$dissect_adp: entry (P_sdw_ptr, P_sdw_info_ptr); system_type = ADP_SYSTEM; goto DISSECT_COMMON; DISSECT_COMMON: sdwp = P_sdw_ptr; /* Make it addressable */ sdw_info_ptr = P_sdw_info_ptr; unspec (sdw_info) = ""b; /* Clear it out, and fill it in */ if system_type = ADP_SYSTEM then do; string (sdw_info.access) = string (adp_sdw.access); string (sdw_info.rings) = string (adp_sdw.rings); sdw_info.faulted = ^adp_sdw.valid; /* Bits are different in state */ sdw_info.paged = ^adp_sdw.unpaged; if ^adp_sdw.not_a_gate then /* Copy the entry bound, if interesting */ sdw_info.gate_entry_bound = 1 + binary (adp_sdw.entry_bound, 14); sdw_info.size = 16 + 16 * binary (adp_sdw.bound, 14); sdw_info.address = binary (adp_sdw.add, 26); end; else do; /* Ordinary Level 68 */ string (sdw_info.access) = string (l68_sdw.access); string (sdw_info.rings) = string (l68_sdw.rings); sdw_info.faulted = ^l68_sdw.valid; /* Bits are different in state */ sdw_info.paged = ^l68_sdw.unpaged; sdw_info.cache = l68_sdw.cache; /* Only on the Level 68 */ if ^l68_sdw.not_a_gate then /* Copy the entry bound, if interesting */ sdw_info.gate_entry_bound = 1 + binary (l68_sdw.entry_bound, 14); sdw_info.size = 16 + 16 * binary (l68_sdw.bound, 14); sdw_info.address = binary (l68_sdw.add, 24); end; return; /* End of sdw_util_$dissect */ /* */ sdw_util_$set_access: entry (P_sdw_ptr, P_access); /* This sets the access in an SDW */ system_type = sys_info$system_type; goto SET_ACCESS_COMMON; sdw_util_$set_access_l68: entry (P_sdw_ptr, P_access); /* This sets the access in a Level 68 SDW */ system_type = L68_SYSTEM; goto SET_ACCESS_COMMON; sdw_util_$set_access_adp: entry (P_sdw_ptr, P_access); /* This sets the access in an ADP SDW */ system_type = ADP_SYSTEM; goto SET_ACCESS_COMMON; SET_ACCESS_COMMON: sdwp = P_sdw_ptr; if system_type = ADP_SYSTEM then string (adp_sdw.access) = P_access; else string (l68_sdw.access) = P_access; return; /* End of sdw_util_$set_access */ /* */ sdw_util_$set_address: entry (P_sdw_ptr, P_address); /* This sets the address in an SDW */ system_type = sys_info$system_type; goto SET_ADDRESS_COMMON; sdw_util_$set_address_l68: entry (P_sdw_ptr, P_address); /* This sets the address in a Level 68 SDW */ system_type = L68_SYSTEM; goto SET_ADDRESS_COMMON; sdw_util_$set_address_adp: entry (P_sdw_ptr, P_address); /* This sets the address in an ADP SDW */ system_type = ADP_SYSTEM; goto SET_ADDRESS_COMMON; SET_ADDRESS_COMMON: sdwp = P_sdw_ptr; if system_type = ADP_SYSTEM then do; adp_sdw.add = bit (binary (P_address, 26, 26)); if adp_sdw.unpaged then substr (adp_sdw.add, 26 - 3, 4) = "0000"b; end; else l68_sdw.add = bit (binary (P_address, 24), 24); return; /* End of sdw_util_$set_address */ /* */ sdw_util_$set_size: entry (P_sdw_ptr, P_size); /* This sets the size of an SDW */ system_type = sys_info$system_type; goto SET_BOUND_COMMON; sdw_util_$set_size_l68: entry (P_sdw_ptr, P_size); /* This sets the size of a Level 68 SDW */ system_type = L68_SYSTEM; goto SET_BOUND_COMMON; sdw_util_$set_size_adp: entry (P_sdw_ptr, P_size); /* This sets the size of an ADP SDW */ system_type = ADP_SYSTEM; goto SET_BOUND_COMMON; SET_BOUND_COMMON: sdwp = P_sdw_ptr; if system_type = ADP_SYSTEM then do; if ^adp_sdw.unpaged then /* Set the paged size */ seg_size = 64 * divide (P_size + 1023, 1024, 17, 0); else seg_size = divide (P_size + 15, 16, 17, 0); adp_sdw.bound = bit (binary (max (seg_size - 1, 0), 14), 14); if P_size = 0 then adp_sdw.valid = "0"b; /* Set the size, but fault the SDW if it's zero */ end; else do; /* Level 68 */ seg_size = divide (P_size + 15, 16, 17, 0); /* Bound has same resolution paged or unpaged */ l68_sdw.bound = bit (binary (max (seg_size - 1, 0), 14), 14); if P_size = 0 then l68_sdw.valid = "0"b; /* Set the size, but fault the SDW if it's zero */ end; return; /* End of sdw_util_$set_size */ /* */ sdw_util_$get_access: entry (P_sdw_ptr, P_access); system_type = sys_info$system_type; goto GET_ACCESS_COMMON; sdw_util_$get_access_l68: entry (P_sdw_ptr, P_access); system_type = L68_SYSTEM; goto GET_ACCESS_COMMON; sdw_util_$get_access_adp: entry (P_sdw_ptr, P_access); system_type = ADP_SYSTEM; goto GET_ACCESS_COMMON; GET_ACCESS_COMMON: sdwp = P_sdw_ptr; /* Make it addressable */ if system_type = ADP_SYSTEM then P_access = string (adp_sdw.access); else P_access = string (l68_sdw.access); return; /* End of sdw_util_$get_access */ /* */ sdw_util_$get_address: entry (P_sdw_ptr, P_address); system_type = sys_info$system_type; goto GET_ADDRESS_COMMON; sdw_util_$get_address_l68: entry (P_sdw_ptr, P_address); system_type = L68_SYSTEM; goto GET_ADDRESS_COMMON; sdw_util_$get_address_adp: entry (P_sdw_ptr, P_address); system_type = ADP_SYSTEM; goto GET_ADDRESS_COMMON; GET_ADDRESS_COMMON: sdwp = P_sdw_ptr; /* Make it addressable */ if system_type = ADP_SYSTEM then P_address = binary (adp_sdw.add, 26); else P_address = binary (l68_sdw.add, 24); return; /* End of sdw_util_$get_address */ /* */ sdw_util_$get_size: entry (P_sdw_ptr, P_size); system_type = sys_info$system_type; goto GET_BOUND_COMMON; sdw_util_$get_size_l68: entry (P_sdw_ptr, P_size); system_type = L68_SYSTEM; goto GET_BOUND_COMMON; sdw_util_$get_size_adp: entry (P_sdw_ptr, P_size); system_type = ADP_SYSTEM; goto GET_BOUND_COMMON; GET_BOUND_COMMON: sdwp = P_sdw_ptr; /* Make it addressable */ if system_type = ADP_SYSTEM then P_size = 16 + 16 * binary (adp_sdw.bound, 14); else P_size = 16 + 16 * binary (l68_sdw.bound, 14); return; /* End of sdw_util_$get_size */ /* */ sdw_util_$set_valid: entry (P_sdw_ptr); system_type = sys_info$system_type; goto SET_VALID_COMMON; sdw_util_$set_valid_l68: entry (P_sdw_ptr); system_type = L68_SYSTEM; goto SET_VALID_COMMON; sdw_util_$set_valid_adp: entry (P_sdw_ptr); system_type = ADP_SYSTEM; goto SET_VALID_COMMON; SET_VALID_COMMON: sdwp = P_sdw_ptr; /* Make it addressable */ if system_type = ADP_SYSTEM then adp_sdw.valid = "1"b; else do; /* Set valid, and set DF0, too */ l68_sdw.valid = "1"b; l68_sdw.df_no = "00"b; end; return; /* End of sdw_util_$set_valid */ /* */ sdw_util_$set_faulted: entry (P_sdw_ptr); system_type = sys_info$system_type; goto SET_FAULTED_COMMON; sdw_util_$set_faulted_l68: entry (P_sdw_ptr); system_type = L68_SYSTEM; goto SET_FAULTED_COMMON; sdw_util_$set_faulted_adp: entry (P_sdw_ptr); system_type = ADP_SYSTEM; goto SET_FAULTED_COMMON; SET_FAULTED_COMMON: sdwp = P_sdw_ptr; /* Make it addressable */ if system_type = ADP_SYSTEM then adp_sdw.valid = "0"b; else do; l68_sdw.valid = "0"b; l68_sdw.df_no = "00"b; /* Refresh these bits, just in case */ end; return; /* End of sdw_util_$set_faulted */ /* */ sdw_util_$get_valid: entry (P_sdw_ptr, P_valid_bit); system_type = sys_info$system_type; goto GET_VALID_COMMON; sdw_util_$get_valid_l68: entry (P_sdw_ptr, P_valid_bit); system_type = L68_SYSTEM; goto GET_VALID_COMMON; sdw_util_$get_valid_adp: entry (P_sdw_ptr, P_valid_bit); system_type = ADP_SYSTEM; goto GET_VALID_COMMON; GET_VALID_COMMON: sdwp = P_sdw_ptr; /* Make it addressable */ if system_type = ADP_SYSTEM then P_valid_bit = adp_sdw.valid; else P_valid_bit = l68_sdw.valid; return; /* End of sdw_util_$get_valid */ %page; %include "sdw.adp"; %page; %include "sdw.l68"; %page; %include sdw_info; %page; %include system_types; end sdw_util_;  wire_proc.pl1 11/11/89 1133.2r w 11/11/89 0825.5 108954 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ wire_proc: proc (wireptr, code); /* This procedure is used to temporarily wire down a hardcore procedure and its linkage section. It is assumed that ALL such wiring/unwiring is done by calls to this procedure. A data base in the SST header is used to prevent conflicts between different processes wiring/unwiring tha same segment, and between calls for procedures contained in the same bound segment. Linkage segments may be in a combined linkage segment. It is assumed that no procedure or linkage has segment number of zero. Coded September 1970 by Roger R. Schell 09/10/72, RB Snyder for follow-on 09/18/74, SH Webber to repair locking problems. 08/03/76, N. I. Morris to fix bug referencing linkage header 04/06/81, W. Olin Sibert, for ADP conversion, stacq builtin 10/12/83, Keith Loepere, for paged unpaged segments. */ dcl wireptr ptr parameter; /* pointer to the procedure to be wired */ dcl code fixed bin (35) parameter; /* an error code that is returned to caller */ dcl linkno fixed bin (18); /* segment number of linkage */ dcl linkoff fixed bin (18); /* offset of our linkage */ dcl segno fixed bin (18); /* segment number of procedure */ dcl tseg fixed bin (18); /* segment number temporary */ dcl sdwp pointer; /* Must declare here, 'cause include file can't */ dcl callptr pointer; /* pointer into calling procedure */ dcl freep pointer; /* pointer to a free entry */ dcl ip pointer; /* pointer to entry of current index */ dcl linkptr pointer; /* pointer to start of linkage */ dcl fp fixed bin; /* first page being wired */ dcl freei fixed bin; /* index of a free entry */ dcl i fixed bin; /* loop index */ dcl lp fixed bin; /* last page being wired */ dcl np fixed bin; /* number of pages being wired */ dcl size fixed bin; /* size of array of entries */ dcl temp_fp fixed bin; /* temporary */ dcl temp_lp fixed bin; /* temporary */ dcl increment fixed bin; /* incrementing value for count of wiring */ dcl wire_call bit (1) aligned; /* flag on if this was a call to wire */ dcl repeated_call bit (1) aligned; /* on if are other outstanding calls */ dcl locked bit (1) aligned; /* flag used during locking process */ dcl pds$process_id bit (36) aligned external static; /* id for locking */ dcl dseg$ (0:1023) fixed bin (71) aligned external static; dcl unpaged_page_tables$ external; dcl sys_info$system_type fixed bin external static; dcl sst$wire_proc_data bit (36) aligned external static; dcl sst$temp_w_event bit (36) aligned external static; dcl 1 lot$ aligned like lot external static; dcl error_table_$nolinkag fixed bin (35) external static; /* error code for no entry in lot */ dcl pxss$wait entry; dcl pxss$addevent entry (bit (36) aligned); dcl pxss$delevent entry (bit (36) aligned); dcl pxss$notify entry (bit (36) aligned); dcl get_ptrs_$given_segno entry (fixed bin (18)) returns (ptr); /* gets astep for a segment number */ dcl pc_wired$wire_wait entry (ptr, fixed bin, fixed bin); /* to read into core and wire pages */ dcl pc_wired$unwire entry (ptr, fixed bin, fixed bin); /* unwire pages */ dcl syserr entry options (variable); /* prints error message and crashes system */ dcl wired_utility_$caller entry () returns (ptr); /* procedure to get pointer to our caller */ dcl (addr, baseptr, bin, divide, hbound, max, null, ptr, stac, stacq) builtin; /* */ wire_call = "1"b; /* primary entry is a call to wire */ increment = 1; /* add to count for wire call */ goto join_not_me; wire_proc$unwire_proc: entry (wireptr, code); /* entry to unwire specified procedure */ wire_call = "0"b; /* Unwiring. */ increment = -1; /* Decrement counts */ join_not_me: code = 0; /* initialize error code to no error */ callptr = wireptr; /* copy argument */ go to join; /* join common code */ wire_proc$wire_me: entry (); /* entry to wire the caller */ wire_call = "1"b; /* primary entry is a call to wire */ increment = 1; /* when wiring we add 1 to counts */ goto join_me; wire_proc$unwire_me: entry (); /* entry to unwire the caller */ wire_call = "0"b; /* Unwiring. */ increment = -1; /* Decrement counts */ join_me: callptr = wired_utility_$caller (); /* get pointer to our caller */ /* and fall through to common code */ join: wpdp = addr (sst$wire_proc_data); /* get pointer to data for wire_proc */ upt_ptr = addr (unpaged_page_tables$); segno = bin (baseno (callptr), 18); /* get caller's segment number */ locked = stac (addr (wpd.temp_w_lock), pds$process_id); /* try to lock */ do while (^locked); call pxss$addevent (sst$temp_w_event); /* tell TC event to wait on */ locked = stac (addr (wpd.temp_w_lock), pds$process_id); /* try to lock again */ if ^locked then call pxss$wait; /* still locked, wait for it */ else call pxss$delevent (sst$temp_w_event); /* locked, clean un unnecessary addevent */ end; size = wpd.temp_w_max; /* find how far we must search for a match */ repeated_call = "0"b; /* initialize */ freei = hbound (wpd.temp_w, 1) + 1; /* initialize to null value -- max of 7 entries */ twep = null; /* initialize */ do i = size + 1 to 1 by -1; /* search for the entry we will use */ ip = addr (wpd.temp_w (i)); /* get pointer to current entry */ tseg = bin (ip -> twe.segno, 18); /* find who owns this entry */ if tseg = segno /* is it us? */ then do; twep = ip; /* remember that this is our entry */ if wire_call /* check if wire/unwire call */ then repeated_call = "1"b; /* this is repeated call to wire */ else if bin (twe.count, 18) ^= 1 /* for unwire, check number of calls outstanding */ then repeated_call = "1"b; /* there are other outstanding calls */ end; if tseg = 0 /* check for free entry */ then do; /* rememper the free entry */ freep = ip; /* remember the free index */ freei = i; end; end; linkno = binary (baseno (lot$.lp (segno)), 18); /* get linkage segment number */ if linkno = 0 /* check for segment that is not valid */ then code = error_table_$nolinkag; /* return error code */ else do; /* there is a linkage segment */ if ^repeated_call /* check if wired state is already set up */ then do; if twep = null /* check if we already have an entry */ then do; /* this is the first request to wire procedure */ linkoff = binary (rel (lot$.lp (segno)), 18); /* get linkage starting offset */ linkptr = ptr (baseptr (linkno), linkoff); /* make pointer to linkage header */ if freei > hbound (wpd.temp_w, 1) /* make certain end of array not passed */ then call syserr (1, "wire_proc: too many temp wired segments."); /* crash */ else wpd.temp_w_max = max (size, freei); /* update count of wired segs */ twep = freep; /* use a free entry */ twe.seg_w = check_unpaged (addr (dseg$ (segno))); /* unpaged is always wired */ twe.link_w = check_unpaged (addr (dseg$ (linkno))); /* remember linkage wired */ twe.segno = bit (segno, 18); /* fill in our segment number */ twe.linkno = bit (linkno, 18); /* and for our linkage */ twe.flp = bit (divide (linkoff, 1024, 8, 0), 8); /* compute the first link page */ /* compute last page from link length */ temp_lp = linkoff - 1 + bin (linkptr -> header.block_length, 18); twe.llp = bit (divide (temp_lp, 1024, 8, 0), 8); end; if ^twe.link_w /* check if linkage was initially wired */ then do; /* linkage is not initially wired */ fp, temp_fp = bin (bin (twe.flp, 8), 17); /* get first page number in linkage */ lp, temp_lp = bin (bin (twe.llp, 8), 17); /* and last page */ do i = 1 to size; /* check for overlap of linkage pages */ ip = addr (wpd.temp_w (i)); /* get pointer to entry */ if ip ^= twep /* skip our own entry */ then if linkno = bin (ip -> twe.linkno, 18) /* if same linkage segment */ then if fp = bin (ip -> twe.llp, 8) /* check for conflict with our first page */ then fp = temp_fp + 1; /* this page is taken care of by someone else */ else if lp = bin (ip -> twe.flp, 8) /* check for conflict with our last page */ then lp = temp_lp - 1; /* taken care of , so we skip last page */ end; if fp <= lp /* check if all linkage pages already wired */ then do; astep = get_ptrs_$given_segno (linkno); /* get AST pointer for linkage segment */ np = lp - fp + 1; /* compute number of pages */ if wire_call /* check if wire or unwire */ then call pc_wired$wire_wait (astep, fp, np); /* wire down linkage pages */ else call pc_wired$unwire (astep, fp, np); /* unwire linkage pages */ end; end; if ^twe.seg_w /* check if procedure was initially wired */ then do; astep = get_ptrs_$given_segno (segno); /* get AST pointer for procedure segment */ if wire_call /* check if wire or unwire */ then call pc_wired$wire_wait (astep, 0, -1); /* wire all pages of procedure */ else call pc_wired$unwire (astep, 0, -1); /* unwire all pages of procedure */ end; if ^wire_call /* check if we just unwired */ then do; /* if unwired, then release our entry */ twe.segno = (18)"0"b; /* clear procedure segment number */ twe.linkno = (18)"0"b; /* and linkage segment number */ if twep = addr (wpd.temp_w (size)) /* check if we have the last entry */ then wpd.temp_w_max = size - 1; /* reduce count of active entry max */ end; end; /* bump counter of outstanding calls */ twe.count = bit (bin (bin (twe.count, 18) + increment, 18), 18); end; if stacq (wpd.temp_w_lock, "0"b, pds$process_id) then call pxss$notify (sst$temp_w_event); else call syserr (1, "wire_proc: lock not locked"); return; %page; check_unpaged: proc (sdw_ptr) returns (bit (1) aligned); /* See if the sdw pointed to is unpaged (not page control paged) */ dcl sdw_ptr pointer; if sys_info$system_type = ADP_SYSTEM then /* Examine the appropriate SDW */ return ((bin (sdw_ptr -> adp_sdw.add, 26) < upt.sst_absloc) | (upt.sst_last_loc < bin (sdw_ptr -> adp_sdw.add, 26))); else return ((bin (sdw_ptr -> l68_sdw.add, 24) < upt.sst_absloc) | (upt.sst_last_loc < bin (sdw_ptr -> l68_sdw.add, 24))); end; %page; %include wire_proc_data; %page; %include linkdcl; %page; %include lot; %page; %include aste; %page; %include system_types; %page; %include "sdw.l68"; %page; %include "sdw.adp"; %page; %include unpaged_page_tables; /* */ /* BEGIN MESSAGE DOCUMENTATION Message: wire_proc: too many temp wired segments. S: $crash T: $run M: A request has been made to the supervisor to temp-wire an eighth hardcore segment. Only seven are allowed. Temp-wiring is used for supervisor programs, not I/O buffers. $err A: $recover $boot_tape Message: wire_proc: lock not locked S: $crash T: $run M: The lock on temp-wiring in the SST was found unlocked at the time an attempt was made to unlock it. The SST may be damaged. $err A: $recover END MESSAGE DOCUMENTATION */ end wire_proc; 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