free nodes

gistfile1.txt

		do-flush: func [								;-- assumes frames-list buffer is built and sorted
			kind	[integer!]							;-- 1: list, 2: reloc-list
			/local
				frm p e n node new [int-ptr!]
				frm-nb w cnt [integer!]
		][
			either kind = 1 [
				n: list
				loop count [
					node: as node! n/value
					if collector/refs <> null [
						new: _hashtable/rs-get collector/refs as-integer node
						if new <> null [
							;probe ["freeing node: " node ", new: " as node! new/value]
							node: as node! new/value
							if node <> null [
								reloc-count: reloc-count + 1
								reloc-list/reloc-count: as-integer node
							]
						]
					]
					n: n + 1
				]
				n: list
				cnt: count
			][
				n: reloc-list
				cnt: reloc-count
			]

			qsort as byte-ptr! n cnt 4 :compare-cb
			p: frames-list/nodes/list
			e: p + frames-list/nodes/count
			w: nodes-per-frame * size? node!			;-- node frame width

			loop cnt [
				node: as node! n/value
				if collector/refs <> null [
					new: _hashtable/rs-get collector/refs as-integer node
					if new <> null [
						;probe ["freeing node: " node ", new: " as node! new/value]
						node: as node! new/value
					]
				]
				while [
					frm: as int-ptr! p/value + size? node-frame!
					not all [frm <= node  node < as node! ((as byte-ptr! frm) + w)]
				][
					p: p + 1
					assert p <= e
				]
				free-node as node-frame! p/value node
				n: n + 1
			]
		]

		flush: does [
			if count > 0 [
				do-flush 1
				count: 0
			]
			if reloc-count > 0 [
				do-flush 2
				reloc-count: 0
			]
		]
	]