linked_object

All I/O has to be derived from this class.

We provide two lists as i/o object often have to be linked twice, once in the structures being created when the objects are being constructed. Once in cleanup lists. The second link is intended for the cleanup list. Hence it's name.

 
	\ object 
	\ 	:construct
	\ 	:destruct
	\ 	:print
	\	 	link_object
	\			:list_head
	\			:link_cleanup
	\			:unlink_cleanup
	\			:number_of_links
	            
	object class

		protected

		\ This is only a default, normaly things get overriden and the object is placed
		\ in the relevent list
		ram_variable _%linked_objects
		

		\ normaly :construct gets overriden
		\ and a differnt head used
		double% instance_variable %%object_link
		double% instance_variable %%cleanup_link

		public

		\ this gets overridden whenever a differnt head is used
		\ Not that the construct and descruct word get the linked
		\ list using this method. As a result only one method has to
		\ be overriden.
		m: ( --addr )
			_%linked_objects
		; method :list_head

		m: ( --)
			%%object_link this :list_head link_double
			\ something to indicate that it is unset
			\ has to be eight bytes.
			S" -notset-" %%cleanup_link SWAP MOVE
		; overrides :construct

		m: ( --)
			%%object_link unlink_double
		; overrides :destruct

	
		: link>object ( addr --obj)
			[ %%object_link ]T LITERAL 
			-
		;

		\ The cleanup link
		\ ----------------
		m: ( head --)
			%%cleanup_link SWAP link_double
		; method :link_cleanup

		m: ( --)
			%%cleanup_link unlink_double
		; method :unlink_cleanup	

		: cleanup>object ( addr --obj) 
			[ %%cleanup_link ]T LITERAL
			-
		; 

		\ Information
		\ -----------
		m:  ( --n)
			this :list_head number_in_list
		; method :number_of_links

		m: ( indent --)
			CR DUP SPACES
			." link_object | " ." Object: " this .h 
			CR DUP SPACES ." Linked_objects: " this :number_of_links .h 
			this :list_head @ BEGIN
				DUP 
			WHILE
				OVER 4+ OVER link>object DUP this <> IF
					:print
				ELSE
					2DROP
				THEN
			REPEAT 
			2DROP
			send
		; overrides :print

	end_class linked_object