



		    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+<cpu tag>
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+<cpu tag>
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
