215 lines
7.4 KiB
Tal
215 lines
7.4 KiB
Tal
|
( zenochat.tal )
|
||
|
|
( )
|
||
|
|
( uses uxnet protocol, see uxnet.txt for details )
|
||
|
|
( )
|
||
|
|
( the server assumes its assigned idxs are exactly 3 bytes long. )
|
||
|
|
( this is an implementation detail of uxnet.py not currently )
|
||
|
|
( required by the spec. )
|
||
|
|
( )
|
||
|
|
( clients send messages to the server using the > command. )
|
||
|
|
( each type of messages is identified by its first ASCII )
|
||
|
|
( character, which is otherwise ignored: )
|
||
|
|
( )
|
||
|
|
( CHAR MEANING )
|
||
|
|
( N sets username to $text )
|
||
|
|
( B broadcasts a chat message of $text )
|
||
|
|
( C notifies that user $text has connected )
|
||
|
|
( D notifies that user $text has disconnected )
|
||
|
|
( R expects $prev/$curr, user $prev is renamed to $curr )
|
||
|
|
( )
|
||
|
|
( nicknames are not allowed to have slashes, i.e. /, and must )
|
||
|
|
( be 16 bytes or fewer long. messages are not allowed to contain )
|
||
|
|
( the NULL byte, and are not expected to contain newlines. )
|
||
|
|
|
||
|
|
|10 @Console [ &vect $2 &r $1 &pad $4 &type $1 &w $1 &e $1 ]
|
||
|
|
|
||
|
|
|0000
|
||
|
|
@interpret $2
|
||
|
|
@pos $2
|
||
|
|
@next-client $2
|
||
|
|
|
||
|
|
|0100
|
||
|
|
;before-start .interpret STZ2
|
||
|
|
;addr .pos STZ2
|
||
|
|
;clients .next-client STZ2
|
||
|
|
;read-args .Console/vect DEO2
|
||
|
|
BRK
|
||
|
|
|
||
|
|
( we don't expect anything )
|
||
|
|
@before-start ( -> )
|
||
|
|
#0000 DIV JMP2r
|
||
|
|
|
||
|
|
( we expect to read $/ )
|
||
|
|
@when-starting ( -> )
|
||
|
|
;input LDAk LIT "$ NEQ ?&error
|
||
|
|
INC2 LDAk LIT "/ NEQ ?&error
|
||
|
|
POP2
|
||
|
|
( TODO: validate input )
|
||
|
|
;when-listening .interpret STZ2 JMP2r
|
||
|
|
&error #010f DEO BRK
|
||
|
|
|
||
|
|
( we expect to read $ # < )
|
||
|
|
@when-listening ( -> )
|
||
|
|
;input LDAk LIT "$ EQU ?connect
|
||
|
|
LDAk LIT "# EQU ?disconnect
|
||
|
|
LDAk LIT "< EQU ?receive
|
||
|
|
POP2 #0000 DIV
|
||
|
|
|
||
|
|
@connect ( input* -> )
|
||
|
|
( TODO: validate input )
|
||
|
|
INC2 !add-client
|
||
|
|
|
||
|
|
@disconnect ( input* -> )
|
||
|
|
( TODO: validate input )
|
||
|
|
INC2 !rm-client
|
||
|
|
|
||
|
|
( expect: <999/N...\0 )
|
||
|
|
( or: <999/B...\0 )
|
||
|
|
@receive ( input* -> )
|
||
|
|
( TODO: validate input )
|
||
|
|
INC2 DUP2 find-client ( msg=input+1* maybe* )
|
||
|
|
ORAk ?&found POP2 emit JMP2r ( )
|
||
|
|
&found ( msg* client* )
|
||
|
|
SWP2 #0004 ADD2 ( client* body=msg+4 )
|
||
|
|
LDAk LIT "N EQU ?rename ( client* body* )
|
||
|
|
LDAk LIT "B EQU ?broadcast ( client* body* )
|
||
|
|
POP2 POP2 JMP2r ( )
|
||
|
|
|
||
|
|
@broadcast ( client* body* -> )
|
||
|
|
INC2 SWP2 #0003 ADD2 ( data=body+1* name=client+3* )
|
||
|
|
start-output copy-dst0 ( data* dst+n* ; copy name into dst+5 )
|
||
|
|
#3a20 OVR2 STA2 ( data* dst+n-1* ; dst+n-1<-": " )
|
||
|
|
INC2 INC2 copy ( ; copy data into dst+n+1 )
|
||
|
|
!send-to-all ( )
|
||
|
|
|
||
|
|
( sends ;output to all clients )
|
||
|
|
( fn should have shape: client* -> )
|
||
|
|
@send-to-all ( -> )
|
||
|
|
.next-client LDZ2 ;clients ( limit* start* )
|
||
|
|
&loop GTH2k ?&ok POP2 POP2 JMP2r ( )
|
||
|
|
&ok DUP2 send-to #0014 ADD2 !&loop ( limit* pos+20* )
|
||
|
|
POP2 POP2 JMP2r ( )
|
||
|
|
|
||
|
|
( sends ;output to a client )
|
||
|
|
@send-to ( client* -> )
|
||
|
|
;output STH2k INC2 ( client* output+1* [output*] )
|
||
|
|
idx-copy ( [output*] ; copy idx into output+1 )
|
||
|
|
STH2r emit ( ; emit output )
|
||
|
|
( #0a18 DEO JMP2r ( need newline for interactive testing ) )
|
||
|
|
#0018 DEO JMP2r
|
||
|
|
|
||
|
|
@rename-msg 20 "is 20 "now 20 "called 20 00
|
||
|
|
|
||
|
|
@start-output ( -> dst* )
|
||
|
|
LIT2r :output
|
||
|
|
LIT "> STH2kr STA INC2r
|
||
|
|
LIT2 "00 STH2kr STA2 INC2r INC2r
|
||
|
|
LIT2 "0/ STH2kr STA2 INC2r INC2r
|
||
|
|
STH2r JMP2r
|
||
|
|
|
||
|
|
@rename ( client* body* -> )
|
||
|
|
OVR2 #0003 ADD2 ( client* body* name=client+3* )
|
||
|
|
start-output copy-dst0 ( client* body* dst* ; copy old name to output )
|
||
|
|
;rename-msg SWP2 copy-dst0 ( client* body* dst2* )
|
||
|
|
STH2 INC2 STH2k #00 STH2kr ( client* data=body+1* 0^ data* [dst2* data*] )
|
||
|
|
#0010 ADD2 STA ( client* data* ; data+16<-0 [dst2* data*] )
|
||
|
|
SWP2 #0003 ADD2 copy ( [dst2* data*] ; copy data into client+3 )
|
||
|
|
STH2r STH2r ( data* dst2* )
|
||
|
|
copy !send-to-all ( ; copy data into dst2 and send )
|
||
|
|
|
||
|
|
( we expect to read addr then port )
|
||
|
|
@read-args ( -> BRK )
|
||
|
|
.Console/type DEI #04 EQU ?start-server
|
||
|
|
.Console/type DEI #03 EQU ?&end-addr
|
||
|
|
.Console/r DEI .pos LDZ2 STA ( ; write c into buf )
|
||
|
|
.pos LDZ2k INC2 ROT STZ2 BRK ( BRK ; increment buf pos )
|
||
|
|
&end-addr ;port .pos STZ2 BRK ( BRK ; start raeding port port )
|
||
|
|
|
||
|
|
@read-stdin
|
||
|
|
( .Console/r DEI #0a NEQ ?&continue ( ; did we read null? ) )
|
||
|
|
.Console/r DEI ?&continue ( ; did we read null? )
|
||
|
|
#00 .pos LDZ2 STA ( ; write null )
|
||
|
|
.interpret LDZ2 JSR2 ( ; interpret message )
|
||
|
|
;input .pos STZ2 BRK ( ; reset input buffer )
|
||
|
|
&continue ( )
|
||
|
|
.Console/r DEI .pos LDZ2 STA ( ; write c into input buffer )
|
||
|
|
.pos LDZ2k INC2 ROT STZ2 BRK ( ; increment input buffer )
|
||
|
|
|
||
|
|
@start-server ( -> BRK )
|
||
|
|
LIT "@ .Console/w DEO ;addr emit
|
||
|
|
LIT "/ .Console/w DEO ;port emit
|
||
|
|
( #0a .Console/w DEO )
|
||
|
|
#00 .Console/w DEO
|
||
|
|
;input .pos STZ2
|
||
|
|
;when-starting .interpret STZ2
|
||
|
|
;read-stdin .Console/vect DEO2
|
||
|
|
BRK
|
||
|
|
|
||
|
|
( assumes idxs are 3 bytes long )
|
||
|
|
@idx-eq ( idx1* idx2* -> bool^ )
|
||
|
|
STH2 LDAk LDAkr STHr NEQ ?&nope
|
||
|
|
INC2 INC2r LDAk LDAkr STHr NEQ ?&nope
|
||
|
|
INC2 INC2r LDA LDAr STHr EQU JMP2r
|
||
|
|
&nope #00 JMP2r
|
||
|
|
|
||
|
|
( assumes idxs are 3 bytes long )
|
||
|
|
@idx-copy ( idx* dst* -> )
|
||
|
|
STH2 LDAk STH2kr STA INC2 INC2r ( idx+1* [dst+1*] ; dst<-idx )
|
||
|
|
LDAk STH2kr STA INC2 INC2r ( idx+2* [dst+2*] ; dst+1<-idx+1 )
|
||
|
|
LDA STH2r STA JMP2r ( ; dst+2<-idx+2 )
|
||
|
|
|
||
|
|
@connect-msg 20 "has 20 "connected 00
|
||
|
|
|
||
|
|
@add-client ( idx* -> )
|
||
|
|
LITr -next-client LDZ2r ( idx* [next*] )
|
||
|
|
DUP2 STH2kr copy-slash ( idx* [next*] ; copy idx to client-idx )
|
||
|
|
STH2kr #0003 ADD2 copy-slash ( [next*] ; copy idx to client-name )
|
||
|
|
#00 STH2kr #0006 ADD2 STA ( [next*] ; null terminate )
|
||
|
|
STH2kr #0003 ADD2 ( next+3* [next*] )
|
||
|
|
start-output copy-dst0 ( dst* [next*] ; start message )
|
||
|
|
;connect-msg SWP2 copy ( [next*] ; finish message )
|
||
|
|
STH2r #0014 ADD2 .next-client STZ2 ( ; next-client<-next+20 )
|
||
|
|
!send-to-all ( )
|
||
|
|
|
||
|
|
@disconnect-msg 20 "has 20 "disconnected 00
|
||
|
|
|
||
|
|
@rm-client ( idx* -> )
|
||
|
|
find-client ORAk ?&found ( addr* )
|
||
|
|
POP2 JMP2r ( )
|
||
|
|
&found ( addr* )
|
||
|
|
DUP2 #0003 ADD2 start-output ( addr* addr+3* dst* )
|
||
|
|
copy-dst0 ( addr* dst2* )
|
||
|
|
;disconnect-msg SWP2 copy ( addr* )
|
||
|
|
.next-client LDZ2 #0014 SUB2 SWP2 ( limit* addr* )
|
||
|
|
&loop GTH2k ?&ok !&done ( limit* pos* )
|
||
|
|
&ok DUP2 #0014 ADD2 LDA2 ( limit* pos* cc* )
|
||
|
|
OVR2 STA2 INC2 INC2 !&loop ( limit* pos+2* )
|
||
|
|
&done .next-client STZ2 POP2 ( )
|
||
|
|
!send-to-all ( )
|
||
|
|
|
||
|
|
( returns client addr or 0000 on failure )
|
||
|
|
( finds client based on 3 byte idx )
|
||
|
|
@find-client ( idx* -> addr* )
|
||
|
|
STH2 .next-client LDZ2 ;clients ( limit* clients* [idx*] )
|
||
|
|
&loop ( limit* c* [idx*] )
|
||
|
|
DUP2 STH2kr idx-eq ?&found ( limit* c* [idx*] )
|
||
|
|
#0014 ADD2 GTH2k ?&loop ( limit* c+20* [idx*] )
|
||
|
|
POP2r POP2 DUP2 EOR2 JMP2r ( 0* )
|
||
|
|
&found NIP2 POP2r JMP2r ( c* )
|
||
|
|
|
||
|
|
~zenoutil.tal
|
||
|
|
|
||
|
|
@addr $100
|
||
|
|
@port $6
|
||
|
|
@input $1000
|
||
|
|
@output $1000
|
||
|
|
|
||
|
|
( client layout: )
|
||
|
|
( - bytes 1-3: idx )
|
||
|
|
( - bytes 4-20: nickname\0 )
|
||
|
|
( every idx is 3 bytes )
|
||
|
|
( max username is 16 chars )
|
||
|
|
( username is null-terminated; idx is not )
|
||
|
|
( max # of clients is 64 )
|
||
|
|
@clients $500 &limit
|