View of /lisp/test/daemon.l

Parent Directory

Revision Log

change to CVS wadalab font project

(defconst SYS_select 93)
(defconst SYS_socket 97)
(defconst SYS_accept 99)
(defconst SYS_bind 104)
(defconst SYS_listen 106)
(defconst SYS_shutdown 134)
(defconst SOCK_STREAM 1)
(defconst AF_INET 2)
(defconst INADDR_ANY (make-string 4))
(defun select (nfds rmask)
  (syscall SYS_select nfds rmask 0 0 0))
(defun socket ()
  (syscall SYS_socket AF_INET SOCK_STREAM 0))
(defun accept (sock addr addrlen)
  (syscall SYS_accept sock addr addrlen))
 ; for SPARC only
(defun htons (i) i)
(defun make-sockaddr (family port addr)
  (let ((ret (make-string 16))
	(newport (htons port)))
    (sset ret 0 (logand 255 (logshift family -8)))
    (sset ret 1 (logand 255 family))
    (sset ret 2 (logand 255 (logshift newport -8)))
    (sset ret 3 (logand 255 newport))
    (string-amend ret addr 4)))
(defun bind (sock family port addr)
  (syscall SYS_bind sock (make-sockaddr family port addr) 16))
(defun listen (sock count)
  (syscall SYS_listen sock count))
;
(defun shutdown (sock how)
  (syscall SYS_shutdown sock how))
;
(defun selbitref (bitarray index)
  (bref bitarray (- 31 index)))
;
(defun selbitset (bitarray index value)
  (bset bitarray (- 31 index) value))

;
(defun test (port)
  (lets ((sock (socket))
	 (origmask (make-string 4))
	 (rmask (make-string 4))
	 (newfd)(fdlist)(s1))
    (bind sock AF_INET port INADDR_ANY)
    (listen sock 5)
    (selbitset origmask sock t)
    (loop
     (do ((l fdlist (cdr l)))
       ((atom l))
       (prind (list "stream-modes = " (stream-mode (cadar l)))))
     (loop
      (string-amend rmask origmask)
      (and (<= 0 (select 32 rmask))(exit)))
     (do ((l fdlist (cdr l)))
       ((atom l))
       (prind (list "stream-modes = " (stream-mode (cadar l)))))
     (cond ((selbitref rmask sock)
	    (setq newfd (accept sock (make-sockaddr AF_INET 1211 INADDR_ANY)
				(make-string 4)))
	    (push (list newfd 
			(appendopen (stream newfd))) fdlist)
	    (prind (list "newfd=" newfd))
	    (selbitset origmask newfd t)))
     (do ((l fdlist (cdr l)))
       ((atom l))
       (cond ((selbitref rmask (caar l))
	      (prind (list "message from =" (caar l)))
	      (prind (list "stream-modes = " (stream-mode (cadar l))
			   (stream-mode (cadar l))))
	      (prind (list "openfiles " openfiles))
	      (let ((curfd (caar l))
		    (rstream (cadar l))
		    (err:end-of-file (function (lambda (x (y))
						 (setq fdlist (remq (assq curfd fdlist) fdlist))
						 (selbitset origmask curfd nil)
						 (prind (list "shutdown " (shutdown curfd 2)))
;						 (close rstream)
;						 (close wstream)
						 (prind (list "openfiles " openfiles))
						 (exit)))))
		(setq r (readline (cadar l))))
	      (prind (list "read =" r))
;	      (setq r (eval r))
	      (prind (list "write = " r))
	      (print r (cadar l))))))))