Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-03 11:16:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

adding (chibi pty)

Browse source
This commit is contained in:
Alex Shinn 2019-08-19 23:03:09 +08:00
parent ec09e0eed4
commit 8ea1852ac1
8 changed files with 117 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile
View file

@ -41,7 +41,8 @@ CHIBI_COMPILED_LIBS = lib/chibi/filesystem$(SO) lib/chibi/weak$(SO) \
lib/chibi/heap-stats$(SO) lib/chibi/disasm$(SO) lib/chibi/ast$(SO) \
lib/chibi/emscripten$(SO)
CHIBI_POSIX_COMPILED_LIBS = lib/chibi/process$(SO) lib/chibi/time$(SO) \
lib/chibi/system$(SO) lib/chibi/stty$(SO) lib/chibi/net$(SO)
lib/chibi/system$(SO) lib/chibi/stty$(SO) lib/chibi/pty$(SO) \
lib/chibi/net$(SO)
CHIBI_WIN32_COMPILED_LIBS = lib/chibi/win32/process-win32$(SO)
CHIBI_CRYPTO_COMPILED_LIBS = lib/chibi/crypto/crypto$(SO)
CHIBI_IO_COMPILED_LIBS = lib/chibi/io/io$(SO)

3
Makefile.libs
View file

@ -52,6 +52,9 @@ all-libs: $(COMPILED_LIBS)
lib/%.c: lib/%.stub $(CHIBI_FFI_DEPENDENCIES)
$(CHIBI_FFI) $<
lib/chibi/pty$(SO): lib/chibi/pty.c $(INCLUDES) libchibi-scheme$(SO)
$(CC) $(CLIBFLAGS) $(CLINKFLAGS) $(XCPPFLAGS) $(XCFLAGS) $(LDFLAGS) -o $@ $< -L. $(RLDFLAGS) $(XLIBS) -lchibi-scheme -lutil
lib/%$(SO): lib/%.c $(INCLUDES) libchibi-scheme$(SO)
$(CC) $(CLIBFLAGS) $(CLINKFLAGS) $(XCPPFLAGS) $(XCFLAGS) $(LDFLAGS) -o $@ $< -L. $(RLDFLAGS) $(XLIBS) -lchibi-scheme

26
lib/chibi/pty-test.sld Normal file
View file

@ -0,0 +1,26 @@
(define-library (chibi pty-test)
(import (scheme base) (scheme file) (scheme write)
(chibi io) (chibi pty) (chibi stty) (chibi test))
(export run-tests)
(begin
(define (run-tests . o)
(when (file-exists? "/usr/bin/units")
(test-begin "pty")
(test '("\t* 3.2808399" "\t/ 0.3048")
(call-with-pty-process-io
'("/usr/bin/units" "-q")
(lambda (pid in out name)
(with-raw-io
out
(lambda ()
;; input with tab completion
(display "mete\t" out) (newline out)
(display "fee\t" out) (newline out)
(display (integer->char 4) out)
(flush-output-port out)
;; result
(let* ((l1 (read-line in))
(l2 (read-line in)))
(list l1 l2)))))))
(test-end)))))

62
lib/chibi/pty.sld Normal file
View file

@ -0,0 +1,62 @@
(define-library (chibi pty)
(import (scheme base)
(chibi filesystem)
(chibi process)
(chibi string)
(chibi stty)
(only (chibi) fileno?))
(export open-pty fork-pty login-tty
open-pty-process call-with-pty-process-io)
(include-shared "pty")
(begin
(define (winsize-arg o)
(cond
((and (pair? o) (integer? (car o)))
(unless (and (pair? (cdr o)) (integer? (cadr o)))
(error "open-pty expects integer width and height" o))
(make-winsize (car o) (cadr o)))
((and (pair? o) (pair? (cdr o))) (cadr o))
(else #f)))
(define (open-pty . o)
(let ((termios (and (pair? o) (car o)))
(winsize (winsize-arg (if (pair? o) (cdr o) '()))))
(openpty termios winsize)))
(define (fork-pty . o)
(let ((termios (and (pair? o) (car o)))
(winsize (winsize-arg (if (pair? o) (cdr o) '()))))
(forkpty termios winsize)))
(define (open-pty-process command . o)
(let* ((command (if (and (string? command)
(string-find? command #\space))
(string-split command)
command))
(pty (apply fork-pty o)))
(cond
((not (and (pair? pty) (integer? (car pty))
(not (negative? (car pty)))
(pair? (cdr pty)) (fileno? (cadr pty))))
(error "failed to fork-pty" pty))
((zero? (car pty)) ; child
(execute (car command) command))
(else ; parent
pty))))
(define (call-with-pty-process-io command proc . o)
(unless (procedure? proc)
(error "call-with-pty-process-io expected procedure" proc))
(let ((pty (apply open-pty-process command o)))
(if (and (pair? pty)
(integer? (car pty))
(not (negative? (car pty)))
(fileno? (cadr pty)))
(let* ((pid (car pty))
(fd (cadr pty))
(name (and (pair? (cddr pty)) (car (cddr pty))))
(in (open-input-file-descriptor fd))
(out (open-output-file-descriptor fd))
(res (proc pid in out name)))
(close-input-port in)
(close-output-port out)
(close-file-descriptor fd)
res)
(error "couldn't open-pty-process" command o pty))))))

14
lib/chibi/pty.stub Normal file
View file

@ -0,0 +1,14 @@
(c-system-include "pty.h")
(c-system-include "utmp.h")
(c-link "util")
(declare-c-struct termios)
(declare-c-struct winsize)
(define-c errno openpty
((result fileno) (result fileno) (result (array char 256)) (maybe-null default NULL termios) (maybe-null default NULL winsize)))
(define-c pid_t forkpty
((result fileno) (result (array char 256)) (maybe-null default NULL termios) (maybe-null default NULL winsize)))
(define-c int (login-tty "login_tty") (fileno))

9
lib/chibi/stty.sld
View file

@ -2,7 +2,14 @@
(define-library (chibi stty)
(export stty with-stty with-raw-io
get-terminal-width get-terminal-dimensions
TCSANOW TCSADRAIN TCSAFLUSH)
TCSANOW TCSADRAIN TCSAFLUSH
winsize winsize? make-winsize winsize-row winsize-col
termios term-attrs? make-term-attrs
;;term-attrs-iflag term-attrs-iflag-set!
;;term-attrs-oflag term-attrs-oflag-set!
;;term-attrs-cflag term-attrs-cflag-set!
;;term-attrs-lflag term-attrs-lflag-set!
)
(import (chibi) (srfi 69) (srfi 151))
(include-shared "stty")
(include "stty.scm"))

1
lib/chibi/stty.stub
View file

@ -24,6 +24,7 @@
(define-c-struct winsize
predicate: winsize?
constructor: (make-winsize ws_row ws_col)
(unsigned-short ws_row winsize-row)
(unsigned-short ws_col winsize-col))

2
tools/chibi-ffi
View file

@ -1791,7 +1791,7 @@
(cond
(imported?
(cat " name = sexp_intern(ctx, \"" scheme-name "\", -1);\n"
" " (type-id-name name) " = sexp_env_ref(env, name, SEXP_FALSE);\n"
" " (type-id-name name) " = sexp_env_ref(ctx, env, name, SEXP_FALSE);\n"
" if (sexp_not(" (type-id-name name) ")) {\n"
" sexp_warn(ctx, \"couldn't import declared type: \", name);\n"
" }\n"))