[OpenSPARC-T2-SAM] / obp / obp / dev / utilities / memlist.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: memlist.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: @(#)memlist.fth 1.9 06/11/01
purpose: 
copyright: Copyright 2006 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

external
headers

fload ${BP}/dev/utilities/64bit-ops.fth

\ This struct has to be 64-bit aligned
\ since some of the components are 64-bit in size.
struct
   /n field >next-node
   /n +				\ alignment padding
   /x field >mem.adr
   /x field >mem.size
constant /memnode

0 value memlist
0 value prev-node
0 value next-node

\ Some of the functions in this file are called from other places 
\ in pci probe code and are likely to be passed paramerters which 
\ are sign-extended. Hence we need to convert those into unsigned 
\ number until we have a better solution albiet tokenizer fix.
\ Here are the list of functions,
\  - free-memrange
\  - allocate-memrange
\  - set-node
\  - round-node-up
\  - round-node-down
\  - split-node

\
\ This routine expects to be called with a valid node, not a pointer to a node
\
: (find-node)  ( ??? node acf -- ?? prev-node this-node|0 )
   0 >r >r			( ?? this )		( r: 0 acf )
   begin			( ?? this )		( r: prev acf )
      r@ over >r		( ?? this acf )		( r: prev acf this )
      execute			( ?? acf flag )		( r: prev acf this )
      r> swap if		( ?? this )		( r: prev acf )
         r> r>			( ?? this acf prev )	( r: -- )
         nip swap exit		( ?? prev this|0 )	( r: -- )
      else			( ?? this )		( r: prev acf )
         r> r>			( ?? this acf prev )	( r: -- )
         drop			( ?? this acf )		( r: -- )
         swap >r		( ?? acf )		( r: prev )
         r@ >next-node @	( ?? acf this )		( r: prev )
         swap >r		( ?? this )		( r: prev acf )
      then			( ?? this )		( r: prev acf )
   dup 0= until 		( ?? this )		( r: prev acf )
   r> drop			( ?? this )		( r: prev )
   r> swap			( ?? prev this )	( r: -- )
;

: find-node  ( ?? list acf -- ?? )
   >r						( ?? list ) ( r: acf )
   dup to memlist				( ?? ) ( r: acf )
   @ r> (find-node)				( ?? prev this|0 )
   to next-node					( ?? prev )
   to prev-node					( ?? )
;

: delete-after  ( prev-node -- deleted-node )
   dup >next-node @ tuck			( next prev next )
   >next-node @ swap !				( next )
;

: insert-after  ( new-node-adr prev-node-adr -- )
   >next-node					( new &prev->next )
   tuck @					( &prev->next new next )
   over >next-node !				( &prev->next new )
   swap !					( -- )
;


: set-node  ( size adr -- node )
   unsigned-x swap unsigned-x swap
   /memnode alloc-mem				( adr size node )
   dup  >next-node off				( adr size node )
   tuck >mem.adr x!				( node )
   tuck >mem.size x!				( adr node)
;

: free-node ( node --  )  /memnode free-mem ;

: node-range ( node -- adr size )     dup >mem.adr x@  swap >mem.size x@  ;
: prev-start ( -- adr )			prev-node >mem.adr x@  ;
: node-end   ( node -- adr )		node-range +  ;

\ Is 'adr' less that the address in the node?
: lower?  ( adr node -- adr flag )  >mem.adr x@ over x>=  ;


: merged-lower? ( size adr -- [ size adr false ] | true )
   prev-node  if				( size adr )
      dup prev-node node-end x= if		( size adr )
         drop prev-node >mem.size +x!		( -- )
         true exit				( true )
      then					( size adr )
   then						( size adr )
   false					( size adr false )
;

: merged-upper? ( size adr -- [ size adr false ] | true )
   next-node if					( size adr )
      2dup + next-node >mem.adr x@ x= if	( size adr )
         next-node >mem.adr x!			( size -- )
         next-node >mem.size +x!		( -- )
         true exit				( true )
      then					( size adr )
   then						( size adr )
   false					( size adr false )
;

: free-memrange  ( adr size list -- )
   >r unsigned-x swap unsigned-x r>		( size adr list )
   dup @ if					( adr size list )
      ['] lower?  find-node			( -- )
   else						( size adr list )
      -rot set-node swap ! exit			( -- )
   then						( -- )

   \ Error check to catch attempts to free already-free memory.
   next-node if
      2dup swap bounds swap			( size adr lo hi )
      next-node >mem.adr x@ -rot xwithin	( size adr flag )
      if					( size adr flag )
        ." Freeing memory that is already free: " .x .x cr
        abort					( -- )
      then					( -- )
   then						( size adr )

   merged-lower? if					( -- )
      \ We attempted to merge the lower node and it worked
      \ Now we need to check the upper
      prev-node node-range swap			( size adr )
      merged-upper? if				( -- )
         \ We merged upper and lower addresses.
         next-node >mem.size x@ prev-node >mem.size x!
         prev-node delete-after			( node )
         free-node				( -- )
      else					( size adr )
         2drop					( -- )
      then					( -- )
      exit					( -- )
   else						( size adr )
      merged-upper? if				( -- )
         exit					( -- )
      then					( -- )      
   then						( size adr )

   set-node					( node )
   prev-node if					( -- )
      prev-node insert-after			( -- )
   else						( node )
      next-node over >next-node !		( -- )
      memlist !					( -- )
   then
;

: round-node-up ( node align memlist  -- )
   swap unsigned-x swap				( node align memlist )
   to memlist >r				( node )
   dup >mem.adr x@ dup r> round-up		( node mem mem1 )
   2dup x<> if					( node mem mem1 )
      tuck					( node mem1 mem mem1 )
      over -					( node mem1 mem diff )
      tuck memlist free-memrange		( node mem1 diff )
      >r 					( node mem1 )
      over >mem.adr x!				( node )
      r> negate swap >mem.size +x!		( -- )
   else						( node mem mem1 )
      3drop					( -- )
   then						( -- )
;

: round-node-down ( node align memlist -- )
   swap unsigned-x swap				( node align memlist )
   to memlist >r				( node )
   dup node-end					( node end )
   dup r> round-down				( node end end' )
   2dup x<> if					( node end end' )
      tuck -					( node end' len )
      tuck					( node len end' len )
      memlist free-memrange			( node len )
      negate swap >mem.size +x!			( -- )
   else						( node end end' )
      3drop					( -- )
   then						( -- )
;

\
\ And now the code to carve holes in the list.
\
: suitable?  ( align size node-adr -- alignment size flag )
   >r r@ >mem.adr x@  2 pick round-up		( align size aligned-adr )
   r> node-range -rot -				( align size node-size waste )
   2dup x<=  if  2drop false  exit  then	( align size node-size waste )
   -						( align size aln-node-size )
   over x>=					( align size flag )
;   

: allocate-memrange  ( alignment size list -- phys-adr false | true )
   rot unsigned-x rot unsigned-x rot		( alignment size list ) 
   dup @ if
      ['] suitable?  find-node			( align size )
   else
      3drop true exit				( true )
   then

   next-node 0=  if  2drop true  exit  then	( aln size )

   \ simple check first..
   \ is this exactly the right size?  
   dup next-node >mem.size x@ x= if		( aln size )
      \ the size matches..
      2drop					( -- )
      prev-node ?dup if				( -- )
         delete-after				( node )
      else					( -- )
         next-node dup >next-node @ memlist !	( adr node )
      then					( adr node )
      dup >mem.adr x@ swap			( adr node )
      free-node					( adr )
      false exit				( -- adr false )
   then

   \ OK we need to snip a node
   swap						( size aln )
   over next-node >mem.size x@ swap - >r	( size aln len' )
   next-node >mem.adr x@ dup >r			( size aln adr )
   over round-up				( size aln adr' )
   dup r> x= if					( size aln adr' )
      \ We can take the space from the front
      \ of the node, leaving the remainder
      r> next-node >mem.size x!			( size aln adr' )
      -rot					( adr size aln )
      drop next-node >mem.adr +x!		( adr )
      false					( adr false )
      exit					( --  adr false )
   then						( size aln adr' )

   \ OK we've exhausted the easy cases
   \ Now we get to create a new node to describe the remainder
   dup next-node >mem.adr x@ -			( size aln adr' diff )
   dup next-node >mem.size x!			( size aln adr' diff )
   \ First node is truncated now.
   rot drop r> swap -				( size adr' diff )
   -rot dup >r +				( diff adr' )
   over x0<> if					( diff adr' )
      set-node next-node insert-after		( -- )
   else						( diff adr' )
      2drop					( -- )
   then						( -- )
   r> false					( adr false )
;


: biggest? ( largest node -- largest flag )
   over if					( largest node )
      over >mem.size x@				( largest node size1 )
      over >mem.size x@ x>= if			( largest node )
         drop					( largest )
      else					( largest node )
         nip					( largest' )
      then					( largest' )
   else						( largest node )
      nip 					( largest false )
   then	 false					( largest flag )
;

: get-biggest-node ( memlist-ptr -- node )
   0 swap					( biggest memlist-ptr )
   dup @ if					( biggest memlist-ptr )
      ['] biggest? find-node			( biggest )
   else						( 0 memlist-ptr )
      drop					( 0 )
   then						( biggest )
;

: last-node? ( node -- flag )  >next-node @ 0= ;

: get-last-node ( memlist-ptr -- prev last )
   dup @ if					( memlist-ptr )
      ['] last-node? find-node			( -- )
      prev-node next-node 			( prev next )
   else						( memlist-ptr )
      drop 0 0					( 0 0 )
   then						( prev last )
;

: found-node? ( want current -- flag ) over = ;

\
\ This doesn't free the selected node, just cuts it from the list.
\
: remove-selected-node ( node memlistptr -- fail? )
   ['] found-node? find-node drop next-node 0= dup if exit then
   prev-node ?dup if
      delete-after drop
   else
      next-node >next-node @ memlist !
   then
   next-node if  0 next-node >next-node !  then
;

\ release all the nodes in this list.
: free-list ( node -- )
   begin					( node )
     dup while					( node )
        dup >next-node @			( node next )
        swap free-node				( node )
   repeat  drop					( -- )
;

\ split node at address
: split-node ( adr node -- prev next )
   swap unsigned-x swap			( adr node )
   2dup node-range over + within if 	( adr node )
      2dup >mem.adr x@ -		( adr node diff )
      over >mem.size x@ over - 		( adr node diff next.len )
      -rot over >mem.size x!		( adr next.len node )
      -rot swap set-node		( node next )
   else
      nip dup 			( node node )
   then
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: memlist.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: @(#)memlist.fth 1.9 06/11/01
	43	purpose:
	44	copyright: Copyright 2006 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	external
	48	headers
	49
	50	fload ${BP}/dev/utilities/64bit-ops.fth
	51
	52	\ This struct has to be 64-bit aligned
	53	\ since some of the components are 64-bit in size.
	54	struct
	55	/n field >next-node
	56	/n + \ alignment padding
	57	/x field >mem.adr
	58	/x field >mem.size
	59	constant /memnode
	60
	61	0 value memlist
	62	0 value prev-node
	63	0 value next-node
	64
65	\ Some of the functions in this file are called from other places
66	\ in pci probe code and are likely to be passed paramerters which
67	\ are sign-extended. Hence we need to convert those into unsigned
68	\ number until we have a better solution albiet tokenizer fix.
69	\ Here are the list of functions,
70	\ - free-memrange
71	\ - allocate-memrange
72	\ - set-node
73	\ - round-node-up
74	\ - round-node-down
75	\ - split-node
76
77	\
78	\ This routine expects to be called with a valid node, not a pointer to a node
79	\
80	: (find-node) ( ??? node acf -- ?? prev-node this-node\|0 )
81	0 >r >r ( ?? this ) ( r: 0 acf )
82	begin ( ?? this ) ( r: prev acf )
83	r@ over >r ( ?? this acf ) ( r: prev acf this )
84	execute ( ?? acf flag ) ( r: prev acf this )
85	r> swap if ( ?? this ) ( r: prev acf )
86	r> r> ( ?? this acf prev ) ( r: -- )
87	nip swap exit ( ?? prev this\|0 ) ( r: -- )
88	else ( ?? this ) ( r: prev acf )
89	r> r> ( ?? this acf prev ) ( r: -- )
90	drop ( ?? this acf ) ( r: -- )
91	swap >r ( ?? acf ) ( r: prev )
92	r@ >next-node @ ( ?? acf this ) ( r: prev )
93	swap >r ( ?? this ) ( r: prev acf )
94	then ( ?? this ) ( r: prev acf )
95	dup 0= until ( ?? this ) ( r: prev acf )
96	r> drop ( ?? this ) ( r: prev )
97	r> swap ( ?? prev this ) ( r: -- )
98	;
99
100	: find-node ( ?? list acf -- ?? )
101	>r ( ?? list ) ( r: acf )
102	dup to memlist ( ?? ) ( r: acf )
103	@ r> (find-node) ( ?? prev this\|0 )
104	to next-node ( ?? prev )
105	to prev-node ( ?? )
106	;
107
108	: delete-after ( prev-node -- deleted-node )
109	dup >next-node @ tuck ( next prev next )
110	>next-node @ swap ! ( next )
111	;
112
113	: insert-after ( new-node-adr prev-node-adr -- )
114	>next-node ( new &prev->next )
115	tuck @ ( &prev->next new next )
116	over >next-node ! ( &prev->next new )
117	swap ! ( -- )
118	;
119
120
121	: set-node ( size adr -- node )
122	unsigned-x swap unsigned-x swap
123	/memnode alloc-mem ( adr size node )
124	dup >next-node off ( adr size node )
125	tuck >mem.adr x! ( node )
126	tuck >mem.size x! ( adr node)
127	;
128
129	: free-node ( node -- ) /memnode free-mem ;
130
131	: node-range ( node -- adr size ) dup >mem.adr x@ swap >mem.size x@ ;
132	: prev-start ( -- adr ) prev-node >mem.adr x@ ;
133	: node-end ( node -- adr ) node-range + ;
134
135	\ Is 'adr' less that the address in the node?
136	: lower? ( adr node -- adr flag ) >mem.adr x@ over x>= ;
137
138
139	: merged-lower? ( size adr -- [ size adr false ] \| true )
140	prev-node if ( size adr )
141	dup prev-node node-end x= if ( size adr )
142	drop prev-node >mem.size +x! ( -- )
143	true exit ( true )
144	then ( size adr )
145	then ( size adr )
146	false ( size adr false )
147	;
148
149	: merged-upper? ( size adr -- [ size adr false ] \| true )
150	next-node if ( size adr )
151	2dup + next-node >mem.adr x@ x= if ( size adr )
152	next-node >mem.adr x! ( size -- )
153	next-node >mem.size +x! ( -- )
154	true exit ( true )
155	then ( size adr )
156	then ( size adr )
157	false ( size adr false )
158	;
159
160	: free-memrange ( adr size list -- )
161	>r unsigned-x swap unsigned-x r> ( size adr list )
162	dup @ if ( adr size list )
163	['] lower? find-node ( -- )
164	else ( size adr list )
165	-rot set-node swap ! exit ( -- )
166	then ( -- )
167
168	\ Error check to catch attempts to free already-free memory.
169	next-node if
170	2dup swap bounds swap ( size adr lo hi )
171	next-node >mem.adr x@ -rot xwithin ( size adr flag )
172	if ( size adr flag )
173	." Freeing memory that is already free: " .x .x cr
174	abort ( -- )
175	then ( -- )
176	then ( size adr )
177
178	merged-lower? if ( -- )
179	\ We attempted to merge the lower node and it worked
180	\ Now we need to check the upper
181	prev-node node-range swap ( size adr )
182	merged-upper? if ( -- )
183	\ We merged upper and lower addresses.
184	next-node >mem.size x@ prev-node >mem.size x!
185	prev-node delete-after ( node )
186	free-node ( -- )
187	else ( size adr )
188	2drop ( -- )
189	then ( -- )
190	exit ( -- )
191	else ( size adr )
192	merged-upper? if ( -- )
193	exit ( -- )
194	then ( -- )
195	then ( size adr )
196
197	set-node ( node )
198	prev-node if ( -- )
199	prev-node insert-after ( -- )
200	else ( node )
201	next-node over >next-node ! ( -- )
202	memlist ! ( -- )
203	then
204	;
205
206	: round-node-up ( node align memlist -- )
207	swap unsigned-x swap ( node align memlist )
208	to memlist >r ( node )
209	dup >mem.adr x@ dup r> round-up ( node mem mem1 )
210	2dup x<> if ( node mem mem1 )
211	tuck ( node mem1 mem mem1 )
212	over - ( node mem1 mem diff )
213	tuck memlist free-memrange ( node mem1 diff )
214	>r ( node mem1 )
215	over >mem.adr x! ( node )
216	r> negate swap >mem.size +x! ( -- )
217	else ( node mem mem1 )
218	3drop ( -- )
219	then ( -- )
220	;
221
222	: round-node-down ( node align memlist -- )
223	swap unsigned-x swap ( node align memlist )
224	to memlist >r ( node )
225	dup node-end ( node end )
226	dup r> round-down ( node end end' )
227	2dup x<> if ( node end end' )
228	tuck - ( node end' len )
229	tuck ( node len end' len )
230	memlist free-memrange ( node len )
231	negate swap >mem.size +x! ( -- )
232	else ( node end end' )
233	3drop ( -- )
234	then ( -- )
235	;
236
237	\
238	\ And now the code to carve holes in the list.
239	\
240	: suitable? ( align size node-adr -- alignment size flag )
241	>r r@ >mem.adr x@ 2 pick round-up ( align size aligned-adr )
242	r> node-range -rot - ( align size node-size waste )
243	2dup x<= if 2drop false exit then ( align size node-size waste )
244	- ( align size aln-node-size )
245	over x>= ( align size flag )
246	;
247
248	: allocate-memrange ( alignment size list -- phys-adr false \| true )
249	rot unsigned-x rot unsigned-x rot ( alignment size list )
250	dup @ if
251	['] suitable? find-node ( align size )
252	else
253	3drop true exit ( true )
254	then
255
256	next-node 0= if 2drop true exit then ( aln size )
257
258	\ simple check first..
259	\ is this exactly the right size?
260	dup next-node >mem.size x@ x= if ( aln size )
261	\ the size matches..
262	2drop ( -- )
263	prev-node ?dup if ( -- )
264	delete-after ( node )
265	else ( -- )
266	next-node dup >next-node @ memlist ! ( adr node )
267	then ( adr node )
268	dup >mem.adr x@ swap ( adr node )
269	free-node ( adr )
270	false exit ( -- adr false )
271	then
272
273	\ OK we need to snip a node
274	swap ( size aln )
275	over next-node >mem.size x@ swap - >r ( size aln len' )
276	next-node >mem.adr x@ dup >r ( size aln adr )
277	over round-up ( size aln adr' )
278	dup r> x= if ( size aln adr' )
279	\ We can take the space from the front
280	\ of the node, leaving the remainder
281	r> next-node >mem.size x! ( size aln adr' )
282	-rot ( adr size aln )
283	drop next-node >mem.adr +x! ( adr )
284	false ( adr false )
285	exit ( -- adr false )
286	then ( size aln adr' )
287
288	\ OK we've exhausted the easy cases
289	\ Now we get to create a new node to describe the remainder
290	dup next-node >mem.adr x@ - ( size aln adr' diff )
291	dup next-node >mem.size x! ( size aln adr' diff )
292	\ First node is truncated now.
293	rot drop r> swap - ( size adr' diff )
294	-rot dup >r + ( diff adr' )
295	over x0<> if ( diff adr' )
296	set-node next-node insert-after ( -- )
297	else ( diff adr' )
298	2drop ( -- )
299	then ( -- )
300	r> false ( adr false )
301	;
302
303
304	: biggest? ( largest node -- largest flag )
305	over if ( largest node )
306	over >mem.size x@ ( largest node size1 )
307	over >mem.size x@ x>= if ( largest node )
308	drop ( largest )
309	else ( largest node )
310	nip ( largest' )
311	then ( largest' )
312	else ( largest node )
313	nip ( largest false )
314	then false ( largest flag )
315	;
316
317	: get-biggest-node ( memlist-ptr -- node )
318	0 swap ( biggest memlist-ptr )
319	dup @ if ( biggest memlist-ptr )
320	['] biggest? find-node ( biggest )
321	else ( 0 memlist-ptr )
322	drop ( 0 )
323	then ( biggest )
324	;
325
326	: last-node? ( node -- flag ) >next-node @ 0= ;
327
328	: get-last-node ( memlist-ptr -- prev last )
329	dup @ if ( memlist-ptr )
330	['] last-node? find-node ( -- )
331	prev-node next-node ( prev next )
332	else ( memlist-ptr )
333	drop 0 0 ( 0 0 )
334	then ( prev last )
335	;
336
337	: found-node? ( want current -- flag ) over = ;
338
339	\
340	\ This doesn't free the selected node, just cuts it from the list.
341	\
342	: remove-selected-node ( node memlistptr -- fail? )
343	['] found-node? find-node drop next-node 0= dup if exit then
344	prev-node ?dup if
345	delete-after drop
346	else
347	next-node >next-node @ memlist !
348	then
349	next-node if 0 next-node >next-node ! then
350	;
351
352	\ release all the nodes in this list.
353	: free-list ( node -- )
354	begin ( node )
355	dup while ( node )
356	dup >next-node @ ( node next )
357	swap free-node ( node )
358	repeat drop ( -- )
359	;
360
361	\ split node at address
362	: split-node ( adr node -- prev next )
363	swap unsigned-x swap ( adr node )
364	2dup node-range over + within if ( adr node )
365	2dup >mem.adr x@ - ( adr node diff )
366	over >mem.size x@ over - ( adr node diff next.len )
367	-rot over >mem.size x! ( adr next.len node )
368	-rot swap set-node ( node next )
369	else
370	nip dup ( node node )
371	then
372	;
373