Remember all this will go with TCP/IP and TELNET
bank_tube. This is object installed by the server. The server is the task providing the info. The terminal is the client. Same convention as the network, inverse convention to X. The control block must exist in banked memory. Because of history the bank_tube object has to allocated a number. This is the location the control block address is placed in the table pointed to by %bank_pbase. The object is created with the string bank_tube/nn for example to create an object for the operator task:
You have to remember through all this that the OPERATOR task has to be local and remote connectable.
S" bank_tube/$1F" R/W OPEN-FILE $ABORT
: W!bank ( value addr --)
_lock_word
claim_bank
W!
release_bank
_unlock_word
;
: !bank ( value addr --)
_lock_word
claim_bank
!
release_bank
_unlock_word
;
: C@bank ( addr --value)
_lock_word
claim_bank
C@
release_bank
_unlock_word
;
: W@bank ( addr --value)
_lock_word
claim_bank
W@
release_bank
_unlock_word
;
: @bank ( addr --value)
_lock_word
claim_bank
@
release_bank
_unlock_word
;
: bank_move ( source dest num --)
_lock_word
claim_bank
MOVE
release_bank
_unlock_word
;
\ n1 is the time to wait
\ addr is the facility address
: bank_xgrab ( n1 addr --zero|$)
BEGIN
OVER 0>
WHILE
_lock_word
claim_bank
DUP @ 0= IF \ count addr (--
status SWAP !
release_bank
_unlock_word
DROP
zero
EXIT
THEN
DUP @ status = IF \ count addr (--
release_bank
_unlock_word
2DROP
zero
EXIT
THEN
release_bank
_unlock_word
xtest 0A xwait
SWAP 0A - SWAP
REPEAT
\ get to here and the game is lost
2DROP
$can't_claim
;
: bank_release ( add --)
zero SWAP !bank
;
tube class
m: ( --)
\ does the unlinking
this [parent] :destruct
; overrides :destruct
\ This will set up up as a normal tube, it is Sopen that converts us to
\ port_tube
m: ( number parent--)
this [parent] :construct
; overrides :construct
\ you can open the device and particular port with the code
\ bank_port/nn
\ this code should receive the string nn.
\ As the open operation creates the bank port memory area
\ the device must be opened and closed from a task that has bank
\ memory to allocate ( all owned by operator in the begining)
\ before the device is opened by a task not having the memory to allocate.
m: ( addr num mode-- handle )
this :!mode
\ because thats what out I/O standard expect us to do.
[CHAR] / remove_leading
2DUP this :!name
\ because this is what we want
Snumber \ number(--
DUP #bank_tube_max < not ABORT" Port number out of range"
\ Now this may seem strange but we have to take care.
DUP CELLS %bank_tube_control> +
_lock_word
claim_bank
@
not IF
\ We can not store a random number as master side will only test for zero.
\ This is not 100% correct but as we can no longer save a binary
\ image of the application it's ok. Run time code is allocating bank
\ memory; thats the problem. Note we take care to only allocate
\ it once for each port. The memory belongs to the port not the object.
\ There is no place to return it so once allocated it remains until
\ the system is restarted. A system restart reloads the application.
\ Obviously the port has to be opened first in a task that has bank
\ memory to allocate.
bank_here \ num base(--
\ this could be nasty an ABORT with interrupts disabled
_#control_block_size ['] bank_allot CATCH ?DUP IF
release_bank
_unlock_word $ABORT
THEN
\ num base(--
DUP _#control_block_size
ERASE
bank_here OVER #p_tpoint + !
_#write_buffer_length
['] bank_allot CATCH ?DUP IF
release_bank
_unlock_word $ABORT
THEN
OVER \ num base num(--
CELLS %bank_tube_control> + !
THEN
release_bank
_unlock_word
\ num(--
CELLS %bank_tube_control> + @bank this :!control_block
this
; overrides :Sopen
\ the contol block is in dual port memory
\ Shit; I know but all this is being repelaced by TCP/IP
\ so it is a waste of time doing it any other way.
: _bank_send ( addr count --)
DUP not IF \ Don't send null packet.
2DROP
xpause
EXIT
THEN
10 %%control_block> @ #p_status + bank_xgrab $ABORT
\ for the ^C
user_base activation_status this :@control_block #p_^C_task + !bank
\ addr count(--
\ Only pause if there is an owner. This feature
\ allows you to use tubes for debugging. If no one
\ is logged on the message is gobbled up. If logged
\ on you get the message.
%%control_block> @ #p_owner + @bank %%always_send @ OR IF
#send_code %%control_block> @ #p_function + W!bank
DUP %%control_block> @ #p_count + W!bank
FALSE %%control_block> @ #p_?data + W!bank
xsleep
%%control_block> @ #p_local + W@bank IF
\ If local is set there is an owner
\ addr count(--
DROP
%%control_block> @ #p_address + !bank
TRUE %%control_block> @ #p_request + W!bank
wake %%control_block> @ #p_owner + @bank W!
xnext
ELSE
\ addr count(--
\ If remote move data into bank transfer buffer)
\ addr count(--
%%control_block> @ #p_tpoint + @bank SWAP
_#write_buffer_length MIN
3 + $FFFFFFFC AND
\ addr addrfrom addrto count(--
bank_move
%%control_block> @ #p_tpoint + @bank
%%control_block> @ #p_address + !bank
TRUE %%control_block> @ #p_request + W!bank
xnext
THEN
ELSE
2DROP
\ xpause
THEN
%%control_block> @ #p_status + bank_release
;
m: ( --)
\ terminate the write buffer with a send
$82 %%type_buffer> @ %%type_buffer_count @ + C!
1 %%type_buffer_count +!
%%type_buffer> @ %%type_buffer_count @
_bank_send
zero %%type_buffer_count !
; overrides :flush_file
: read_common ( addr num --addr )
send
10 %%control_block> @ #p_status + bank_xgrab $ABORT
\ for ^C
user_base activation_status this :@control_block #p_^C_task + !bank
#expect_code %%control_block> @ #p_function + W!bank
#p_count %%control_block> @ + W!bank
\ addr(--
%%control_block> @ #p_local + W@bank TUCK IF
\ if local point to buffer
DUP #p_address %%control_block> @ + !bank
ELSE
\ if remote we have to transfer data to
\ transfer buffer.
%%control_block> @ #p_tpoint + @bank
%%control_block> @ #p_address + !bank
THEN
\ local addr (--
zero %%control_block> @ #p_actual + W!bank
xsleep
TRUE %%control_block> @ #p_request + W!bank
%%control_block> @ #p_owner + @bank IF
OVER IF
%%control_block> @ #p_owner + @bank
wake SWAP W!
THEN
ELSE
\ If no one is logged on seal the interpreter
TRUE seal W!
THEN
xnext
\ local addr(--
\ If not local data is now in buffer pointed to by address, we now copy it
\ to the users buffer. Look at port_tube for reason.
SWAP not IF
%%control_block> @ #p_address + @bank
OVER
%%control_block> @ #p_actual + W@bank \ includes termination code
\ long word align, makes for faster copy. And as dual port
\ will only allow word moves a valid copy.
3+ $FFFFFFFC AND
\ from to num (--
bank_move
THEN
;
\ Once we have set up for a local read we have to be committed to
\ the local read. Ii is possible for the local task to log off and
\ a remote task to log on.
m: ( addr num -- num_bytes )
\ addr(--
read_common
DROP
%%control_block> @ #p_actual + W@bank 1- \ exclude termination code
%%control_block> @ #p_status + bank_release
; overrides :read
\ addr is the start of the buffer
\ n is the numbr of characters including the terminator
m: ( addr num -- num_bytes )
read_common
\ addr(--
%%control_block> @ #p_actual + W@bank
\ deal with termination
this :termination>code
%%control_block> @ #p_status + bank_release
; overrides :read_line
m: ( indent --)
CR DUP SPACES ." bank_tube | " ." Object: " this .h
DROP send
; overrides :print
target_also
&drivers
target_definitions
end_class bank_tube
target_previous_definitions
target_previous
The client. If we have the control block we can fiddle with that and not get involved any further. These words will work agains a tube or port_tube. The data is moved through the buffer pointed to by tpoint because port_tube requires this action.
| : _expect_action { ( control_block --control_block) }{
variable %terminator
}
\ have to receive into a buffer as the receive area may be in
\ dual port memory.
DUP #p_count + W@bank get_buffer
buffer OVER #p_count + W@bank ACCEPT
\ control_block count(--
buffer jump #p_address + @bank
\ control_block count buffer addr(--
jump
1 + \ add in terminator
3+ $FFFFFFFC AND \ round to long word count
MOVE
kill_buffer
\ control_block actual_count(--
\ we want control C set befor the task is told about expect
user_base activation_^c_set W@ IF ( ^C )
TRUE jump #p_^C + W!bank
FALSE user_base activation_^c_set W!
OVER #p_^C_task + @bank
IF
TRUE jump #p_^C_task + @bank
[ #activation_^c_set #activation_status - ]T LITERAL + W!
THEN
THEN
'input_file @ :terminal_mode@ IF
OVER #p_address + @bank OVER + C@bank %terminator !
ELSE
\ in binary mode there is no terminator
zero %terminator !
THEN
1 CHARS + \ add in termination code
OVER #p_actual + W!bank
KEY? OVER #p_?data + W!bank
xtest
DUP #p_status + @bank ?DUP IF
wake SWAP W!
zero OVER #p_function + W!bank
THEN
%terminator @ #end_eof = ABORT" Disconnected"
;
| : _type_action ( control_block --control_block)
DUP #p_address + @bank
OVER #p_count + W@bank
\ remember the type data will not be in the
\ banked memory
_cvs_terminal_codes_decode
KEY? OVER #p_?data + W!bank
\ wake up task we are supplying terminal services too
xtest
DUP #p_status + @bank ?DUP IF
wake SWAP W!bank
zero OVER #p_function + W!bank
THEN
;
| : _no_action ( control_block -- control_block)
;
CREATE function.vectors
4 tw,
' _no_action t,
' _expect_action t,
' _type_action t,
' _no_action t,
\ the operator task has to expose it's tibe to the bank memory and
\ we have to use this word.
: bank_logon ( object--)
:@control_block
10 OVER #p_owner + bank_xgrab $ABORT
TRUE OVER #p_local + W!bank
\ Old rlogon code reset request on logoff. We need to turn to the function
\ code. If the function code is non zero then it is a safe bet that
\ the task is waiting for the terminal. The old logon code doesn't
\ reset the function code under normal operation so there is a risk
\ but small.
DUP #p_function + W@bank IF
DUP #p_status + @bank ?DUP IF
wake SWAP W!
zero OVER #p_function + W!bank
THEN
THEN
\ control block(--
BEGIN
user_base activation_^c_set W@ IF ( ^C )
TRUE OVER #p_^C + W!
FALSE user_base activation_^c_set W!
DUP #p_^C_task + @bank
IF
TRUE OVER #p_^C_task + @bank
[ #activation_^c_set #activation_status -]T LITERAL + W!
THEN
THEN
DUP #p_request + W@bank IF
FALSE OVER #p_request + W!bank
DUP #p_function + W@bank
\ as we use the function code on logon to
\ determine if the task is waiting for
\ the terminal we must set it to zero in
\ normal operation, if we wake te task.
\ limit to number of vectors in table
function.vectors W@ 1- MIN
\ get vector
4* function.vectors + 2 + @
CATCH ?DUP IF
\ addr $(--
\ a remote logon will not set this
\ flag so the default has to be remote.
FALSE jump #p_local + W!bank
SWAP #p_owner + bank_release \ $ (--
$ABORT
THEN
THEN
2 xwait
AGAIN
;