//_Header: Formpm.prx		_date: 17-dec-1981
// Define and set compiler variables.
//
	%define for_vax
	%define for_lsi 
	%define net_connection  
	%define mpm_connection

	%set 	for_vax = false
	%set 	for_lsi = true
	%set 	net_connection  = false
	%set 	mpm_connection  = true
//_Header: Notrace		_date: 27-sep-1980
// Define and set compiler variable that controls debug messages:
//
	%define trace
	%set trace = false


module NSMHANUTL
//_Header
//*******************************************************************
//    NOVA Central Controls  ---  Lawrence Livermore Laboratory
//*******************************************************************
//_Module_Name:  NSMHANUTL		_File:  [NSM.SRC]NSMHANUTL.PRX
//
//_Description:
//	This module contains miscellaneous procedures needed by HANDLER
//	and SERVER to perform the operations required to implement the
//	signalling, locking, reserving and updating of regions.
//	Routines that are common to multiple user calls are implemented 
//	here.
//_Call:
//	To use the routines declared here, import the specific procedure
//	or USE NSMHANUTL.
//	The routines implemented here are:
Export
	Sleep,		// - Hibernate for a purpose, acknowledge when woken.
	pr_wake_user,	// - For a given user, wake, or signal server.
	user_activated, // - Set up user entry in environment.
	pr_acquire_reg,	// - Process interlocked open, lock, of a region.
	pr_give_reg,	// - Process the giving of a region to an aspiring owner.
		nsm_give_reg_critical, // fatal exception
	pr_free_reg,	// - process the final freeing up of a region ( interlocked )
	pr_aspirants	// - do interlocked access of region aspirants count.
//
//_Identifier: NCCNSM-VAXVMS-162
//
//*******************************************************************
//_Author:  J. M. Duffy		_Creation_Date:   5-MAR-1981
//
//_Revisions:
//
//  1.000   5-MAR-1981  JMD	Initial Key-in.
//  2.200  10-apr-1981	JMD	Add dynamic associate capability. ( not really )
//  2.201  16-apr-1981  JMD	Add pr_acquire, Change sleep.
//  2.400  01-may-1981	JMD	Another major rework: Put user calls into
//				separate modules and add individual handlers.
//  2.410  11-may-1981	JMD	SMC-version tests and revisions:
//  2.411  09-jun-1981  JMD	Fix deadlock in pr_cl_reg and pr_ul_reg
//  2.412  15-jun-1981  JMD	Fix deadlock in pr_cl_reg and pr_ul_reg (really)
//				Move routines to other modules.
//  2.413  27-oct-1981  JMD	Use actual env_id as a key for declare_env
//  2.700  19-jan-1982  JMD	Split into LSI/mpm and LSI/net versions.
//				Remove declare_env to another module.
//  2.701  17-feb-1982  JMD	Add signal_server option to sleep.
//  2.800  22-feb-1982  JMD	Add universal lock support:
//  2.801  23-FEB-1982  JMD	call TR_SIMPLE in pr_acquire_reg.
//  2.802  08-mar-1982  JMD	Change order of cancel_wake
//				Fix race, by allowing wake of snoozing
//				aswell as sleeping user in pr_wake_user.
//  2.803  16-mar-1982  jMD	Change pr_acquire_reg so as not to become
//				an aspiring user when open/lock_wait is 0.
//				Add sleep code for lsi-11.
//  2.900  18-may-1982  JMD	Re-do process wake/sleep synchronization.
//  2.901  19-may-1982  JMD	Add pr_free_reg.
//  2.902  20-may-1982  JMD	Add process synchronization.
//  2.903  21-may-1982  JMD	Use NSM_sleep_timer_efn
//  2.904  28-may-1982  JMD	Fix hanging action in pr_acquire_reg.
//  2.905  02-jun-1982  JMD	bracket out ef calls for lsi-11 version.
//  2.906  23-jul-1982  JMD	Fix bug in sleep which caused incorrect
//				timeout response on wait forevers.
//  2.907  27-jul-1982  JMD	Use gltypes instead of regionids.
//  2.908  19-aug-1982  JMD	Correct use of VMS timer id's thru use
//				of local event flag number stored in NSM_Timer
//				as timerid and event flag.
//  2.909  03-sep-1982  JMD	Add mpm interrupts
//  2.911  02-dec-1982  JMD	Add pr_aspirants to do interlocked check 
//				of region aspirant count.
%ident "2.911"
//*******************************************************************
//_End

//
// Import types, variables, and structures from other modules.
//
	Use 	Nsmtypes
	Use 	Nsmstatus
	Use 	Iomodule
	Use 	NSMsysutl
	Use 	NSMtabutl
	Use	NSMcommon
	Import	dmp_re,
		dmp_ue,
		dmp_ae,
		dmp_pid		from NSMDUMP
	Import	Addr_of		From Addrof
	Use	nsmnodes
%if mpm_connection
	use	nsmmpmutl
%endif
%if net_connection
	import  env_offset 	from gltypes
	Use	NSMtrnutl
%endif



	exception NSM_give_reg_critical

//_Header
//*******************************************************************
//_Module_Name:  sleep		_File:  [NSM.SRC]nsmhanutl.PRX
//_Identifier: NCCNSM-VAXVMS-163
//_Description:
//	This procedure will allow a user to hibernate for a particular
//	reason, and will deduce if the process was woken or timed out.
//
//	For lsi-11s this routine will go into a compute bound loop
//	until the ud.status field has been set by the waker.
//	( a psuedo time value is used. )
//_Call:
procedure sleep 
    param
	why		: in 	val User_action_type
	UD		: inout ref UDT_entry_type
	AC		: inout ref ACB_entry_type
	wait		: in	ref Wait_vector
	response	: out 	ref 16 bit integer
	signal		: optional in 	val boolean initially false
	first_flag	: optional in	val boolean initially true
    endparam
//_remarks:
//
//	This procedure has been altered so that it uses a local event
//	flag timer to verify the the time-out interval... this will give us
//	a race free indication of whether or not it was a "wake" or a
//	time out.  A flag has been added to allow this call to be made
//	without the setting of the timer..... 
//
//	Issues:
//		1) The scheduled_wake is never cancelled... It is just allowed
//		to time_out.... This may cause more Unknown Wakeups than
//		before ,but the new logic should verify that this was a dummy
//		wake and go back to sleep...
//
//		2) The user_is_dozing check is for wakes on different nodes.
//_end
	%if trace
		put16("Sleep -- for reason:",why)
	%endif
	declare
%if for_vax
		was_clear: boolean
%orif for_lsi 
		time_out : 16 bit integer 	// pseudo counter.
%endif
	enddeclare

	if wait.time_out <> 0 do
		If wait.time_out > 0 do
%if for_vax
			if first_flag do
				%if trace
					put16( "***************** scheduling wakeup for:",wait.time_out)
					put16( "*****************                 units:",wait.units)
				%endif
				set_timer(nsm_timer,wait.time_out,wait.units)
				schedule_wakeup ( wait.time_out, wait.units, response )
			endif
%otherwise
			time_out := wait.time_out * wait.units * 1000		// a "psuedo wait."
		otherwise
			time_out := -1
%endif
		endif
		ac.action := why
		ud.action := why
		ud.status := user_is_asleep
		if signal do
			%if trace
				put("********* signal server *******")
			%endif
			signal_server()
		endif
		%if trace
			put ("*************** hibernating ************")
		%endif
%if for_vax
		hibernate ( )					// wait here
		%if trace
			put ("*************** woken up ************")
		%endif
		clear_ef ( nsm_timer, was_clear )
		if wait.time_out = -1 do
			response := nsm_success
		otherwise
			if not was_clear do
				response := nsm_timeout
			otherwise
				response := nsm_success
			endif
		endif
%otherwise
		response := nsm_timeout
		wait_loop: repeat 
			for i := 1 to time_out do
				if ud.status = user_was_woken do
					response := nsm_success
					break wait_loop
				endif
			endfor
		until time_out > 0 					// repeat this loop for ever.
%endif
		ud.status := user_is_active
		ud.action := no_action
	otherwise
		%if trace
			put ("********* not waiting ***********")
		%endif
		response := nsm_timeout
	endif
endprocedure { sleep }

//_Header
//*******************************************************************
//_Module_Name:  pr_wake_user		_File:  [NSM.SRC]nsmhanutl.prx
//_Identifier: NCCNSM-VAXVMS-xxx
//_Description:
//	This procedure will wake a sleeping user if he is in the same node
//	as the caller, and set him to dozing, if he is not.
//	And send an mpm interrupt on the lsi-11
//_Call:
//
procedure	pr_wake_user
    param
	ud	: inout  ref udt_entry_type
	resp	: out    ref 16 bit integer
    endparam
//
//_remarks:
//	This routine no longer tests the previous state of the 
//	user before wakeing him....
%if trace
	dmp_pid("Pr_Wake_User called for user:",ud.pid)
%endif
	if ud.node = initial_user.node do
		ud.status := user_was_woken 
		wake ( ud.pid, resp )
		%if trace
			put16("   - woken... resp:",resp )
		%endif
	otherwise 
		%if trace
			put("    - Set to dozing.")
		%endif
		ud.status := user_is_dozing
%if mpm_connection
		declare
			mask : 16 bit integer
				initially node_to_mpm_mask(ud.node)
		enddeclare
		if mask <> 0 do
			mp_send (mask,resp)	// signal thru multiport
		otherwise
			/// signal server of remote users ma780 port
			resp := nsm_signal
		endif
%endif
	endif
endprocedure {pr_wake_user}

//_Header
//*******************************************************************
//_Module_Name:  USER_ACTIVATED		_File:  [NSM.SRC]nsmhanutl.prx
//_Identifier: NCCNSM-VAXVMS-178
//_Description:
//	This procedure will add a user to the UDT list.
//	It is meant to be called from within AS_env or as_reg.
//_Call:
//
function  user_activated 
    param
	ECB		: inout	ref Ecb_type
	RCT		: inout	ref array [1..?r_size] of RCT_entry_type
	UDT		: inout	ref array [1..?u_size] of UDT_entry_type
	ACB		: inout	ref array [1..?a_size] of ACB_entry_type
	dmt		: inout ref Dmt_entry_type
	pid		: in 	ref pid_type
	node		: in 	ref node_type
	priority	: in 	ref user_priority_type
	user		: inout ref UDT_index
	resp		: inout 16 bit integer
    endparam
    returns 
	success	: boolean initially false
//
//_End

	%if trace
		declare
			longword is 32 bit integer
			temp 	: longword
		enddeclare
		put("user_activated -- Entry:")
		dmp_pid("	pid:      ",pid)
		put8 ("	node:     ",node)
		put8 ("	priority: ",priority)
		put8 ("	udt_index:",user)
	%endif

	If all_U ( ecb, udt, user ) do			// Get a free entry.
		ini_Ue ( udt[user] )			// Initialize it to default values.
			pid_move( pid, udt[user].pid ) 	
			udt[user].priority := priority
			udt[user].node	:= node
		If add_U ( ecb, udt, user ) do		// Add My Udt Entry to the UDT Active list.
			dmt.user_index := user		// save in dmt.
			declare 
				t : boolean
				a : acb_index
			enddeclare
			for i := 1 to ecb.reg_count do	// Initiallize all acb's for the user.
				t := find_a(ecb,rct,udt,acb,i,user,a)
				ini_ae(acb[a])
			endfor
			resp 	:= nsm_success
			success := true
		otherwise
			resp := nsm_tableslost
		endif
	otherwise					// No Udt entries available.
		resp := nsm_overuser
	endif
	%if trace
		put("User_activated -- result:")
//		put8 ("	udt_index:",user)
		dmp_ue (udt,user)
		if success do
			put  ("	success:   true")
		otherwise
			put  ("	success:   false")
		endif
		put16("	response: ",resp)
		nsm_explain(resp)
	%endif

endfunction { user_activated }


//_Header
//*******************************************************************
//_Module_Name:  pr_acquire_reg		_File:  [NSM.SRC]nsmhanutl.PRX
//_Identifier: NCCNSM-VAXVMS-xxx
//_Description:
//	This function will do the activity neccessary to give a user
//	guaranteed, interlocked access to a region.
//	It is called to do either "opens" and "locks" of regions, 
//	since the logic is so similar.  Also does wait_locks.
//
//	If the user cannot get the region on the first try, he
//	becomes an 'aspiring owner' and hibernates until he has been
//	given the region by the  pr_give_reg call of the current or
//	subsequent owner.	
//	However, one cannot become an asiprant unless, the open_wait
//	or lock_wait fields indicate that the user agrees to go to 
//	sleep until the region is given to him.
//  Universal Lock support:
//	For remote fep's, this routine first sends a request to the
//	central environment server node for this region. If the region
//	can be opened/locked in his behalf at the vax, then it is done
//	locally.
//  New Synchronization:
//	This procedure will loop on the sleep call to check that the 
//	region has indeed been given to us, or a timeout.. otherwise
//	it is assumed to be a hanging wake.
//
//	We are sure to cancel action when we know wake was for us.
//
//	Also we set the action field in the ACB when the aspirant count
//	is interlock-incremented.  This removes a major race.
//
//	Another race was removed by doing a second check that the region was
//	not updated before staying with a wait_lock.
//
//_call:
//
Function pr_acquire_reg
    param
	env_id		: in 	val environment_id_type
	ecb		: in	ref ecb_type
	RC		: inout	ref RCT_entry_type
	UD		: inout	ref UDT_entry_type
	AC		: inout	ref ACB_entry_type
	user		: in	ref udt_index
	wait		: in	ref wait_vector
	action		: in	val user_action_type
	new_status	: in	val region_status_type
	resp		: out 	ref 16 bit integer
    endparam
    returns 
	got_region	: boolean initially false
//
//_end
	declare
%if for_vax
		critical_wait 	= wait_vector ( time_out: 10, units: 2 ) // 10 milliseconds
		retry_max	= 10
%otherwise
		critical_wait 	= wait_vector ( time_out: 0, units: 2 ) // dont wait at all
		retry_max	= 1					// and retry only once.
%endif
		retry_count	: 16 bit integer initially 0
		node		: node_type
		acquire_trans	: transaction_code_type
		first_flag	: boolean initially true
		actual_action	: user_action_type initially action
	enddeclare

	%if trace
		put("pr_acquire -- Entry.")
		select action from
			case open_action: put16("	Open the region:",rc.reg_id)
			case lock_action: put16("	Lock the Region:",rc.reg_id)
			case wait_and_lock_on_update_action: put16 ("	Wait and lock the Region:",rc.reg_id)
			default:	  put("	ooops.......")
		endselect
		put8("	For user:",user)
	%endif
%if net_connection 
	node := central_environment_server_node[env_id]
	if ecb.net_supported and 
	   initial_user.node <> node and current_user.node <> node do
		select action from
		case open_action:
			acquire_trans := op_reg_trans
		case lock_action:
			acquire_trans := LK_reg_trans
		case wait_and_lock_on_update_action:
			resp := nsm_unimplmnt
			return
		default:
			resp := nsm_badparam
			return
		endselect
		tr_simple_send(rc.reg_id, acquire_trans, node, resp)
		if resp <> nsm_success and resp <> nsm_already do
			return
		endif
	endif
%endif
	region rc.lock do
		select rc.status from 					// determine if available.
		    case  reg_is_idle:     got_region 	:= true
		    case  reg_is_latched:  got_region	:= ( action <> open_action )
		    default:   		   got_region 	:= false
		endselect

		if action =  wait_and_lock_on_update_action do
			select ac.status from			// one last check on status
			case reg_was_updated, reg_was_overwritten:
				actual_action := lock_action	// convert to lock
			default:
				got_region := false	
			endselect
		endif

		if got_region do
			rc.owner 	:= user				// claim the user if un-used.
			rc.status	:= new_status		
			ac.status 	:= new_status
			ac.action	:= no_action
			resp 		:= nsm_success
			return
		otherwise
			if wait.time_out <> 0 do			// the user has agreed to wait so...
				rc.aspirants	*= + 1			// increase waiting user count.
			        ac.action	:= actual_action
			otherwise
				resp 	:= nsm_regbusy			// giveup....
				return
			endif
		endif
	otherwise
		%if trace
			put16("	Critical region access failure:",retry_count)
		%endif
		sleep ( wait_for_resources_action, UD, AC, critical_wait, resp )
		retry_count *= + 1
		if retry_count <= retry_max do
			retry
		otherwise
			resp := nsm_noaccess
			return
		endif
	endregion
//
//  This exit out of above region statement is when we want to be an aspiring user.
//	and have agreed to wait.
//
%if trace
	if action <> actual_action do
		put("Action converted from wait_lock to lock")
	endif
%endif
	repeat
		sleep ( actual_action, UD, AC, wait, resp, first_flag: first_flag )			// Wait until
		if rc.status = new_status and rc.owner = user do	// the region has been given to us...
			ac.action := no_action
			got_region := true
			resp := nsm_success
			return
		orif resp = nsm_timeout do				// or we timed out ...
			if rc.status <> reg_is_idle and rc.status <> reg_is_latched do
				resp := nsm_regbusy			
			endif
			ac.action := no_action
			region rc.lock do
				rc.aspirants	*= - 1			// decrease waiting user count.
				if rc.aspirants < 0 do
					rc.aspirants := 0
				endif
			otherwise
				%if trace
					put16("	Critical region access failure:",retry_count)
				%endif
				sleep ( wait_for_resources_action, UD, AC, critical_wait, resp )
				retry_count *= + 1
				if retry_count <= retry_max do
					retry
				otherwise
					resp := nsm_noaccess
					return
				endif
			endregion
			return
		otherwise
			first_flag := false
		endif
	until false

endfunction {pr_acquire_reg}

//_Header
//*******************************************************************
//_Module_Name:  pr_give_reg		_File:  [NSM.SRC]nsmhanutl.PRX
//_Identifier: NCCNSM-VAXVMS-xxx
//_Description:
//	This procedure will give an aspiring user the region for which
//	he is waiting, after processing all associated ACB's, this
//	user should be woken.
//	It is designed to interract with a user who has gone to sleep
//	in the pr_acquire_reg routine.
//	Note: an exception is raised if we cant give away the region
//	since the integrity of the tables is corrupted.
//_Call:
procedure pr_give_reg 
    param
	rc		: inout ref rct_entry_type // rct[reg] please
	giving_ud	: inout ref udt_entry_type
	giving_ac	: inout ref acb_entry_type
	new_user	: in val udt_index
	new_stat	: in val region_status_type
    endparam
//_end
	declare
%if for_vax
		critical_wait = wait_vector ( time_out: 5, units: 2 ) // 5 milliseconds
%otherwise
		critical_wait = wait_vector ( time_out: 0, units: 2 ) // 5 milliseconds
%endif

		retry_count	: 16 bit integer initially 0
		retry_max	= 10	
		resp		: 16 bit integer
	enddeclare
	%if trace 
		put8("pr_give_reg -- To user:", new_user)
		put16("	the region:",rc.reg_id)
		put8 ("	with new status:",new_stat)
	%endif	
	region rc.lock do
		rc.status := new_stat
		rc.owner := new_user
		rc.aspirants *= -1
		if rc.aspirants < 0 do
			rc.aspirants := 0
		endif
	otherwise
		%if trace
			put16("pr_give_reg -- Critical region access failure:",retry_count)
		%endif
		sleep ( wait_for_resources_action, giving_UD, giving_AC, critical_wait, resp )
		retry_count *= + 1
		if retry_count <= retry_max do
			retry
		otherwise
			raise	NSM_give_reg_critical
		endif
	endregion
	%if trace
		put8("tr_give_reg -- Exit. Remaining Aspirants:",rc.aspirants)
	%endif
endprocedure {pr_give_reg}

//_Header
//*******************************************************************
//_Module_Name:  pr_free_reg		_File:  [NSM.SRC]nsmhanutl.PRX
//_Identifier: NCCNSM-VAXVMS-xxx
//_Description:
//	This procedure will free the region for which it is called.
//	This will interlock with a check on the aspirants count.
//	Note that if the region is locked, we can safely assume that
//	there is someone in the process of changing the rc.aspirant
//	value and therefore we can return true.
//	Note: 02-dec-1982  No need for udt and acb here, so they were removed
//	from the call.
//_Call:
procedure pr_free_reg 
    param
	closing		: in 	val boolean
	rc		: inout ref rct_entry_type
	those_aspiring	: inout ref 16 bit integer
	new_aspirants   : out ref boolean
    endparam
//_end
	declare
		resp		: 16 bit integer
		new_status 	: region_status_type 
	enddeclare

	if closing and ( rc.assoc_class = command_class )  do
		new_status := reg_is_latched
	otherwise
		new_status := reg_is_idle
	endif

	%if trace 
		put16("pr_free_reg -- the region:",rc.reg_id)
		put8 ("	to status :", new_status)
		put16("	aspirants :", those_aspiring)
	%endif	

	region rc.lock do
		if  rc.aspirants > those_aspiring  do 	
			new_aspirants  := true
		otherwise
			rc.status := new_status
			new_aspirants  := false
		endif
		those_aspiring := rc.aspirants
	otherwise	// someone is in the process of changing.
		new_aspirants := true
		those_aspiring := rc.aspirants
		// the above assumes that the only time that this will
		// be done is when another process is looking at the
		// state of the region to open or lock it... since
		// we have not yet "freed" the region, we can presume that
		// they will find it busy and increment the aspirant count.
		// However, the value of those_aspiring returned in this case
		// might not yet be the incremented value, depending on the
		// speed of the other code... At most one extra pass of the
		// calling loop will be done....
	endregion

	%if trace
		put8("pr_free_reg -- Exit. Remaining Aspirants:",rc.aspirants)
		if new_aspirants do
			put("	new_aspirants = true")
		otherwise
			put("	new_aspirants = false")
		endif
	%endif
endprocedure {pr_free_reg}


//_Header
//*******************************************************************
//_Module_Name:  pr_aspirants		_File:  [NSM.SRC]nsmhanutl.PRX
//_Identifier: NCCNSM-VAXVMS-xxx
//_Description:
//	This will interlock with a check on the aspirants count.
//	Note that if the region is locked, we can safely assume that
//	there is someone in the process of changing the rc.aspirant
//	value and therefore we can return true.
//_Call:
procedure pr_aspirants 
    param
	rc		: inout ref rct_entry_type
	those_aspiring	:   out ref 16 bit integer
    endparam
//_end

	%if trace 
		put16("pr_aspirants -- for the region:",rc.reg_id)
	%endif	

	region rc.lock do
		those_aspiring := rc.aspirants
	otherwise	// someone is in the process of changing.
		those_aspiring := -1
		// the above assumes that the only time that this will
		// be done is when another process is looking at the
		// state of the region to open or lock it... 
		// Therefore we want to make sure that pr_free_region
		// will always see the new aspirant. 
		// Since the check is for rc.aspirants > those_aspiring
		//	-1 will always be less than the actual number.
		// and since this routine is only called at the entry
		// 	of pr_cl_reg or pr_ul_reg, this -1 value occurs only
		//	once.
	endregion

	%if trace
		put8("pr_aspirants -- Exit. Those_aspiring:",rc.aspirants)
	%endif
endprocedure {pr_aspirants}

endmodule