moontalk/server/eventloop-server-experiment/sendbuffer.4th
2024-02-17 18:26:14 +00:00

58 lines
1.5 KiB
Forth

require util.4th
require configuration.4th
0 variable! sendbuffer-len
4096 constant SENDBUFFER_SIZE
create sendbuffer SENDBUFFER_SIZE allot
CONFIG_C_FFI invert [IF]
variable last-is-newline
: (last) ( c-addr u -- c-addr )
1- + ;
: (sanitize-char) ( c-addr -- )
dup c@ dup 32 < swap 126 > or IF
[char] ? swap c!
ELSE
drop
THEN ;
: sanitize ( c-addr u -- )
dup 0<= IF
2drop EXIT
THEN
2dup (last) c@ 10 = last-is-newline !
2dup
bounds DO
I (sanitize-char)
LOOP
last-is-newline @ IF
(last) 10 swap c!
ELSE
2drop
THEN ;
[ELSE]
\ Calling C here is just optimization.
c-library sanitizelib
\c void sanitize(char *buffer, int buffersize) {
\c int lastIsNewline = buffer[buffersize-1] == '\n' ? 1 : 0;
\c for(int i = 0; i<buffersize; i++) {
\c if(buffer[i]<32 || buffer[i]>126) { buffer[i] = '?'; }
\c }
\c if(lastIsNewline) { buffer[buffersize-1] = '\n'; }
\c return;
\c }
c-function sanitize sanitize a n -- void
end-c-library
[THEN]
: sendbuffer-reset ( -- ) 0 sendbuffer-len ! ;
: (overflow?) ( n -- flag )
sendbuffer-len @ + SENDBUFFER_SIZE u> ;
: (append) ( str -- )
dup -rot sendbuffer sendbuffer-len @ + swap move
sendbuffer-len +! ;
: sendbuffer-append ( str -- )
dup (overflow?) abort" sendbuffer overflow" (append) ;
: sendbuffer-sanitize ( -- )
sendbuffer sendbuffer-len @ sanitize ;
: sendbuffer@ ( -- str ) sendbuffer sendbuffer-len @ ;