Welcome to the CHICKEN Scheme pasting service

(define process-execute
  (let* ((pathname-strip-directory pathname-strip-directory)
	 (c-string->allocated-pointer
	  (foreign-lambda* c-pointer ((scheme-object o))
	    "char *ptr = malloc(C_header_size(o)); \n"
	    "if (ptr != NULL) {\n"
	    "  C_memcpy(ptr, C_data_pointer(o), C_header_size(o)); \n"
	    "}\n"
	    "C_return(ptr);"))
	
	 (free-buffer-array
	  (lambda (buffer-array)
	    (let ((size (pointer-vector-length buffer-array)))
	      (do ((i 0 (fx+ i 1)))
		  ((fx= i size))
		(and-let* ((s (pointer-vector-ref buffer-array i)))
		  (free s))))))

	 (copy&set-c-string!
	  (lambda (buffer-array i s)
	    ;; This avoids embedded NULs and appends a NUL, so "cs" is
	    ;; safe to copy and use as-is in the pointer-vector.
	    (let* ((cs (##sys#make-c-string s 'process-execute))
		   (csp (c-string->allocated-pointer cs)))
	      (unless csp (error "Out of memory in process-execute"))
	      (pointer-vector-set! buffer-array i csp))))

	 ;; TODO: Dynamically determine
	 (arg-max (foreign-value "ARG_MAX" size_t))
	 (env-max (foreign-value "ENV_MAX" size_t))

	 (execvp (foreign-lambda int "C_execvp"
		   c-string pointer-vector))
	 (execve (foreign-lambda int "C_execve"
		   c-string pointer-vector pointer-vector)))
    (lambda (filename #!optional (arglist '()) envlist)
      (##sys#check-string filename 'process-execute)
      (##sys#check-list arglist 'process-execute)
      (when envlist (##sys#check-list envlist 'process-execute))

      (let* ((stripped-filename (pathname-strip-directory filename))
	     (argcount (##sys#length arglist))
	     (envcount (and envlist (##sys#length envlist)))
	     ;; NUL-terminated, so we must add one, and we also store
	     ;; the filename in argv[0], so add another.
	     (argbuf (make-pointer-vector (+ argcount 2) #f))
	     (envbuf (and envcount
			  (make-pointer-vector (+ envcount 1) #f))))
	;; TODO: Check before making the vector?  Doesn't matter much.
	(##sys#check-range argcount 0 arg-max 'process-execute)
	(when envlist
	  (##sys#check-range envcount 0 env-max 'process-execute))

	(handle-exceptions exn
	    ;; Free to avoid memory leak, then reraise
	    (begin (free-buffer-array argbuf)
		   (when envbuf (free-buffer-array envbuf))
		   (signal exn))

	  (copy&set-c-string! argbuf 0 stripped-filename)

	  (do ((al arglist (cdr al))
	       (i 1 (fx+ i 1)) )
	      ((or (null? al) (fx> i argcount))) ; Should coincide
	    (copy&set-c-string! argbuf i (car al)) )

	  (do ((el (or envlist '()) (cdr el))
	       (i 0 (fx+ i 1)) )
	      ((or (null? el) (fx= i envcount))) ; Should coincide
	    (copy&set-c-string! envbuf i (car el)) )

	  (let ((r (if envlist
		       (execve filename argbuf envbuf)
		       (execvp filename argbuf) )) )
	    (when (fx= r -1)
	      (posix-error #:process-error 'process-execute "cannot execute process" filename) ) ))) ) ) )