21 |
;;;; (send-message <lisp-expr> <optional dest = 1>) |
;;;; (send-message <lisp-expr> <optional dest = 1>) |
22 |
;;;; (broadcast-message <lisp-expr>) ; no reply message |
;;;; (broadcast-message <lisp-expr>) ; no reply message |
23 |
;;;; (receive-message <optional source = (MPI-Any-source)>) |
;;;; (receive-message <optional source = (MPI-Any-source)>) |
|
;;;; (defun send-receive-message <lisp-expr> <optional dest = 1>) |
|
24 |
;;;; (send-receive-message <lisp-expr> <optional dest = 1>) |
;;;; (send-receive-message <lisp-expr> <optional dest = 1>) |
25 |
;;;; (free-msg-buffer <buf>) ; optimization for greater efficiency, only |
;;;; (free-msg-buffer <buf>) ; optimization for greater efficiency, only |
26 |
;;;; ; frees message buffer for re-use in next MPI-recv |
;;;; ; frees message buffer for re-use in next MPI-recv |
151 |
(MPI-Send message dest tag) |
(MPI-Send message dest tag) |
152 |
nil) |
nil) |
153 |
|
|
154 |
;;; Still writing this. |
(defun fix-read-write-consistency (str &aux preamble-begin preamble-end end) |
155 |
;;; must handle #'foo => (lambda-block ...) |
"Change #<compiled-function ...> and #<interpreted-function ...> to #'... |
156 |
;;; and #'(lambda ...) => (lambda-closure () () () ...) |
Works solely by modifying str argument" |
157 |
#- not-a-feature |
(setq preamble-begin (si:string-match "#<[a-z]*-function " str)) |
158 |
(defun fix-read-write-consistency (str) str) |
(if (= preamble-begin -1) (return-from fix-read-write-consistency str)) |
159 |
#+ not-a-feature |
;; CHANGE: '#<...> ==> #<...> |
160 |
(defun fix-read-write-consistency (str) |
;; since later, #<...> become #'(lambda (...) ...) |
161 |
"Change #<compiled-function ...> and #<interpreted-function ...> to #'..." |
;; Presumably, other special functions, besides "quote" could also be a problem. |
162 |
;; This doesn't work if ">" (greater than) is used as a function. |
(if (and (> preamble-begin 0) (eq (aref str (- preamble-begin 1)) #\')) |
163 |
;; Really have to use "read-from-string" and be prepared to catch error. |
(setf (aref str (- preamble-begin 1)) #\space)) |
164 |
(setq a (si:string-match "#<[a-z]*-function ")) |
(setq preamble-end (si:match-end 0)) |
165 |
(setq b (si:match-end 0)) |
(fix-read-write-consistency |
166 |
(setq c (length (format nil "~a" (read-from-string |
(make-array (- (length str) preamble-end) |
167 |
(make-array :element-type 'character |
:element-type (array-element-type str) |
168 |
:displaced-to str |
:displaced-to str |
169 |
:displaced-index-offset (si:match-end 0)))))) |
:displaced-index-offset preamble-end)) |
170 |
(setf (aref str a) #\' ) ; #< ==> #' |
(multiple-value-bind (expr expr-end) |
171 |
(fill str #\space :start (+ a 1) :end b) ; ...-function ==> _spaces_ |
(read-from-string str t nil :start preamble-end) |
172 |
(if lambda-block rewrite it or macroexpand it) |
(loop (if (memq (aref str (- expr-end 1)) '(#\tab #\newline #\space)) |
173 |
(setf (aref str (+ b c)) #\) ) ; > ==> right_paren |
(decf expr-end) |
174 |
si:match-end |
(return))) |
175 |
si:match-beginning |
(when (eq #\> (aref str (1- expr-end))) ; when: #<compiled-function mapcar> |
176 |
) |
(decf expr-end) |
177 |
|
(setq expr (read-from-string str t nil :start preamble-end :end expr-end))) |
178 |
|
(setq end (1+ (si:string-match ">" str expr-end))) ; start at expr-end |
179 |
|
;; fill with spaces following '#' of '#<...>' |
180 |
|
(fill str #\space :start (+ preamble-begin 1) :end end) |
181 |
|
(setf (aref str (+ preamble-begin 1)) #\' ) ; #< ==> #' |
182 |
|
(with-output-to-string (stream |
183 |
|
(make-array (- (length str) preamble-begin 2) |
184 |
|
:fill-pointer 0 |
185 |
|
:element-type (array-element-type str) |
186 |
|
:displaced-to str |
187 |
|
:displaced-index-offset (+ preamble-begin 2))) |
188 |
|
(write (cond ((not (listp expr)) expr) |
189 |
|
;; (lambda-block (x) (+ x 1)) => |
190 |
|
((eq (first expr) 'lambda-block) |
191 |
|
(list 'lambda (third expr) |
192 |
|
(list* 'block (second expr) (cdddr expr)))) |
193 |
|
;; (lambda-closure () () () (x) (+ x 1)) => |
194 |
|
((eq (first expr) 'lambda-closure) |
195 |
|
(cons 'lambda (cddddr expr)))) |
196 |
|
;; :circle t okay; body of fnc shouldn't be so large to blow stack |
197 |
|
:stream stream :escape t :level nil :length nil :array t :circle t |
198 |
|
))) |
199 |
|
str) |
200 |
|
|
201 |
(defun receive-message (&optional (source (MPI-Any-source)) (tag (MPI-Any-tag)) |
(defun receive-message (&optional (source (MPI-Any-source)) (tag (MPI-Any-tag)) |
202 |
&aux (datatype -10) (type-enum -1) (type NIL) |
&aux (datatype -10) (type-enum -1) (type NIL) |