Commit d98113a1 authored by bernd's avatar bernd

Terminal stub

parent 606e7c94
......@@ -81,7 +81,10 @@ gen-table $freeze
\ flow control functions
$31 net2o: ack ( -- o:acko ) ack-context @ n:>o ;
$31 net2o: ack ( -- o:acko )
ack-context @ dup 0= IF
drop n2o:new-ack dup ack-context !
THEN n:>o ;
ack-table >table
reply-table $@ inherit-table ack-table
......
......@@ -26,12 +26,12 @@ $20 net2o: emit ( utf8 -- ) \ emit character on server log
64>n xemit ;
+net2o: type ( $:string -- ) \ type string on server log
$> F type ;
+net2o: cr ( -- ) \ newline on server log
F cr ;
+net2o: . ( n -- ) \ print number on server log
64. ;
+net2o: f. ( r -- ) \ print fp number on server log
F f. ;
+net2o: cr ( -- ) \ newline on server log
F cr ;
+net2o: .time ( -- ) \ print timer to server log
F .time .packets profile( .times ) ;
+net2o: !time ( -- ) \ start timer
......@@ -40,7 +40,10 @@ $20 net2o: emit ( utf8 -- ) \ emit character on server log
gen-table $freeze
' context-table is gen-table
$32 net2o: log ( -- o:log ) log-context @ n:>o ;
$32 net2o: log ( -- o:log )
log-context @ dup 0= IF
drop n2o:new-log dup log-context !
THEN n:>o ;
log-table >table
previous set-current
......
\ messages 06aug2014py
\ Copyright (C) 2013 Bernd Paysan
\ Copyright (C) 2014 Bernd Paysan
\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
......@@ -18,7 +18,10 @@
get-current also net2o-base definitions
$34 net2o: msg ( -- o:msg ) \ push a message object
msg-context @ n:>o buf-state 2@ msg-buf 2! ;
msg-context @ dup 0= IF
drop n2o:new-msg dup msg-context !
THEN
n:>o buf-state 2@ msg-buf 2! ;
msg-table >table
......
\ terminal 06aug2014py
\ Copyright (C) 2014 Bernd Paysan
\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
\ the Free Software Foundation, either version 3 of the License, or
\ (at your option) any later version.
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU Affero General Public License for more details.
\ You should have received a copy of the GNU Affero General Public License
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
get-current also net2o-base definitions
term-table >table
log-table $@ inherit-table term-table
+net2o: at-xy ( x y -- ) F at-xy ;
+net2o: set-form ( w h -- ) term-h ! term-w ! ;
+net2o: form ( -- ) F form swap lit, lit, set-form ;
+net2o: set-keys ( $:string -- ) $> key-buf$ $+! ;
gen-table $freeze
' context-table is gen-table
$35 net2o: terminal ( -- o:terminal ) \ push a terminal object
term-context @ dup 0= IF
drop n2o:new-term dup term-context !
THEN n:>o ;
term-table >table
previous set-current
0 [IF]
Local Variables:
forth-local-words:
(
(("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
("[a-z\-0-9]+(" immediate (font-lock-comment-face . 1)
")" nil comment (font-lock-comment-face . 1))
)
forth-local-indent-words:
(
(("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)
(("[:") (0 . 1) (0 . 1) immediate)
((";]") (-1 . 0) (0 . -1) immediate)
)
End:
[THEN]
\ No newline at end of file
......@@ -559,7 +559,7 @@ Variable net2o-tasks
ELSE ~~ 0 (bye) ~~ THEN ;
: net2o-task ( params xt n -- task )
stacksize4 NewTask4 dup >r net2o-pass r> ;
event: ->kill ( -- ) -1 throw ;
event: ->kill:n2o ( -- ) -1 throw ;
: net2o-kills ( -- )
net2o-tasks $@ bounds ?DO
I @ <event ->kill event>
......@@ -831,6 +831,7 @@ Variable log-table
Variable setup-table
Variable ack-table
Variable msg-table
Variable term-table
cmd-class class
64field: dest-vaddr
......@@ -884,14 +885,24 @@ cmd-class class
end-class msg-class
cmd-class class
field: term-w
field: term-h
field: key-buf$
end-class term-class
cmd-class class
\ maps for data and code transfer
field: code-map
field: code-rmap
field: data-map
field: data-rmap
\ contexts for subclasses
field: next-context \ link field to connect all contexts
field: log-context
field: ack-context
field: msg-context
field: next-context \ link field if needed
field: term-context
\ rest of state
field: codebuf#
field: context#
field: wait-task
......@@ -1109,6 +1120,8 @@ UValue connection
o ack-class new >o parent ! ack-table @ token-table ! o o> ;
: n2o:new-msg ( -- o )
o msg-class new >o parent ! msg-table @ token-table ! o o> ;
: n2o:new-term ( -- o )
o term-class new >o parent ! term-table @ token-table ! o o> ;
: n2o:new-context ( addr -- o )
context-class new >o timeout( ." new context: " o hex. cr )
......@@ -1124,9 +1137,6 @@ UValue connection
1 blockalign !
code-lock 0 pthread_mutex_init drop
filestate-lock 0 pthread_mutex_init drop
n2o:new-log log-context !
n2o:new-ack ack-context !
n2o:new-msg msg-context !
o o> ;
\ insert address for punching
......@@ -2361,8 +2371,14 @@ $10 Constant tmp-crypt-val
dest-pubkey $off
pubkey $off
mpubkey $off
log-context @ .dispose
ack-context @ >o timing-stat $off track-timing $off dispose o>
log-context @ ?dup-IF .dispose THEN
ack-context @ ?dup-IF
>o timing-stat $off track-timing $off dispose o>
THEN
msg-context @ ?dup-IF .dispose THEN
term-context @ ?dup-IF
>o key-buf$ $off dispose o>
THEN
unlink-ctx
dispose 0 to connection
cmd( ." disposed" cr ) ;] file-sema c-section ;
......@@ -2463,8 +2479,11 @@ Variable beacons \ destinations to send beacons to
file-task ?dup-IF <event swap wait-task @ elit, elit, ->reqsave event>
ELSE elit, ->request THEN ;
0 value core-wanted
: create-receiver-task ( -- )
[: \ ." created receiver task " up@ hex. cr
[IFDEF] stick-to-core core-wanted stick-to-core drop [THEN]
['] event-loop-nocatch catch-loop drop
( wait-task @ ?dup-IF ->timeout event> THEN ) ;]
1 net2o-task to receiver-task ;
......@@ -2480,7 +2499,8 @@ Variable beacons \ destinations to send beacons to
o IF up@ wait-task ! 0timeout o+timeout THEN
event-loop-task requests->0 o> ;
: server-loop ( -- ) 0 >o rdrop -1 reqmask ! client-loop ;
: server-loop ( -- )
1 to core-wanted 0 >o rdrop -1 reqmask ! client-loop ;
\ client/server initializer
......@@ -2553,6 +2573,7 @@ require net2o-log.fs
require net2o-dht.fs
require net2o-keys.fs \ extra cmd space
require net2o-msg.fs
require net2o-term.fs
\ connection setup helper
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment