From b63d0022a125628af7a98ce272c52765d3abc722 Mon Sep 17 00:00:00 2001 From: Ralph Ronnquist Date: Mon, 8 May 2023 10:59:09 +1000 Subject: [PATCH] initial --- .gitweb | 2 + coproc.lsp | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++++ tcltk.lsp | 24 +++++++++ 3 files changed, 174 insertions(+) create mode 100644 .gitweb create mode 100644 coproc.lsp create mode 100755 tcltk.lsp diff --git a/.gitweb b/.gitweb new file mode 100644 index 0000000..95d3e2d --- /dev/null +++ b/.gitweb @@ -0,0 +1,2 @@ +description = coproc support for newlisp scripting +category = newlisp diff --git a/coproc.lsp b/coproc.lsp new file mode 100644 index 0000000..45c040a --- /dev/null +++ b/coproc.lsp @@ -0,0 +1,148 @@ +;; Utility module for coprocesses in newlisp +;; +;; This is a convenience implementation for running a sub process with +;; its stdio via pipes. It is somewhat similar to the standard +;; function but the utility combines the process +;; PID together with its stdin/stdout into a FOOP object for onwards +;; interactions. The command is passed as a command line to +;; /bin/sh and allows passing in environment. Further, the startup +;; includes closing the unused file descriptors. +;; +;; @syntax: (coproc cmd [ env ] ) +;; Start a coprocess and returns its representation which is a FOOP +;; object: ([coproc] PID outfd infd) +;; +;; The given command is passed to "sh -c 'cmd'" sub process +;; through a fork+execve scheme. The argument should be a +;; pointer to a null-terminated array of pointers to environment +;; NUL-terminated strings of format "NAME=VALUE". (The caller must +;; take care of providing existing pointers. +;; +;; @syntax: (:put0 coproc str ) +;; Write to the given . Returns the number of bytes +;; written. +;; +;; @syntax: (:puts coproc str ) +;; Write followed by newline to the given . Returns the +;; number of bytes written. +;; +;; @syntax: (:gets coproc [ limit [ waitms ]] ) +;; Read one line from the given or up to bytes +;; (default 100000) with up to millisceonds delay (default +;; 100) before reading. +;; +;; @syntax: (:pug coproc str [ limit [ waitms ]] ) +;; Write with :puts, then read once with :gets and return that. +;; +;; @syntax: (:pugs coproc str [ limit [ waitms ]] ) +;; Write with :puts, then read repeatedly with :gets collating +;; its returned lines into a list until :gets retuns nil. Returns the +;; list of lines. +;; +;; @syntax: (:running? coproc [ timeout ]) +;; Check if coproc is running, i.e., that its stdin is still open. + +(context 'coproc) + +(constant 'LIBC6 "/lib/x86_64-linux-gnu/libc.so.6") +(import LIBC6 "execve" "int" + "void*" ; pathname + "void*" ; argv[] + "void*" ; env[] + ) +(import LIBC6 "dup2" "int" + "int" ; oldfd + "int" ; newfd + ) +(import LIBC6 "poll" "int" + "void*" ; struct pollfd *fds + "int" ; nfds_t nfds + "int" ; timeout + ) +(import coproc:LIBC6 "on_exit" "int" + "void*" ; void (*function)(int , void *) + "void*" ; arg + ) + +(constant 'F_GETFD 1) + +; is a 64-bit char** variable, rather than a function +(import LIBC6 "environ") + +; Return the 64-bit value of environ +(define (environ@) ((unpack "Lu" (address environ)) 0)) + +; Pack a list of void* pointers into an array with a final null +; pointer added. +(define (pack-ptrs PTRS) + (pack (dup "Lu" (+ 1 (length PTRS))) (append PTRS (list 0)))) + +; Prepare the binary data setup for calling execve to execute +; via "sh -c 'exec '" and the given environment . If +; is , then the current process environment is used, otherwise +; it should be a list of name-value pairs (strings). +(define (wrapper cmd IO ENV) + (letn ((ARGS (list "/bin/sh" "-c" (string "exec " cmd))) + (ARGV (pack-ptrs (find-all nil ARGS (address $it) !=))) + (EV (if (list? ENV) (map (curry format "%s=%s") ENV))) + (ENVP (if (= true ENV) (environ@) + EV (pack-ptrs (find-all nil EV (address $it) !=)))) + ) + :;(map dup2 (list (IO 0 0) (IO 1 1) (IO 1 1)) '(0 1 2)) + (map dup2 (list (IO 0 0) (IO 1 1)) '(0 1 2)) ; share stderr + (map close (flat IO)) + (execve "/bin/sh" ARGV (or ENVP 0)) + (exit 1))) + +(setf SUBS '()) + +; Create a coproc FOOP object which holds PID and pipe ends. +(define (coproc:coproc cmd ENV) + (let ((IO (list (pipe) (pipe)))) + (last + (push (list (context) + (fork (wrapper cmd IO ENV)) + (begin (close (IO 0 0)) (close (IO 1 1)) (IO 0 1)) + (IO 1 0)) + SUBS -1)))) + +(define (kill-all-coproc x y) + (dolist (S SUBS) + (when (:running? S) + (! (format "kill %d" (S 1))) + ))) +(on_exit (callback 0 'kill-all-coproc "void" "int" "void*") 0) + +; Wait up to for input from the coproc, then read one line of +; up to bytes and return. The final newline, if any, is +; chopped off. +(define (gets limit waitms) + (let ((buffer "") + (delay (if (number? waitms) (* waitms 1000) 100000)) + (maxsize (if (number? limit) limit 1000000)) + ) + (and (net-select (self 3) "r" delay) + (read (self 3) buffer maxsize "\n") + (if (empty? buffer) buffer + (!= "\n" (buffer -1)) buffer + (chop buffer)) + ))) + +; Write to the coproc. +(define (put0 str) + (write (self 2) str (length str))) + +; Write to the coproc plus a newline. +(define (puts str) + (write-line (self 2) str (length str))) + +; First :puts, then :gets +(define (pug str limit waitms) (puts str) (gets limit waitms)) + +; First :puts, then collect :gets until nil +(define (pugs str limit waitms) (puts str) (collect (gets limit waitms))) + +; Poll the stdin pipe +(define (running? (timeout 1)) + (let ((FDS (pack "Lu" (self 2)))) + (>= 0 (poll FDS 1 timeout)))) diff --git a/tcltk.lsp b/tcltk.lsp new file mode 100755 index 0000000..f5084ac --- /dev/null +++ b/tcltk.lsp @@ -0,0 +1,24 @@ +#!/usr/bin/newlisp + +(load "coproc.lsp") + +(setf GUI (coproc "wish" true)) + +(define (GUI-events) + (while (and (setf FS (net-select (list 0 (GUI 3)) "r" -1)) + (not (member 0 FS))) + (let ((cmd (:gets GUI))) + (unless cmd (exit 0)) + (when (starts-with cmd "eval:") + (println (eval-string (println (5 cmd)))))))) + +(prompt-event GUI-events) + +(println (:pugs GUI [text] +frame .top +button .top.b -text "whatever" -command {puts "eval: hello"} +pack .top.b +pack .top +[/text] +)) + -- 2.39.2