[OpenSPARC-T2-SAM] / obp / obp / fm / lib / cirstack.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: cirstack.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: @(#)cirstack.fth 1.6 03/12/08 13:22:21
purpose: 
copyright: Copyright 1990-2003 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ Circular stack defining words
\
\     Examples:
\ 10 circular-stack: foo    Create a new stack named  foo 
\				with space for 10 numbers
\ 123 foo push        Push the number 123 on the stack  foo 
\ foo pop             Pop the top element from the stack  foo 
\				onto the data stack
\ foo top@            Copy the top element from the stack  foo 
\				onto the data stack, but do not
\				remove it from the stack  foo 
\
\ Advantages of a circular stack:
\    does not have to be cleared
\    cannot overflow or underflow
\    invocation is easy
\
\ Disadvantages:
\    can silently lose data
\
\ Applications:
\  + Useful for implementing user interfaces where you want to remember
\    a limited amount of "history", such as the last n commands, or the
\    last n directories "visited", but it is not necessary to guarantee
\    unlimited backtracking.
\  + Can easily be adapted, by adding functions  pushc  and  type-circ ,
\    for keeping a history of characters, for such uses as shadowing and
\    logging console output.

\ Implementation notes:
\    The circular stack parameter field is intentionally the same as
\    the parameter field of a word defined by  buffer: .  This allows
\    us to use the  buffer:  mechanism to automatically allocate the
\    necessary storage space.
\
\    The parameter field elements are located and sized as follows:
\        pfa:		  user#		(  /user# , which is either  /l )
\  					(     or, in the \t16 model, /w )
\        pfa+/user#:	  buffer-size	( might be /n, which was /l in  )
\					( the 32-bit model, but might.  )
\					( with the introduction of the  )
\					( 64-bit model, have become /x  )
\					( because the code remained /n. )
\					( Or it might explicitly be /l, )
\					( which is plenty large enough. )
\  					( Holds the size of the data    )
\  					( area plus one cell.           )
\        pfa+/user#+/n:	  buffer-link	(  /a , which is either   /l    )
\  					(  or, in the \t16 model, /w    )
\
\    As with a   buffer: ,  user#  is the offset of a user area location
\    containing the address of an allocated memory buffer that contains
\    the circular stack data structure.
\
\    The circular stack data structure consists of the following elements:
\        current      Offset into stack data of the next element to pop,
\		      which is equivalent to the last element that was pushed;
\		      occupies one cell at the start of the structure.
\		      (Note:  Although /l would be sufficient for this, we
\		      allocate a cell to keep the data area cell-aligned.)
\        stack data   Space to store the stacked numbers.  It occupies the
\		      remainder of the structure.
\    The "limit", i.e., the size of the stack data area, is obtained
\    from the  buffer-size  minus one cell.
\
\    Invoking the circular stack by name returns one item on the stack,
\    the Parameter Field Address, referred to as  stack-pfa  in stack
\    diagrams.
\
\    Every operator that acts on a  stack-pfa  needs to convert it
\    to three items:  the buffer-address, the limit, and the current
\    pointer; that's done via the  cir-stack-params  function.  That
\    step could have been put into a  does>  clause of the defining
\    word, but it was felt that doing so would create an unwieldy
\    programming interface.

headerless
\ Implementation factors:
\
\  Common arrangement of necessary params
: cir-stack-params ( stack-pfa -- buff-adr limit current )
   dup /buffer		( stack-pfa size )
   /n - swap		( limit stack-pfa )
   do-buffer		( limit buff-adr )
   tuck @		( buff-adr limit current )
;
\
\  Store adjusted "current" offset.
\  Return addresses of both the old and the new "current" items.
: cir-stack-ptr! ( buff-adr old-current new-current -- ... )
					( ... -- old-item-adr new-item-adr )
   rot 2dup !		( old new buff-adr )	\  Store adjusted "current"
   na1+ 		( old new data-adr )	\  Bump to data-area
   dup d+ 		( old-item-ptr new-item-ptr )
;
headers

\ Create a new circular-stack;
\ when executed, it will return its PFA.
: circular-stack: ( #entries -- )  \ name
   1+ /n*			( size )
   create make-buffer
;

\ Add a number to the stack
: push  ( n stack-pfa -- )
   cir-stack-params		( n buff-adr limit current )
   dup na1+			( n buff-adr limit current next? )
   \  Adjust overflow of incremented "current"
   rot over = if drop 0 then	( n buff-adr current next )
   cir-stack-ptr!		( n old-item-adr new-item-adr )
   \  Store into "new" item address
   nip !
;
 
\ Remove a number from the stack
: pop  ( stack-pfa -- n )
   cir-stack-params		( buff-adr limit current )
   \  Adjust imminent underflow of "current", then decrement
   tuck				( buff-adr current limit current )
   if drop dup then /n -	( buff-adr current next ) 
   cir-stack-ptr!		( old-item-adr new-item-adr )
   \  Fetch from "current" (now "old") item address
   drop @
;

\ Return, without popping, the number on top of the stack
: top@  ( stack-pfa -- n )
   cir-stack-params		( buff-adr limit current )
   \  Fetch from "current" item address.  Bump to data-area
   nip na1+ +  @
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: cirstack.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: @(#)cirstack.fth 1.6 03/12/08 13:22:21
	43	purpose:
	44	copyright: Copyright 1990-2003 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ Circular stack defining words
	48	\
	49	\ Examples:
	50	\ 10 circular-stack: foo Create a new stack named foo
	51	\ with space for 10 numbers
	52	\ 123 foo push Push the number 123 on the stack foo
	53	\ foo pop Pop the top element from the stack foo
	54	\ onto the data stack
	55	\ foo top@ Copy the top element from the stack foo
	56	\ onto the data stack, but do not
	57	\ remove it from the stack foo
	58	\
	59	\ Advantages of a circular stack:
	60	\ does not have to be cleared
	61	\ cannot overflow or underflow
	62	\ invocation is easy
	63	\
	64	\ Disadvantages:
65	\ can silently lose data
66	\
67	\ Applications:
68	\ + Useful for implementing user interfaces where you want to remember
69	\ a limited amount of "history", such as the last n commands, or the
70	\ last n directories "visited", but it is not necessary to guarantee
71	\ unlimited backtracking.
72	\ + Can easily be adapted, by adding functions pushc and type-circ ,
73	\ for keeping a history of characters, for such uses as shadowing and
74	\ logging console output.
75
76	\ Implementation notes:
77	\ The circular stack parameter field is intentionally the same as
78	\ the parameter field of a word defined by buffer: . This allows
79	\ us to use the buffer: mechanism to automatically allocate the
80	\ necessary storage space.
81	\
82	\ The parameter field elements are located and sized as follows:
83	\ pfa: user# ( /user# , which is either /l )
84	\ ( or, in the \t16 model, /w )
85	\ pfa+/user#: buffer-size ( might be /n, which was /l in )
86	\ ( the 32-bit model, but might. )
87	\ ( with the introduction of the )
88	\ ( 64-bit model, have become /x )
89	\ ( because the code remained /n. )
90	\ ( Or it might explicitly be /l, )
91	\ ( which is plenty large enough. )
92	\ ( Holds the size of the data )
93	\ ( area plus one cell. )
94	\ pfa+/user#+/n: buffer-link ( /a , which is either /l )
95	\ ( or, in the \t16 model, /w )
96	\
97	\ As with a buffer: , user# is the offset of a user area location
98	\ containing the address of an allocated memory buffer that contains
99	\ the circular stack data structure.
100	\
101	\ The circular stack data structure consists of the following elements:
102	\ current Offset into stack data of the next element to pop,
103	\ which is equivalent to the last element that was pushed;
104	\ occupies one cell at the start of the structure.
105	\ (Note: Although /l would be sufficient for this, we
106	\ allocate a cell to keep the data area cell-aligned.)
107	\ stack data Space to store the stacked numbers. It occupies the
108	\ remainder of the structure.
109	\ The "limit", i.e., the size of the stack data area, is obtained
110	\ from the buffer-size minus one cell.
111	\
112	\ Invoking the circular stack by name returns one item on the stack,
113	\ the Parameter Field Address, referred to as stack-pfa in stack
114	\ diagrams.
115	\
116	\ Every operator that acts on a stack-pfa needs to convert it
117	\ to three items: the buffer-address, the limit, and the current
118	\ pointer; that's done via the cir-stack-params function. That
119	\ step could have been put into a does> clause of the defining
120	\ word, but it was felt that doing so would create an unwieldy
121	\ programming interface.
122
123	headerless
124	\ Implementation factors:
125	\
126	\ Common arrangement of necessary params
127	: cir-stack-params ( stack-pfa -- buff-adr limit current )
128	dup /buffer ( stack-pfa size )
129	/n - swap ( limit stack-pfa )
130	do-buffer ( limit buff-adr )
131	tuck @ ( buff-adr limit current )
132	;
133	\
134	\ Store adjusted "current" offset.
135	\ Return addresses of both the old and the new "current" items.
136	: cir-stack-ptr! ( buff-adr old-current new-current -- ... )
137	( ... -- old-item-adr new-item-adr )
138	rot 2dup ! ( old new buff-adr ) \ Store adjusted "current"
139	na1+ ( old new data-adr ) \ Bump to data-area
140	dup d+ ( old-item-ptr new-item-ptr )
141	;
142	headers
143
144	\ Create a new circular-stack;
145	\ when executed, it will return its PFA.
146	: circular-stack: ( #entries -- ) \ name
147	1+ /n* ( size )
148	create make-buffer
149	;
150
151	\ Add a number to the stack
152	: push ( n stack-pfa -- )
153	cir-stack-params ( n buff-adr limit current )
154	dup na1+ ( n buff-adr limit current next? )
155	\ Adjust overflow of incremented "current"
156	rot over = if drop 0 then ( n buff-adr current next )
157	cir-stack-ptr! ( n old-item-adr new-item-adr )
158	\ Store into "new" item address
159	nip !
160	;
161
162	\ Remove a number from the stack
163	: pop ( stack-pfa -- n )
164	cir-stack-params ( buff-adr limit current )
165	\ Adjust imminent underflow of "current", then decrement
166	tuck ( buff-adr current limit current )
167	if drop dup then /n - ( buff-adr current next )
168	cir-stack-ptr! ( old-item-adr new-item-adr )
169	\ Fetch from "current" (now "old") item address
170	drop @
171	;
172
173	\ Return, without popping, the number on top of the stack
174	: top@ ( stack-pfa -- n )
175	cir-stack-params ( buff-adr limit current )
176	\ Fetch from "current" item address. Bump to data-area
177	nip na1+ + @
178	;