/red/runtime/allocator.reds

  1Red/System [
  2	Title:   "Red memory allocator"
  3	Author:  "Nenad Rakocevic"
  4	File: 	 %allocator.reds
  5	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
  6	License: {
  7		Distributed under the Boost Software License, Version 1.0.
  8		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
  9	}
 10]
 11
 12;-- New built-in natives worth adding to Red/System??
 13; get-bit n value
 14; set-bit n value
 15; clear-bit n value
 16; bit-set? n value
 17
 18;-- cell header bits layout --
 19;   31:		mark							;-- mark as referenced for the GC (mark phase)
 20;   30:		lock							;-- lock slot for active thread access only
 21;   29:		immutable						;-- mark as read-only (series only)
 22;   28:		new-line						;-- new-line (LF) marker (before the slot)
 23;   27:		big								;-- indicates a big series (big-frame!)
 24;	26:		stack							;-- series buffer is allocated on stack (series only)
 25;   25:		permanent						;-- protected from GC (system-critical series)
 26;   25-8:	<reserved>
 27;   7-0:	datatype ID						;-- datatype number
 28
 29#define _128KB				131072			; @@ create a dedicated datatype?
 30#define _2MB				2097152
 31#define _16MB				16777216
 32#define nodes-per-frame		5000
 33#define node-frame-size		[((nodes-per-frame * 2 * size? pointer!) + size? node-frame!)]
 34
 35#define series-in-use		80000000h		;-- mark a series as used (not collectable by the GC)
 36#define flag-series-big		40000000h		;-- 1 = big, 0 = series
 37#define flag-ins-head		10000000h		;-- optimize for head insertions
 38#define flag-ins-tail		20000000h		;-- optimize for tail insertions
 39#define flag-ins-both		30000000h		;-- optimize for both head & tail insertions
 40#define s-size-mask			00FFFFFFh		;-- mask for 24-bit size field
 41	
 42int-array!: alias struct! [ptr [int-ptr!]]
 43
 44cell!: alias struct! [
 45	header	[integer!]						;-- cell's header flags
 46	data1	[integer!]						;-- placeholders to make a 128-bit cell
 47	data2	[integer!]
 48	data3	[integer!]
 49]
 50
 51series-buffer!: alias struct! [
 52	size	[integer!]						;-- bitfield (see below)
 53	node	[int-ptr!]						;-- point back to referring node
 54	head	[integer!]						;-- series buffer head index
 55	tail	[integer!]						;-- series buffer tail index 
 56]
 57;; size bitfield:
 58;; 31: 		used (1 = used, 0 = free)
 59;; 30: 		type (always 0 for series-buffer!)
 60;; 29-28: 	insert-opt (2 = head, 1 = tail, 0 = both)
 61;; 27-24: 	reserved
 62;; 23-0: 	size of allocated buffer
 63
 64series-frame!: alias struct! [				;-- series frame header
 65	next	[series-frame!]					;-- next frame or null
 66	prev	[series-frame!]					;-- previous frame or null
 67	heap	[series-buffer!]				;-- point to allocatable region
 68	tail	[byte-ptr!]						;-- point to last byte in allocatable region
 69]
 70
 71node-frame!: alias struct! [				;-- node frame header
 72	next	[node-frame!]					;-- next frame or null
 73	prev	[node-frame!]					;-- previous frame or null
 74	nodes	[integer!]						;-- number of nodes
 75	bottom	[int-ptr!]						;-- bottom of stack (last entry, fixed)
 76	top		[int-ptr!]						;-- top of stack (first entry, moving)
 77]
 78
 79big-frame!: alias struct! [					;-- big frame header (for >= 2MB series)
 80	flags	[integer!]						;-- bit 30: 1 (type = big)
 81	next	[big-frame!]					;-- next frame or null
 82	size	[integer!]						;-- size (up to 4GB - size? header)
 83	padding [integer!]						;-- make this header same size as series-buffer! header
 84]
 85
 86memory: declare struct! [					; TBD: instanciate this structure per OS thread
 87	total	 [integer!]						;-- total memory size allocated (in bytes)
 88	n-head	 [node-frame!]					;-- head of node frames list
 89	n-active [node-frame!]					;-- actively used node frame
 90	n-tail	 [node-frame!]					;-- tail of node frames list
 91	s-head	 [series-frame!]				;-- head of series frames list
 92	s-active [series-frame!]				;-- actively used series frame
 93	s-tail	 [series-frame!]				;-- tail of series frames list
 94	s-start	 [integer!]						;-- start size for new series frame		(1)
 95	s-size	 [integer!]						;-- current size for new series frame	(1)
 96	s-max	 [integer!]						;-- max size for new series frames		(1)
 97	b-head	 [big-frame!]					;-- head of big frames list
 98]
 99
100memory/total: 	0
101memory/s-start: _128KB
102memory/s-max: 	_2MB
103memory/s-size: 	memory/s-start
104;; (1) Series frames size will grow from 128KB up to 2MB (arbitrary selected). This
105;; range will need fine-tuning with real Red apps. This growing size, with low starting value
106;; will allow small apps to not consume much memory while avoiding to penalize big apps.
107
108
109;-------------------------------------------
110;-- Allocate paged virtual memory region
111;-------------------------------------------
112allocate-virtual: func [
113	size 	[integer!]						;-- allocated size in bytes (page size multiple)
114	exec? 	[logic!]						;-- TRUE => executable region
115	return: [int-ptr!]						;-- allocated memory region pointer
116	/local ptr
117][
118	size: round-to size + 4	OS-page-size	;-- account for header (one word)
119	memory/total: memory/total + size
120	ptr: OS-allocate-virtual size exec?
121	ptr/value: size							;-- store size in header
122	ptr + 1									;-- return pointer after header
123]
124
125;-------------------------------------------
126;-- Free paged virtual memory region from OS
127;-------------------------------------------
128free-virtual: func [
129	ptr [int-ptr!]							;-- address of memory region to release
130][
131	ptr: ptr - 1							;-- return back to header
132	memory/total: memory/total - ptr/value
133	OS-free-virtual ptr
134]
135
136;-------------------------------------------
137;-- Free all frames (part of Red's global exit handler)
138;-------------------------------------------
139free-all: func [
140	/local n-frame s-frame b-frame n-next s-next b-next
141][
142	n-frame: memory/n-head
143	while [n-frame <> null][
144		n-next: n-frame/next
145		free-virtual as int-ptr! n-frame
146		n-frame: n-next
147	]
148	
149	s-frame: memory/s-head
150	while [s-frame <> null][
151		s-next: s-frame/next
152		free-virtual as int-ptr! s-frame
153		s-frame: s-next
154	]
155
156	b-frame: memory/b-head
157	while [b-frame <> null][
158		b-next: b-frame/next
159		free-virtual as int-ptr! b-frame
160		b-frame: b-next
161	]
162]
163
164;-------------------------------------------
165;-- Format the node frame stack by filling it with pointers to all nodes
166;-------------------------------------------
167format-node-stack: func [
168	frame [node-frame!]						;-- node frame to format
169	/local node ptr
170][
171	ptr: frame/bottom						;-- point to bottom of stack
172	node: ptr + frame/nodes					;-- first free node address
173	until [
174		ptr/value: as-integer node			;-- store free node address on stack
175		node: node + 1
176		ptr: ptr + 1
177		ptr > frame/top						;-- until the stack is filled up
178	]
179]
180
181;-------------------------------------------
182;-- Allocate a node frame buffer and initialize it
183;-------------------------------------------
184alloc-node-frame: func [
185	size 	[integer!]						;-- nb of nodes
186	return:	[node-frame!]					;-- newly initialized frame
187	/local sz frame
188][
189	assert positive? size
190	sz: size * 2 * (size? pointer!) + (size? node-frame!) ;-- total required size for a node frame
191	frame: as node-frame! allocate-virtual sz no ;-- R/W only
192
193	frame/prev:  null
194	frame/next:  null
195	frame/nodes: size
196
197	frame/bottom: as int-ptr! (as byte-ptr! frame) + size? node-frame!
198	frame/top: frame/bottom + size - 1		;-- point to the top element
199	
200	either null? memory/n-head [
201		memory/n-head: frame				;-- first item in the list
202		memory/n-tail: frame
203		memory/n-active: frame
204	][
205		memory/n-tail/next: frame			;-- append new item at tail of the list
206		frame/prev: memory/n-tail			;-- link back to previous tail
207		memory/n-tail: frame				;-- now tail is the new item
208	]
209	
210	format-node-stack frame					;-- prepare the node frame for use
211	frame
212]
213
214;-------------------------------------------
215;-- Release a node frame buffer
216;-------------------------------------------
217free-node-frame: func [
218	frame [node-frame!]						;-- frame to release
219][
220	either null? frame/prev [				;-- if frame = head
221		memory/n-head: frame/next			;-- head now points to next one
222	][
223		either null? frame/next [			;-- if frame = tail
224			memory/n-tail: frame/prev		;-- tail is now at one position back
225		][
226			frame/prev/next: frame/next		;-- link preceding frame to next frame
227			frame/next/prev: frame/prev		;-- link back next frame to preceding frame
228		]
229	]
230	if memory/n-active = frame [
231		memory/n-active: memory/n-tail		;-- reset active frame to last one @@
232	]
233
234	assert not all [						;-- ensure that list is not empty
235		null? memory/n-head
236		null? memory/n-tail
237	]
238	
239	free-virtual as int-ptr! frame			;-- release the memory to the OS
240]
241
242;-------------------------------------------
243;-- Obtain a free node from a node frame
244;-------------------------------------------
245alloc-node: func [
246	return: [int-ptr!]						;-- return a free node pointer
247	/local frame node
248][
249	frame: memory/n-active					;-- take node from active node frame
250	node: as int-ptr! frame/top/value		;-- pop free node address from stack
251	frame/top: frame/top - 1
252	
253	if frame/top = frame/bottom [
254		; TBD: trigger a "light" GC pass from here and update memory/n-active
255		frame: alloc-node-frame nodes-per-frame	;-- allocate a new frame
256		memory/n-active: frame				;@@ to be removed once GC implemented
257		node: as int-ptr! frame/top/value	;-- pop free node address from stack
258		frame/top: frame/top - 1
259	]
260	node
261]
262
263;-------------------------------------------
264;-- Release a used node
265;-------------------------------------------
266free-node: func [
267	node [int-ptr!]							;-- node to release
268	/local frame offset
269][
270	assert not null? node
271	
272	frame: memory/n-active
273	offset: as-integer node - frame
274	
275	unless all [
276		positive? offset					;-- check if node address is part of active frame
277		offset < node-frame-size
278	][										;@@ following code not be needed if freed only by the GC...								
279		frame: memory/n-head				;-- search for right frame from head of the list
280		while [								; @@ could be optimized by searching backward/forward from active frame
281			offset: as-integer node - frame
282			not all [						;-- test if node address is part of that frame
283				positive? offset
284				offset < node-frame-size	; @@ check upper bound case
285			]
286		][
287			frame: frame/next
288			assert frame <> null			;-- should found the right one before the list end
289		]
290	]
291	
292	frame/top: frame/top + 1				;-- free node by pushing its address on stack
293	frame/top/value: as-integer node
294
295	assert frame/top < (frame/bottom + frame/nodes)	;-- top should not overflow
296]
297
298;-------------------------------------------
299;-- Allocate a series frame buffer
300;-------------------------------------------
301alloc-series-frame: func [
302	return:	[series-frame!]					;-- newly initialized frame
303	/local size frame
304][
305	size: memory/s-size
306	if size < memory/s-max [memory/s-size: size * 2]
307	
308	size: size + size? series-frame! 		;-- total required size for a series frame
309	frame: as series-frame! allocate-virtual size no ;-- R/W only
310	
311	either null? memory/s-head [
312		memory/s-head: frame				;-- first item in the list
313		memory/s-tail: frame
314		memory/s-active: frame
315		frame/prev:  null
316	][
317		memory/s-tail/next: frame			;-- append new item at tail of the list
318		frame/prev: memory/s-tail			;-- link back to previous tail
319		memory/s-tail: frame				;-- now tail is the new item
320	]
321	
322	frame/next: null
323	frame/heap: as series-buffer! (as byte-ptr! frame) + size? series-frame!
324	frame/tail: (as byte-ptr! frame) + size	;-- point to last byte in frame
325	frame
326]
327
328;-------------------------------------------
329;-- Release a series frame buffer
330;-------------------------------------------
331free-series-frame: func [
332	frame [series-frame!]					;-- frame to release
333][
334	either null? frame/prev [				;-- if frame = head
335		memory/s-head: frame/next			;-- head now points to next one
336	][
337		either null? frame/next [			;-- if frame = tail
338			memory/s-tail: frame/prev		;-- tail is now at one position back
339		][
340			frame/prev/next: frame/next		;-- link preceding frame to next frame
341			frame/next/prev: frame/prev		;-- link back next frame to preceding frame
342		]
343	]
344	if memory/s-active = frame [
345		memory/s-active: memory/s-tail		;-- reset active frame to last one @@
346	]
347
348	assert not all [						;-- ensure that list is not empty
349		null? memory/s-head
350		null? memory/s-tail
351	]
352	
353	free-virtual as int-ptr! frame			;-- release the memory to the OS
354]
355
356;-------------------------------------------
357;-- Update node back-reference from moved series buffers
358;-------------------------------------------
359update-series-nodes: func [
360	series	[series-buffer!]				;-- start of series region with nodes to re-sync
361][
362	until [
363		;-- update the node pointer to the new series address
364		series/node/value: as-integer (as byte-ptr! series) + size? series-buffer!
365		
366		;-- advance to the next series buffer
367		series: as series-buffer! (as byte-ptr! series) + (series/size and s-size-mask)
368		
369		;-- exit when a freed series is met (<=> end of region)
370		zero? (series/size and series-in-use)
371	]
372]
373
374;-------------------------------------------
375;-- Compact a series frame by moving down in-use series buffer regions
376;-------------------------------------------
377#define SM1_INIT		1					;-- enter the state machine
378#define SM1_HOLE		2					;-- begin of contiguous region of freed buffers (hole)
379#define SM1_HOLE_END	3					;-- end of freed buffers region 
380#define SM1_USED		4					;-- begin of contiguous region of buffers in use
381#define SM1_USED_END	5					;-- end of used buffers region 
382
383compact-series-frame: func [
384	frame [series-frame!]					;-- series frame to compact
385	/local heap series state
386		free? [logic!] src [byte-ptr!] dst [byte-ptr!]
387][
388	series: as series-buffer! (as byte-ptr! frame) + size? series-frame! ;-- point to first series buffer
389	free?: zero? (series/size and series-in-use)  ;-- true: series is not used
390	heap: frame/heap
391		
392	src: null								;-- src will point to start of buffer region to move down
393	dst: null								;-- dst will point to start of free region
394	state: SM1_INIT
395
396	until [
397		if all [state = SM1_INIT free?][
398			dst: as byte-ptr! series		 ;-- start of "hole" region
399			state: SM1_HOLE
400		]
401		if all [state = SM1_HOLE not free?][ ;-- search for first used series (<=> end of hole)
402			state: SM1_HOLE_END
403		]
404		if state = SM1_HOLE_END [
405			src: as byte-ptr! series		 ;-- start of new "alive" region
406			state: SM1_USED
407		]
408	 	;-- point to next series buffer
409		series: as series-buffer! (as byte-ptr! series) + (series/size and s-size-mask)
410		free?: zero? (series/size and series-in-use)  ;-- true: series is not used
411
412		if all [state = SM1_USED any [free? series >= heap]][	;-- handle both normal and "exit" states
413			state: SM1_USED_END
414		]
415		if state = SM1_USED_END [
416			assert dst < src				 ;-- regions are moved down in memory
417			assert src < as byte-ptr! series ;-- src should point at least at series - series/size
418			copy-memory dst	src as-integer series - src
419			update-series-nodes as series-buffer! dst
420			dst: dst + (as-integer series - src) ;-- points after moved region (ready for next move)
421			state: SM1_HOLE
422		]
423		series >= heap						;-- exit state machine
424	]
425	
426	unless null? dst [						;-- no compaction occurred, all series were in use
427		frame/heap: as series-buffer! dst	;-- set new heap after last moved region
428	]
429]
430
431;-------------------------------------------
432;-- Allocate a series from the active series frame, return the series
433;-------------------------------------------
434alloc-series-buffer: func [
435	size	[integer!]						;-- size in bytes
436	return: [series-buffer!]				;-- return the new series buffer
437	/local series frame sz
438][
439	assert positive? size					;-- size is not zero or negative
440	size: round-to size 16					;-- size is a multiple of 16 (one cell! size)
441	
442	frame: memory/s-active
443	sz: size + size? series-buffer!			;-- add series header size
444
445	;-- size should not be greater than the frame capacity
446	assert sz < as-integer (frame/tail - ((as byte-ptr! frame) + size? series-frame!))
447
448	series: frame/heap
449	if ((as byte-ptr! series) + sz) >= frame/tail [
450		; TBD: trigger a GC pass from here and update memory/s-active
451		frame: alloc-series-frame
452		memory/s-active: frame				;@@ to be removed once GC implemented
453		series: frame/heap
454	]
455	
456	assert sz < _16MB						;-- max series size allowed in a series frame
457	
458	frame/heap: as series-buffer! (as byte-ptr! frame/heap) + sz
459
460	series/size: sz 
461		or series-in-use 					;-- mark series as in-use
462		or flag-ins-both					;-- optimize for both head & tail insertions (default)
463		and not flag-series-big				;-- set type bit to 0 (= series)
464		
465	series/head: size / 2					;-- position empty series at middle of buffer
466	series/tail: series/head
467	series
468]
469
470;-------------------------------------------
471;-- Allocate a node and a series from the active series frame, return the node
472;-------------------------------------------
473alloc-series: func [
474	size	[integer!]						;-- size in multiple of 16 bytes (cell! size)
475	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
476	/local series node
477][
478	series: alloc-series-buffer size
479	node: alloc-node						;-- get a new node
480	series/node: node						;-- link back series to node
481	;-- make node points to first usable byte of series buffer
482	node/value: as-integer (as byte-ptr! series) + size? series-buffer!
483	node									;-- return the node pointer
484]
485
486;-------------------------------------------
487;-- Release a series
488;-------------------------------------------
489free-series: func [
490	frame	[series-frame!]					;-- frame containing the series (should be provided by the GC)
491	node	[int-ptr!]						;-- series' node pointer
492	/local series
493][
494	assert not null? frame
495	assert not null? node
496	
497	series: as series-buffer! ((as byte-ptr! node/value) - size? series-buffer!) ;-- point back to series header
498	
499	assert not zero? (series/size and not series-in-use) ;-- ensure that 'used bit is set
500	series/size: series/size xor series-in-use	;-- clear 'used bit (enough to free the series)
501	
502	if frame/heap = as series-buffer! (		;-- test if series is on top of heap
503		(as byte-ptr! node/value) +  (series/size and s-size-mask)
504	) [
505		frame/heap = series					;-- cheap collecting of last allocated series
506	]
507	
508	free-node node
509]
510
511;-------------------------------------------
512;-- Expand a series to a new size
513;-------------------------------------------
514expand-series: func [
515	series  [series-buffer!]				;-- series to expand
516	new-sz	[integer!]						;-- new size
517	return: [series-buffer!]				;-- return new series with new size
518	/local new
519][
520	assert not null? series
521	assert new-sz > (series/size and s-size-mask)  ;-- ensure requested size is bigger than current one
522	
523	new: alloc-series-buffer new-sz
524	series/node/value: as-integer new		;-- link node to new series buffer
525	
526	;TBD: honor flag-ins-head and flag-ins-tail when copying!
527	
528	copy-memory 							;-- copy old series in new buffer (including header)
529		as byte-ptr! new
530		as byte-ptr! series
531		series/size + size? series-buffer!
532	
533	assert not zero? (series/size and not series-in-use) ;-- ensure that 'used bit is set
534	series/size: series/size xor series-in-use	;-- clear 'used bit (enough to free the series)
535	new	
536]
537
538;-------------------------------------------
539;-- Shrink a series to a smaller size (not needed for now)
540;-------------------------------------------
541;shrink-series: func [
542;	series  [series-buffer!]
543;	return: [series-buffer!]
544;][
545;
546;]
547
548
549;-------------------------------------------
550;-- Allocate a big series
551;-------------------------------------------
552alloc-big: func [
553	size [integer!]							;-- buffer size to allocate (in bytes)
554	return: [byte-ptr!]						;-- return allocated buffer pointer
555	/local sz frame frm
556][
557	assert positive? size
558	assert size >= _2MB						;-- should be bigger than a series frame
559	
560	sz: size + size? big-frame! 			;-- total required size for a big frame
561	frame: as big-frame! allocate-virtual sz no ;-- R/W only
562
563	frame/next: null
564	frame/size: size
565	
566	either null? memory/b-head [
567		memory/b-head: frame				;-- first item in the list
568	][
569		frm: memory/b-head					;-- search for tail of list (@@ might want to save it?)
570		until [frm: frm/next null? frm/next]
571		assert not null? frm		
572		
573		frm/next: frame						;-- append new item at tail of the list
574	]
575	
576	(as byte-ptr! frame) + size? big-frame!	;-- return a pointer to the requested buffer
577]
578
579;-------------------------------------------
580;-- Release a big series 
581;-------------------------------------------
582free-big: func [
583	buffer	[byte-ptr!]						;-- big buffer to release
584	/local frame frm
585][
586	assert not null? buffer
587	
588	frame: as big-frame! (buffer - size? big-frame!)  ;-- point to frame header
589	
590	either frame = memory/b-head [
591		memory/b-head: null
592	][
593		frm: memory/b-head					;-- search for frame position in list
594		while [frm/next <> frame][			;-- frm should point to one item behind frame on exit
595			frm: frm/next
596			assert not null? frm			;-- ensure tail of list is not passed
597		]
598		frm/next: frame/next				;-- remove frame from list
599	]
600	
601	free-virtual as int-ptr! frame			;-- release the memory to the OS
602]
603
604
605;===========================================
606;== Debugging functions
607;===========================================
608
609#if debug? = yes [
610
611	;-------------------------------------------
612	;-- Print usage stats about a given frame
613	;-------------------------------------------
614	frame-stats: func [
615		free	[integer!]
616		used	[integer!]
617		total	[integer!]
618		/local percent
619	][
620		assert free + used = total
621		percent: 100 * used / total
622		if all [not zero? used zero? percent][percent: 1]
623
624		print [
625			"used = " used "/" total " ("  percent "%), "
626			"free = " free "/" total " (" 100 - percent "%)" lf
627		]
628	]
629	
630		
631	;-------------------------------------------
632	;-- List series buffer allocated in a given series frame
633	;-------------------------------------------
634	list-series-buffers: func [
635		frame	[series-frame!]
636		/local series alt? size block count
637	][
638		count: 1
639		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!
640		until [
641			print [
642				" - series #" count 
643				": size = "	(series/size and s-size-mask) - size? series-buffer!
644				", offset pos = " series/head ", tail pos = " series/tail
645				"    "
646			]
647			if series/size and flag-ins-head <> 0 [print "H"]
648			if series/size and flag-ins-tail <> 0 [print "T"]
649			print lf
650			count: count + 1
651
652			series: as series-buffer! (as byte-ptr! series) + (series/size and s-size-mask)			
653			series >= frame/heap
654		]
655		assert series = frame/heap
656	]
657	
658	;-------------------------------------------
659	;-- Displays total frames count
660	;-------------------------------------------
661	print-frames-count: func [count [integer!] /local s][
662		s: either count > 1 ["s^/"][newline]
663		print ["^/    " count " frame" s lf]
664	]
665
666	;-------------------------------------------
667	;-- Dump memory statistics on screen
668	;-------------------------------------------
669	memory-stats: func [
670		verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
671		/local count n-frame s-frame b-frame free-nodes base
672	][
673		assert all [1 <= verbose verbose <= 3]
674		
675		print [lf "====== Red Memory Stats ======" lf]
676
677	;-- Node frames stats --
678		count: 0
679		n-frame: memory/n-head
680		
681		print [lf "-- Node frames --" lf]
682		while [n-frame <> null][
683			if verbose >= 2 [
684				print ["#" count + 1 ": "]
685				free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
686				frame-stats 
687					free-nodes
688					n-frame/nodes - free-nodes
689					n-frame/nodes
690			]
691			count: count + 1
692			n-frame: n-frame/next
693		]
694		print-frames-count count
695		
696	;-- Series frames stats --
697		count: 0
698		s-frame: memory/s-head
699
700		print ["-- Series frames --" lf]
701		while [s-frame <> null][
702			if verbose >= 2 [
703				print ["#" count + 1 ": "]
704				base: (as byte-ptr! s-frame) + size? series-frame!
705				frame-stats
706					as-integer s-frame/tail - as byte-ptr! s-frame/heap
707					as-integer (as byte-ptr! s-frame/heap) - base
708					as-integer s-frame/tail - base
709				if verbose >= 3 [
710					list-series-buffers s-frame
711				]
712			]
713			count: count + 1
714			s-frame: s-frame/next
715		]
716		print-frames-count count
717		
718	;-- Big frames stats --
719		count: 0
720		b-frame: memory/b-head
721
722		print ["-- Big frames --" lf]
723		while [b-frame <> null][
724			if verbose >= 2 [
725				print ["#" count + 1 ": "]
726				prin-int b-frame/size
727			]
728			count: count + 1
729			b-frame: b-frame/next
730		]
731		print-frames-count count
732		
733		print [
734			"Total memory used: " memory/total " bytes" lf
735			"==============================" lf
736		]
737	]
738	
739	;-------------------------------------------
740	;-- Dump memory layout of a given series frame
741	;-------------------------------------------
742	dump-series-frame: func [
743		frame	[series-frame!]
744		/local series alt? size block
745	][
746		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!
747		
748		print [lf "=== Series layout for frame: <" frame "h>" lf]
749		
750		alt?: no
751		until [
752			block: either zero? (series/size and series-in-use) [
753				"."
754			][
755				alt?: not alt?
756				either alt? ["x"]["o"]
757			]
758			
759			size: ((series/size and s-size-mask) - size? series-buffer!) / 16
760			until [
761				print block
762				size: size - 1
763				zero? size
764			]
765			
766			series: as series-buffer! (as byte-ptr! series) + (series/size and s-size-mask)			
767			series >= frame/heap
768		]
769		assert series = frame/heap
770		print lf
771	]
772	
773]