[OpenSPARC-T2-SAM] / obp / obp / os / bootprom / alarm.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: alarm.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)alarm.fth 2.17 05/04/08
purpose: 
copyright: Copyright 2005 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ alarm function.
\ To install an alarm:  ['] forth-function #msecs alarm
\ To uninstall alarm:   ['] forth-function 0      alarm
\
headerless

variable alarm-list alarm-list off
struct
   /n  field  >active
   /n  field  >time-out
   /n  field  >time-remain
   /n  field  >acf
   /n  field  >ihandle
constant /alarm-node
d# 32 constant /max-alarms
/max-alarms /alarm-node * constant /alarm-list

: init-alarm-list
   /alarm-list dup alloc-mem			( len adr )
   dup alarm-list !				( len adr )
   swap erase					( )
;

\ execute acf for each active node in the alarm list
\ with the acf args and active node on the stack ( ??? node -- ??? flag )
\ exit with the alarm node for which the acf returns true on the stack
\ or 0 if the acf returns false for all alarms
: active-alarms  ( ??? acf -- node|0 )
   alarm-list @ /alarm-list 			( ??? acf adr len )
   bounds do					( ??? acf )
      i >active @ if				( ??? acf )
         i swap dup >r execute if		( ??? )           ( r: acf )
            r> drop i false leave		( ??? node flag ) ( r: )
         then					( ??? )           ( r: acf )
         r>					( ??? acf )       ( r: )
      then					( ??? acf )
      /alarm-node				( ??? acf sz )    ( r: )
   +loop					( ??? acf )       ( r: )
   if false then
;

: show-alarm  ( node -- flag )
   dup >acf @ .name  d# 20 to-column  dup >ihandle @ 9 u.r
   dup >time-out @ d# 7 u.r  >time-remain @ d# 10 u.r  cr
   false
;
headers
: .alarms  ( -- )
   ." Action                Ihandle  Interval  Remaining" cr
   ['] show-alarm active-alarms drop
;
headerless

\ Return flag will be true if the acf of the give node is equal to
\ the given acf.
: target-node?  ( ihandle acf node -- ihandle acf flag )
   2dup >acf @  =				( ihandle acf node flag )
   3 pick rot >ihandle @  = and			( ihandle acf flag )
;

: find-alarm  ( ihandle acf -- ihandle acf node|0 )
   ['] target-node? active-alarms
;

\ find next inactive alarm node for new alarm
: new-alarm  ( -- node|0 )
   false alarm-list @ /alarm-list 		( false adr len )
   bounds do					( false )
      i >active @ 0= if  drop i leave  then	( node )
      /alarm-node				( false sz )
   +loop					( false|node )
;

\ If a node with "acf" is already in the alarm-list, then just set the
\ time-out and time-remain with the new value "n"; else allocate a
\ new node and set up all fields with the given info.
: set-alarm-node  ( ihandle acf n -- )
   \ convert n miliseconds to #clock-ticks.
   ms/tick /mod  swap 0<>  if  1+  then		( ihandle acf #clock-ticks )
   >r find-alarm ?dup if			( ihandle acf node ) ( r: clk )
      0 over >active !				( ihandle acf node )
   else						( ihandle acf )
      new-alarm ?dup 0= if			( ihandle acf )
         ." ERROR: Alarm " .h			( ihandle )
         ."  not installed." cr   		( ihandle )
         ." Out of available alarms! " cr	( ihandle )
         r> 2drop abort				( )
      then					( )
   then						( ihandle acf node )
   tuck >acf !					( ihandle node )
   r@ over >time-out !				( ihandle node )
   r> over >time-remain !			( ihandle node )
   tuck >ihandle !				( node )
   -1 swap >active !				( )
;

\ find alarm by matching in ihandle/acf and set it inactive
: turn-off-alarm  ( ihandle acf -- )
   find-alarm ?dup if				( ih acf node )
      >active 0 swap ! 2drop			( )
   else						( ih acf )
      ." No alarm was installed for " .h  cr	( ih )
      drop					( )
   then
;

\ First check to see if the alarm is on (time-out >0).  If it is,
\ then check to see if the time is expired (time-remain = 0).
\ If time is not expired, decrement the time-remain.
: time-expired?  ( node -- flag )
   dup  >time-remain @  1- dup 0<=  if		( node remain )
      drop  dup >time-out @  over		( node out node )
      dup >acf @  swap >ihandle @		( node out acf ih )
      call-package				( node out )
   then swap >time-remain ! false		( false )
;

\ on entry alarms are disabled by setting alarm-disabled? true.
\ after alarms complete, alarm-disabled? set back to false to reenable alarms.
\ if any alarm results in an exception, we won't return from active-alarms
\ and alarm-disabled? will remain true so that alarms are permanently
\ disabled until the system is reset (breaks won't work). this is to
\ prevent exception-causing alarms from recurring everytime obp tries to
\ recover from the last exception. 
variable alarm-disabled? alarm-disabled? off
: check-alarm  ( -- )
   alarm-disabled? @ if  exit  then
   alarm-disabled? on
   ['] time-expired? active-alarms drop
   alarm-disabled? off
;

headers
: alarm  ( acf n -- )
   my-self -rot				( ihandle acf n )
   ?dup if  set-alarm-node  else  turn-off-alarm  then
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: alarm.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)alarm.fth 2.17 05/04/08
	43	purpose:
	44	copyright: Copyright 2005 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ alarm function.
	48	\ To install an alarm: ['] forth-function #msecs alarm
	49	\ To uninstall alarm: ['] forth-function 0 alarm
	50	\
	51	headerless
	52
	53	variable alarm-list alarm-list off
	54	struct
	55	/n field >active
	56	/n field >time-out
	57	/n field >time-remain
	58	/n field >acf
	59	/n field >ihandle
	60	constant /alarm-node
	61	d# 32 constant /max-alarms
	62	/max-alarms /alarm-node * constant /alarm-list
	63
	64	: init-alarm-list
65	/alarm-list dup alloc-mem ( len adr )
66	dup alarm-list ! ( len adr )
67	swap erase ( )
68	;
69
70	\ execute acf for each active node in the alarm list
71	\ with the acf args and active node on the stack ( ??? node -- ??? flag )
72	\ exit with the alarm node for which the acf returns true on the stack
73	\ or 0 if the acf returns false for all alarms
74	: active-alarms ( ??? acf -- node\|0 )
75	alarm-list @ /alarm-list ( ??? acf adr len )
76	bounds do ( ??? acf )
77	i >active @ if ( ??? acf )
78	i swap dup >r execute if ( ??? ) ( r: acf )
79	r> drop i false leave ( ??? node flag ) ( r: )
80	then ( ??? ) ( r: acf )
81	r> ( ??? acf ) ( r: )
82	then ( ??? acf )
83	/alarm-node ( ??? acf sz ) ( r: )
84	+loop ( ??? acf ) ( r: )
85	if false then
86	;
87
88	: show-alarm ( node -- flag )
89	dup >acf @ .name d# 20 to-column dup >ihandle @ 9 u.r
90	dup >time-out @ d# 7 u.r >time-remain @ d# 10 u.r cr
91	false
92	;
93	headers
94	: .alarms ( -- )
95	." Action Ihandle Interval Remaining" cr
96	['] show-alarm active-alarms drop
97	;
98	headerless
99
100	\ Return flag will be true if the acf of the give node is equal to
101	\ the given acf.
102	: target-node? ( ihandle acf node -- ihandle acf flag )
103	2dup >acf @ = ( ihandle acf node flag )
104	3 pick rot >ihandle @ = and ( ihandle acf flag )
105	;
106
107	: find-alarm ( ihandle acf -- ihandle acf node\|0 )
108	['] target-node? active-alarms
109	;
110
111	\ find next inactive alarm node for new alarm
112	: new-alarm ( -- node\|0 )
113	false alarm-list @ /alarm-list ( false adr len )
114	bounds do ( false )
115	i >active @ 0= if drop i leave then ( node )
116	/alarm-node ( false sz )
117	+loop ( false\|node )
118	;
119
120	\ If a node with "acf" is already in the alarm-list, then just set the
121	\ time-out and time-remain with the new value "n"; else allocate a
122	\ new node and set up all fields with the given info.
123	: set-alarm-node ( ihandle acf n -- )
124	\ convert n miliseconds to #clock-ticks.
125	ms/tick /mod swap 0<> if 1+ then ( ihandle acf #clock-ticks )
126	>r find-alarm ?dup if ( ihandle acf node ) ( r: clk )
127	0 over >active ! ( ihandle acf node )
128	else ( ihandle acf )
129	new-alarm ?dup 0= if ( ihandle acf )
130	." ERROR: Alarm " .h ( ihandle )
131	." not installed." cr ( ihandle )
132	." Out of available alarms! " cr ( ihandle )
133	r> 2drop abort ( )
134	then ( )
135	then ( ihandle acf node )
136	tuck >acf ! ( ihandle node )
137	r@ over >time-out ! ( ihandle node )
138	r> over >time-remain ! ( ihandle node )
139	tuck >ihandle ! ( node )
140	-1 swap >active ! ( )
141	;
142
143	\ find alarm by matching in ihandle/acf and set it inactive
144	: turn-off-alarm ( ihandle acf -- )
145	find-alarm ?dup if ( ih acf node )
146	>active 0 swap ! 2drop ( )
147	else ( ih acf )
148	." No alarm was installed for " .h cr ( ih )
149	drop ( )
150	then
151	;
152
153	\ First check to see if the alarm is on (time-out >0). If it is,
154	\ then check to see if the time is expired (time-remain = 0).
155	\ If time is not expired, decrement the time-remain.
156	: time-expired? ( node -- flag )
157	dup >time-remain @ 1- dup 0<= if ( node remain )
158	drop dup >time-out @ over ( node out node )
159	dup >acf @ swap >ihandle @ ( node out acf ih )
160	call-package ( node out )
161	then swap >time-remain ! false ( false )
162	;
163
164	\ on entry alarms are disabled by setting alarm-disabled? true.
165	\ after alarms complete, alarm-disabled? set back to false to reenable alarms.
166	\ if any alarm results in an exception, we won't return from active-alarms
167	\ and alarm-disabled? will remain true so that alarms are permanently
168	\ disabled until the system is reset (breaks won't work). this is to
169	\ prevent exception-causing alarms from recurring everytime obp tries to
170	\ recover from the last exception.
171	variable alarm-disabled? alarm-disabled? off
172	: check-alarm ( -- )
173	alarm-disabled? @ if exit then
174	alarm-disabled? on
175	['] time-expired? active-alarms drop
176	alarm-disabled? off
177	;
178
179	headers
180	: alarm ( acf n -- )
181	my-self -rot ( ihandle acf n )
182	?dup if set-alarm-node else turn-off-alarm then
183	;