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

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: showdisk.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: @(#)showdisk.fth 1.10 02/05/02
purpose: 
copyright: Copyright 1990-2002 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

headerless
\ more-poss? is true if there are possibly more devices
0 value more-poss?

\ The prefix deal- relates to "device alias".
\ deal-display is turned on if we want to display text in menu
\ It also affects displaying of individual device path names.
0 value deal-display

\ menu-cont? controls begin while repeat loop to display/receive input
\ It affects only the end text of menu.
true value menu-cont?

\ deal-counter countes all devices of a given type, along with deal-cycle.
0 value deal-counter

\ user's selected counter
0 value my-deal-counter

\ If devices to display are more than those can be displayed in one menu
0 value deal-cycle

\ value of cycle when user selected counter
0 value my-deal-cycle

\ turn off deal-unchosen? after user selects "q" or some valid device
true value deal-unchosen?

h# 90 constant  /deal-buffs
h# 20 constant  /deal-tbuffs
d# 10 constant cyclesize		\ no. of items to display in one menu
/deal-buffs   buffer: start-deal	\ initial path/expanded alias
/deal-buffs  buffer: deal-seled		\ device path selected by user.
/deal-tbuffs  buffer: deal-type-buff	\ device_type to search

\ display one choice for device
: show-me ( -- )
   true to deal-display
   deal-unchosen?  if
      deal-counter ascii a + emit ." ) "
      deal-seled 0 (pwd) type			( )
      cr
   then
;

\ Redisplay selection and some help on how to use it.
: show-only-my ( -- )
   false to deal-display
   \ get correct selection
   deal-counter my-deal-counter =
   deal-cycle my-deal-cycle = and  if   ( )
      \ collect device name in buffer
      [ also hidden also command-completion ]
      cr kill-buffer 1+ 0 (pwd) swap 1- tuck c! dup ".	( pstr )
      [ previous previous ]
      ."  has been selected." cr
      ." Type ^Y ( Control-Y ) to insert it in the command line. " cr
      ." e.g. ok nvalias mydev ^Y " cr
      ."          for creating devalias mydev for " ". cr
   then
;

\ process input from user  other than "m"/"q"
: get-menu ( counter -- counter )
   \ make sure my-deal-counter is less than current deal-counter
   dup deal-counter <
   over 0 >= and  if  ( counter )
      \ there was a valid choice
      deal-cycle to my-deal-cycle
      false to menu-cont?
      false to deal-unchosen?
      false to deal-display
      \ ." correctly selected counter/cycle "
   else   ( counter )
      \ there was an invalid choice
      true to deal-unchosen?
      (cr ." valid choice: a..." deal-counter 1- ascii a + emit ." , "
      more-poss?  if
	 ." m for more or "
      then
      ." q to quit "
   then    ( counter )
;

\ display end portion of menu and take input. process "m"/"q" input
: deal-menu ( -- )
   more-poss?  if
      ." m) MORE SELECTIONS " cr
   then
   deal-display  if
      ." q) NO SELECTION " cr
      ." Enter Selection, q to quit: "
   then
   \ true to menu-cont?
   deal-cycle deal-counter or to menu-cont?
   begin  menu-cont?  while
      key lcc dup emit
      ascii a - to my-deal-counter
      my-deal-counter case
	 [ ascii m ascii a - ] literal ( h# c ) of
	    more-poss?  if
	       \ next round
	       false to menu-cont?
	       deal-display  if  cr cr cr  then
	    else
	       (cr ." valid choice: a..." deal-counter 1- ascii a + emit ." , "
	       ." q to quit "
	    then
	    true to deal-unchosen?
	 endof

	 [ ascii q ascii a - ] literal ( h# 10 ) of
	    false to menu-cont?
	    false to deal-unchosen?
	    false to deal-display
	    \ quitting
	 endof

	 ( default )   get-menu ( my-deal-counter -- my-deal-counter )
      endcase
   repeat
;

\ call routine to individually process a device path name and
\ call routine to get input when one set of devices (cyclesize) are displayed.
: .countedshow  ( acf -- )
   \ execute single device handling routine
   execute  ( )
   deal-counter 1+ is deal-counter
   deal-counter cyclesize mod 0=  if
      \ handle selection from user
      \ TODO if we can terminate (search-preorder) after we select a device,
      \ then we don't need to worry about deal-unchosen? below
      deal-display deal-unchosen? and  if
	 deal-menu
      then
      deal-cycle 1+ is deal-cycle
      0 to deal-counter
   then
;

\ select a device of required device_type
: (sel-dev-type)  ( acf -- )
   \  see if device_type property exists,
   " device_type" get-property  if           ( acf )
      \ not of interest
      drop  				     (  )
   else ( device may be of interest )        ( acf val-adr,len )
      \ since device_type existed, this device may be of interest
      \ see if this device_type is same as we are looking for
      get-encoded-string  deal-type-buff count  $=  if  ( acf )
	 \ really interesting device
	 .countedshow                        (  )
      else                                   ( acf )
	 \ skip this device since device_type is of no interest to us
	 drop                                (  )
      then                                   (  )
   then
;

\ for selecting all devices of a given device_type
: sel-devs ( -- flag )  ['] show-me (sel-dev-type) false  ;

\ for selecting only one device which was chosen by user
: sel-only-my ( -- flag )  ['] show-only-my (sel-dev-type) false  ;

: init-my-counters ( -- )
   true to more-poss?
   true to deal-unchosen?
   0 to my-deal-cycle
   0 to my-deal-counter
;

: init-his-counters ( -- )
   deal-seled /deal-buffs erase
   0 to deal-cycle
   0 to deal-counter
   false to deal-display
;

: init-deal ( type-adr,len -- )  \ initialize counters
   deal-type-buff  /deal-tbuffs erase
   start-deal /deal-buffs erase
   deal-type-buff pack drop     (  )
   init-his-counters            (  )
   init-my-counters             (  )
;

\ initialization and dealing with device path/alias entered by user.
: deal-head ( type-adr,len -- dev-pathadr,len )
   init-deal  ( )
   \ handle optional devicepath or alias
   optional-arg-or-/$        ( dev-pathadr,len )
   ?expand-alias             ( dev-pathadr,len )
   \ save initial path in a buffer for later use with deal-find.
   2dup start-deal pack drop ( dev-pathadr,len )
;

\ main routine which calls preorder search on device tree
: deal-find ( dev-pathadr,len acf -- )
   -rot  find-device  ( acf )
      ( acf )  ['] (search-preorder) catch 2drop
   device-end
;

\ for confirming user's selection (redisplay of the selected device path)
: show-sel ( -- )
   my-deal-counter
   ( ascii q ascii a - ) h# 10 <>  if
      init-his-counters                 (  )
      \ start with the same device path/alias as user entered
      start-deal count                  ( dev-pathadr,len )
      ['] sel-only-my deal-find
   then
;

\ main high level routine to find all devices of a given type.
\ stack input is counted string for that device type
: deal-devs ( type-adr,len -- )
   current-device >r
   \ init and handle optional input
   deal-head  ( dev-pathadr,len )
   ['] sel-devs deal-find
   \ in case we never made a choice
   begin
      deal-unchosen? deal-cycle deal-counter or and
   while
      false to more-poss?
      deal-menu
      false to deal-display
   repeat
   \ after a valid selection by user, redisplay user's selection
   show-sel
   r>  push-device
;

headers
: show-disks    ( -- )  " block"         deal-devs  ;
: show-ttys     ( -- )  " serial"        deal-devs  ;
: show-hier     ( -- )  " hierarchical"  deal-devs  ;
: show-nets     ( -- )  " network"       deal-devs  ;
: show-tapes    ( -- )  " byte"          deal-devs  ;
: show-displays ( -- )  " display"       deal-devs  ;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: showdisk.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: @(#)showdisk.fth 1.10 02/05/02
	43	purpose:
	44	copyright: Copyright 1990-2002 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	headerless
	48	\ more-poss? is true if there are possibly more devices
	49	0 value more-poss?
	50
	51	\ The prefix deal- relates to "device alias".
	52	\ deal-display is turned on if we want to display text in menu
	53	\ It also affects displaying of individual device path names.
	54	0 value deal-display
	55
	56	\ menu-cont? controls begin while repeat loop to display/receive input
	57	\ It affects only the end text of menu.
	58	true value menu-cont?
	59
	60	\ deal-counter countes all devices of a given type, along with deal-cycle.
	61	0 value deal-counter
	62
	63	\ user's selected counter
	64	0 value my-deal-counter
65
66	\ If devices to display are more than those can be displayed in one menu
67	0 value deal-cycle
68
69	\ value of cycle when user selected counter
70	0 value my-deal-cycle
71
72	\ turn off deal-unchosen? after user selects "q" or some valid device
73	true value deal-unchosen?
74
75	h# 90 constant /deal-buffs
76	h# 20 constant /deal-tbuffs
77	d# 10 constant cyclesize \ no. of items to display in one menu
78	/deal-buffs buffer: start-deal \ initial path/expanded alias
79	/deal-buffs buffer: deal-seled \ device path selected by user.
80	/deal-tbuffs buffer: deal-type-buff \ device_type to search
81
82	\ display one choice for device
83	: show-me ( -- )
84	true to deal-display
85	deal-unchosen? if
86	deal-counter ascii a + emit ." ) "
87	deal-seled 0 (pwd) type ( )
88	cr
89	then
90	;
91
92	\ Redisplay selection and some help on how to use it.
93	: show-only-my ( -- )
94	false to deal-display
95	\ get correct selection
96	deal-counter my-deal-counter =
97	deal-cycle my-deal-cycle = and if ( )
98	\ collect device name in buffer
99	[ also hidden also command-completion ]
100	cr kill-buffer 1+ 0 (pwd) swap 1- tuck c! dup ". ( pstr )
101	[ previous previous ]
102	." has been selected." cr
103	." Type ^Y ( Control-Y ) to insert it in the command line. " cr
104	." e.g. ok nvalias mydev ^Y " cr
105	." for creating devalias mydev for " ". cr
106	then
107	;
108
109	\ process input from user other than "m"/"q"
110	: get-menu ( counter -- counter )
111	\ make sure my-deal-counter is less than current deal-counter
112	dup deal-counter <
113	over 0 >= and if ( counter )
114	\ there was a valid choice
115	deal-cycle to my-deal-cycle
116	false to menu-cont?
117	false to deal-unchosen?
118	false to deal-display
119	\ ." correctly selected counter/cycle "
120	else ( counter )
121	\ there was an invalid choice
122	true to deal-unchosen?
123	(cr ." valid choice: a..." deal-counter 1- ascii a + emit ." , "
124	more-poss? if
125	." m for more or "
126	then
127	." q to quit "
128	then ( counter )
129	;
130
131	\ display end portion of menu and take input. process "m"/"q" input
132	: deal-menu ( -- )
133	more-poss? if
134	." m) MORE SELECTIONS " cr
135	then
136	deal-display if
137	." q) NO SELECTION " cr
138	." Enter Selection, q to quit: "
139	then
140	\ true to menu-cont?
141	deal-cycle deal-counter or to menu-cont?
142	begin menu-cont? while
143	key lcc dup emit
144	ascii a - to my-deal-counter
145	my-deal-counter case
146	[ ascii m ascii a - ] literal ( h# c ) of
147	more-poss? if
148	\ next round
149	false to menu-cont?
150	deal-display if cr cr cr then
151	else
152	(cr ." valid choice: a..." deal-counter 1- ascii a + emit ." , "
153	." q to quit "
154	then
155	true to deal-unchosen?
156	endof
157
158	[ ascii q ascii a - ] literal ( h# 10 ) of
159	false to menu-cont?
160	false to deal-unchosen?
161	false to deal-display
162	\ quitting
163	endof
164
165	( default ) get-menu ( my-deal-counter -- my-deal-counter )
166	endcase
167	repeat
168	;
169
170	\ call routine to individually process a device path name and
171	\ call routine to get input when one set of devices (cyclesize) are displayed.
172	: .countedshow ( acf -- )
173	\ execute single device handling routine
174	execute ( )
175	deal-counter 1+ is deal-counter
176	deal-counter cyclesize mod 0= if
177	\ handle selection from user
178	\ TODO if we can terminate (search-preorder) after we select a device,
179	\ then we don't need to worry about deal-unchosen? below
180	deal-display deal-unchosen? and if
181	deal-menu
182	then
183	deal-cycle 1+ is deal-cycle
184	0 to deal-counter
185	then
186	;
187
188	\ select a device of required device_type
189	: (sel-dev-type) ( acf -- )
190	\ see if device_type property exists,
191	" device_type" get-property if ( acf )
192	\ not of interest
193	drop ( )
194	else ( device may be of interest ) ( acf val-adr,len )
195	\ since device_type existed, this device may be of interest
196	\ see if this device_type is same as we are looking for
197	get-encoded-string deal-type-buff count $= if ( acf )
198	\ really interesting device
199	.countedshow ( )
200	else ( acf )
201	\ skip this device since device_type is of no interest to us
202	drop ( )
203	then ( )
204	then
205	;
206
207	\ for selecting all devices of a given device_type
208	: sel-devs ( -- flag ) ['] show-me (sel-dev-type) false ;
209
210	\ for selecting only one device which was chosen by user
211	: sel-only-my ( -- flag ) ['] show-only-my (sel-dev-type) false ;
212
213	: init-my-counters ( -- )
214	true to more-poss?
215	true to deal-unchosen?
216	0 to my-deal-cycle
217	0 to my-deal-counter
218	;
219
220	: init-his-counters ( -- )
221	deal-seled /deal-buffs erase
222	0 to deal-cycle
223	0 to deal-counter
224	false to deal-display
225	;
226
227	: init-deal ( type-adr,len -- ) \ initialize counters
228	deal-type-buff /deal-tbuffs erase
229	start-deal /deal-buffs erase
230	deal-type-buff pack drop ( )
231	init-his-counters ( )
232	init-my-counters ( )
233	;
234
235	\ initialization and dealing with device path/alias entered by user.
236	: deal-head ( type-adr,len -- dev-pathadr,len )
237	init-deal ( )
238	\ handle optional devicepath or alias
239	optional-arg-or-/$ ( dev-pathadr,len )
240	?expand-alias ( dev-pathadr,len )
241	\ save initial path in a buffer for later use with deal-find.
242	2dup start-deal pack drop ( dev-pathadr,len )
243	;
244
245	\ main routine which calls preorder search on device tree
246	: deal-find ( dev-pathadr,len acf -- )
247	-rot find-device ( acf )
248	( acf ) ['] (search-preorder) catch 2drop
249	device-end
250	;
251
252	\ for confirming user's selection (redisplay of the selected device path)
253	: show-sel ( -- )
254	my-deal-counter
255	( ascii q ascii a - ) h# 10 <> if
256	init-his-counters ( )
257	\ start with the same device path/alias as user entered
258	start-deal count ( dev-pathadr,len )
259	['] sel-only-my deal-find
260	then
261	;
262
263	\ main high level routine to find all devices of a given type.
264	\ stack input is counted string for that device type
265	: deal-devs ( type-adr,len -- )
266	current-device >r
267	\ init and handle optional input
268	deal-head ( dev-pathadr,len )
269	['] sel-devs deal-find
270	\ in case we never made a choice
271	begin
272	deal-unchosen? deal-cycle deal-counter or and
273	while
274	false to more-poss?
275	deal-menu
276	false to deal-display
277	repeat
278	\ after a valid selection by user, redisplay user's selection
279	show-sel
280	r> push-device
281	;
282
283	headers
284	: show-disks ( -- ) " block" deal-devs ;
285	: show-ttys ( -- ) " serial" deal-devs ;
286	: show-hier ( -- ) " hierarchical" deal-devs ;
287	: show-nets ( -- ) " network" deal-devs ;
288	: show-tapes ( -- ) " byte" deal-devs ;
289	: show-displays ( -- ) " display" deal-devs ;