bank file operations

license

Get data from the memory between CPU I and II. CPU I is requester CPU II provides the data,

 
: claim_bank ( --)
	BEGIN	
		BEGIN
			_#cpu_II_bank3_claim C@ 01 AND not 
		UNTIL
		TRUE _#cpu_I_bank3_claim C!
		_#cpu_II_bank3_claim C@ 01 AND not IF
			TRUE _#bank3_direction C!
			EXIT
		THEN
		FALSE _#cpu_I_bank3_claim C!
	AGAIN
;

: release_bank ( --)
		FALSE _#cpu_I_bank3_claim C!
;


ram_create %bank_file_facility #facility_length  ram_allot

: interrupt_cpuii_for_file
	_lock_word
	claim_bank
	TRUE %bank_i_file !
	release_bank
	_unlock_word
	TRUE _#interrupt_other_cpu C!
;

\ ### what should this do.
: reset_ii_interrupt
	TRUE _#interrupt_other_cpu_reset C!	
;


ram_variable %bank_interrupt
interrupt:  bank_interrupt
	1 %bank_interrupt +!
	reset_ii_interrupt
	claim_bank
	%bank_ii_file @ IF
		zero %bank_ii_file !
		%bank_file_facility _#facility + @ ?DUP IF
			wake SWAP W!
		THEN
	THEN
	%bank_ii_terminal @ IF
		%bank_ii_unit @ IF
			%bank_ii_unit @ #p_status + @ IF
				wake %bank_ii_unit @ #p_status + @ W!
			THEN
			zero %bank_ii_unit !
		THEN
		zero %bank_ii_terminal !
	THEN
	%bank_ii_^ced @ IF
		%bank_ii_unit @ IF
			%bank_ii_unit @ #p_^C_task + @ IF
				TRUE %bank_ii_unit @ #p_^C_task + @ ^c_set user_base - +  W!
			THEN
			zero %bank_ii_unit !
		THEN
		zero %bank_ii_terminal !
	THEN				
	release_bank
;interrupt	


: rti_check_error { -- }
	_lock_word
	claim_bank
	%bank_file_table #flbus_count + W@ IF
		\ a word operation will work against the dual port
		\ memory.
		%bank_buffer W@ $FF00 AND [ #error_ilan 8 LSHIFT ]T LITERAL  = IF
			\ move the data into a buffer
			%bank_file_table #flbus_count + W@ 3 + -4 AND 
			release_bank 
			_unlock_word
			
			DUP get_buffer

			_lock_word
			claim_bank
			%bank_buffer buffer ROT MOVE
			release_bank
			_unlock_word
			buffer 1+ $error #$buffer $move
			kill_buffer
			$error $ABORT
		THEN
	THEN
	release_bank
	_unlock_word
;


( flag is true if fault)
: perform_bank_op ( addr count -- )
	TUCK 3+ -4 AND
	_lock_word 
	claim_bank
		%bank_buffer SWAP MOVE
		\ count(--
		( pointer to table)
		%bank_file_table %bank_(file_table) !
		%bank_buffer %bank_file_table #flbus_buffer + !
		%bank_file_table #flbus_count + W!
	release_bank
	_unlock_word
	xtest
	interrupt_cpuii_for_file
	#2sec 2* xwait
	xtimeout? IF
		TRUE ABORT" Master didn't process file request"
	THEN
	rti_check_error 
;



: close_bank ( file_code --)
	%bank_file_facility get
	[ #ilan_close_header_length 3+ -4 AND ]T LITERAL  get_buffer  
	#close_ilan #ilan_disk_code buffer + C!
	#ilan_disk_i/o_id buffer  + unaligned!
	buffer [ #ilan_close_header_length 3+ -4 AND ]T LITERAL 
	['] perform_bank_op CATCH
	?DUP IF
		kill_buffer
		%bank_file_facility release
		$ABORT
	THEN
	kill_buffer 
	%bank_file_facility release
;


#$count_length 1 ??=

: open_bank ( add n mode file_code --)
	%bank_file_facility get
	jump [ #$count_length #ilan_open_header_length + ]T LITERAL + get_buffer 
	#open_ilan #ilan_disk_code buffer + C!
	#ilan_disk_i/o_id buffer + unaligned!
	#ilan_disk_mode buffer + unaligned!
	\ add n(--
	TUCK
	\ ###
	\ convenient to use $make here but isn't correct.
	\ The string structure is set by a protocol structure not by
	\ the FORTH spec. If the structure of $ changes this will be wrong
	buffer #ilan_open_header_length + $make
	\ length(--
	buffer SWAP #ilan_open_header_length + #$count_length +
	['] perform_bank_op CATCH
	?DUP IF
		kill_buffer
		%bank_file_facility release
		$ABORT
	THEN 
	kill_buffer
	%bank_file_facility release
;

: read_bank ( addr n seek_pointer file_code -- n )

	%bank_file_facility get

	#ilan_disk_header_length get_buffer

	4dup
	#read_ilan #ilan_disk_code buffer  + C!
	#ilan_disk_i/o_id buffer  + unaligned!
	#ilan_disk_where buffer  + unaligned!
	#ilan_disk_length buffer  + unaligned!
	DROP
	\ addr n seek_pointer file_code(--
	buffer #ilan_disk_header_length
	['] perform_bank_op CATCH
	?DUP IF
		kill_buffer
		%bank_file_facility release
		$ABORT
	THEN 

	kill_buffer

	_lock_word 
	claim_bank

	\ The requested data is now in %bank_buffer
	%bank_file_table #flbus_count + W@ #ilan_disk_header_length < IF
		release_bank
		_unlock_word
		%bank_file_facility release

		$command_length_wrong $ABORT
	THEN

	\ The memory operations that can be done against dual port memory are limited
	\ as we will be writing the data to a user I/O area we cannot force long word
	\ operation so we need to copy to buffer.

	%bank_file_table #flbus_count + W@ 3 + -4 AND get_buffer
	%bank_buffer buffer %bank_file_table #flbus_count + W@ 3 + -4 AND MOVE	 

	release_bank
	_unlock_word
	
	buffer #ilan_disk_code + C@ #read_ilan <> IF
		%bank_file_facility release
		$strange_command $ABORT
	THEN
	buffer #ilan_disk_i/o_id + unaligned@ 
	<> IF
		%bank_file_facility release
		$wrong_file $ABORT
	THEN
	buffer #ilan_disk_where + unaligned@ <> IF
		%bank_file_facility release
		$wrong_file_pointer $ABORT
	THEN
	buffer #ilan_disk_length + unaligned@ TUCK
	\ addr n_in n_out n_in(--
	< IF
		%bank_file_facility release
		$wrong_length $ABORT
	THEN
	\ addr n_in(--
	DUP 
	%bank_file_table #flbus_count + W@ #ilan_disk_header_length - 
	<> IF
		%bank_file_facility release
		$?data_length $ABORT
	THEN
	\ addr n_in(--
	TUCK

	\ The count may be byte aligned and we have to respect it
	buffer #ilan_disk_header_length +
	-rot MOVE
	kill_buffer
	%bank_file_facility release
;
	 


: write_bank ( addr n seek_pointer file_code--)
	%bank_file_facility get
	jump  #ilan_disk_header_length + get_buffer
	#write_ilan #ilan_disk_code buffer + C!
	#ilan_disk_i/o_id buffer + unaligned!
	#ilan_disk_where buffer  + unaligned!
	DUP #ilan_disk_length buffer + unaligned!
	TUCK
	\ n add n (--
	buffer #ilan_disk_header_length + SWAP 3 + -4 AND MOVE
	\ n (--
	#ilan_disk_header_length + buffer SWAP
	['] perform_bank_op CATCH
	?DUP IF
		kill_buffer
		%bank_file_facility release
		$ABORT
	THEN 
	kill_buffer
	%bank_file_facility release
;


	io_common class
		
\		inode_interface implementation
		 
		protected

		
		ram_variable _%opened_files
			
		ram_create _%device_facility  #facility_length  ram_allot


		\ all opened inodes are liked into here
		ram_variable _%opened_inodes

		public



		\ bank
		\
		m:  ( parent_ihandle -- )
			\ If you want to change the root directory you open it, claim it and
			\ see that no one else has it. For this to work the open has to
			\ claim the device also.
			this :facility grab
				this [parent] :construct
			this :facility release
		; overrides :construct

		\ on object descruct get rid of file name.
		\ The closing of the rti file is done by the inode.
		m: ( --)
			this [parent] destruct
		; overrides :destruct


		\ After the device is opened by Sopen, the device open method is used
		\ to consume the reset of the open string.
		\ As a result the only structure that is fixed is the requirment that
		\ the open command starts with the driver name.
		\ On entry this is a device object, here we store the file name
		\ We make a inode object, this opens the file on the rti
		\ with the device locked.
		\ We then make a file object which we return

		m: ( addr num mode-- handle )
			this :!mode
			DUP not IF
				2DROP
				this
				EXIT
			THEN
			[CHAR] / remove_leading
			this :!name
			get_filecode
			this :open_inode 
			\ inode_handle(-- 
			this file_class heap_object  \ file_handle(--
			DUP %%file_instance !
		; overrides :Sopen


		m: ( --addr)
			_%opened_files
		; overrides :list_head


		\ device_common
		m: ( --addr)
			_%device_facility 
		; overrides :facility
	

		\ bank
		\ ----------------------------------------------------------------------
		\ functions to be overriden to have format work on different sized files
		\ number of inodes		
		\ total bytes in file system

		\ this has to be exported for file as file has to know how many bytes in a block
		\ when deblocking the data. We deal in 8k blocks		
		m: 
			$2000
		; overrides :bytes_a_zone


		\ ----------------------------------------------------------------------

		\ The file offset and disk offset are one the same
		m:  { ( file_offset ) variable _%inode -- ( disk_offset) }
		; overrides :file_offset>device_offset

		m: ( addr n -- n )
			\ need to supply file_code this is supplied from the inode_handle
			\ the pointer
			\ addr and n
			this :inode \ convert inode_handle to file_code
			%%seek_pointer @
			SWAP
			\ addr n seek_pointer file_code(--
			\ This is the device, when doing a read the device must be claimed 
			\ You are allowed only one active read
			this :facility grab
			read_bank
			this :facility release
			DUP %%seek_pointer +!
		; overrides :read


		m: ( addr n -- )
			this :inode
			%%seek_pointer @ 2DUP + >R
			
			SWAP
			\ addr n seek_pointer file_code(--
			this :facility grab
			write_bank
			this :facility release
			R> %%seek_pointer !
		; overrirdes :write
		
		\ opening a file makes it, just let this go by
		m: ( addr n --)
			2drop
		; overrides :make_file

		\ head for the device	
		m: ( --addr)
			_%opened_inodes
		; overrides :inode_head
			
		m: { variable _%inode ( -- ihandle) }
			this :facility grab			
			\ returns the head of the list
			this :inode_head   
			BEGIN
				@
			DUP WHILE
				\ link(--
				\ Following only words because all objects are children
				\ of linked_objects so method is the same
				DUP link>object \ object
				\ link object(--
				DUP :inode _%inode @ = IF
					\ link object(--
					\ This will increment the open count
					DUP :open
					this :facility release
					NIP
					\ object(--
					EXIT
				THEN
				DROP
			REPEAT
			DROP
			this :@name this :@mode _%inode @ 
			\ addr num mode code(--
			['] open_bank CATCH
			?DUP IF
				this :facility release
				$ABORT
			THEN 
			\ (--
			_%inode @ this inode_class heap_object
			this :facility release		
		; overrides :open_inode

		\ bank

		m: ( inode_instance --)
			\ claim the device 
			this :facility grab
			DUP :close IF
				\ :close returns true if the node can be closed
				DUP :inode  
				\ inode_instance file_code(--
				['] close_bank CATCH
				?DUP IF
					this :facility release
				THEN
				\ inode_instance
				DUP heap_object_free
			THEN
			DROP
			this :facility release	
		; overrides :close_inode 


		m: ( indent --)
			CR DUP SPACES ." bank | " ." Object: " this .h  
				SPACE ." file:" this :@name TYPE
			CR DUP SPACES ." seek_value: " %%seek_pointer @ .h 
			SPACE ." timeout: " %%timeout @ .h
			." linked_objects: " this :number_of_links .h 
			\ indent(--
			DROP send
		; overrides :print
target_also
&drivers
target_definitions
	end_class bank
target_previous_definitions
target_previous