[Gcl-devel] Re: Parallel GCL

[Camm Maguire]

Greetings!  Just a tidbit for those interested. Here is an example of
GCL's fasd i/o, which appears to be some sort of rudimentary byte
compiler of lisp objects.  Right now, open_fasd will not accept socket
streams, but this is an easy fix.  When done, one can do a crude
parallelism entirely from within lisp as shown at the bottom, though
we likely would not content ourselves with this.

This is not a serious answer, just FYI.

=============================================================================
(defun foo (p)
  (let (r)
    (with-open-file 
     (s p) 
     (do nil ((let ((z (read s nil 'eof))) (or (eq 'eof z) (and  (push z r) 
nil))) (nreverse r))))))
  
(defun baq (a p)
  (with-open-file 
   (s p :direction :output) 
   (prin1 a s)
   nil))

(defun foo1 (p)
  (let (r)
    (with-open-file 
     (s p) 
     (do nil ((let ((z (read s nil 'eof))) (or (eq 'eof z) (setq r z))) r)))))

(defun bar (a p)
  (with-open-file 
   (s p :direction :output) 
   (let* ((h (make-hash-table :test 'eq))
          (x (si::open-fasd s :output 'eof h))) 
     (si::find-sharing-top a h) 
     (si::write-fasd-top a x)
     (si::close-fasd x))))

(defun baz (p)
  (let (r)
    (with-open-file 
     (s p) 
     (let* ((v (make-array 10))
            (x (si::open-fasd s :input 'eof v)))
       (setq r (si::read-fasd-top x))
       (si::close-fasd x)))
    r))

=============================================================================
>(setq a (foo "../lsp/gcl_predlib.lsp") b nil)

NIL

>(time (dotimes (i 100) (baq a "/tmp/baq")))

real time       :      3.230 secs
run-gbc time    :      3.140 secs
child run time  :      0.000 secs
gbc time        :      0.000 secs
NIL

>(time (dotimes (i 100) (setq b (foo1 "/tmp/baq"))))

real time       :      1.160 secs
run-gbc time    :      1.140 secs
child run time  :      0.000 secs
gbc time        :      0.000 secs
NIL

>(time (dotimes (i 100) (bar a "/tmp/bar")))

real time       :      3.430 secs
run-gbc time    :      3.170 secs
child run time  :      0.000 secs
gbc time        :      0.240 secs
NIL

>(time (dotimes (i 100) (setq c (baz "/tmp/bar"))))

real time       :      0.350 secs
run-gbc time    :      0.340 secs
child run time  :      0.000 secs
gbc time        :      0.000 secs
NIL

>(with-open-file (s "/tmp/baq") (with-open-file (q "/tmp/bar") (values 
>(file-length s) (file-length q))))

55867
18105

>(equal a b )

T

>(equal a c )

T

>
============================================================================
(setq s (si::socket 1919 
                :server (lambda (s) 
                        (let* ((h (make-hash-table :test 'eq))
                               (x (si::open-fasd s :output 'eof h))
                               (a (do-computation-here-in-chile)))
                            (si::find-sharing-top a h) 
                            (si::write-fasd-top a x)
                            (si::close-fasd x)
                            (quit)))))

(let ((s (si::socket 1919 :host "localhost"))
       r)
    (let* ((v (make-array 10))
           (x (si::open-fasd s :input 'eof v)))
      (setq r (si::read-fasd-top x))
      (si::close-fasd x)))
  r)
=============================================================================
Polling the socket via #'listen is available.


Take care,
-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah