- (ls-read stream eof-error-p eof-value t)
- (prog2 (ls-read stream)
- (ls-read stream eof-error-p eof-value t)))))
- ((and ch (digit-char-p ch))
- (let ((id (digit-char-p ch)))
- (while (and (%peek-char stream)
- (digit-char-p (%peek-char stream)))
- (setf id (+ (* id 10) (digit-char-p (%read-char stream)))))
- (ecase (%peek-char stream)
- (#\=
- (%read-char stream)
- (if (find-labelled-object id)
- (error "Duplicated label #~S=" id)
- (progn
- (add-labelled-object id *future-value*)
- (let ((obj (ls-read stream eof-error-p eof-value t)))
- ;; FIXME: somehow the more natural
- ;; (setf (cdr (find-labelled-object id)) obj)
- ;; doesn't work
- (rplacd (find-labelled-object id) obj)
- obj))))
- (#\#
- (%read-char stream)
- (let ((cell (find-labelled-object id)))
- (if cell
- (if (eq (cdr cell) *future-value*)
- (progn
- (push (cons (funcall *make-fixup-function*)
- id)
- *fixup-locations*)
- *fixup-value*)
- (cdr cell))
- (error "Invalid labelled object #~S#" id)))))))
- (t
- (error "Invalid dispatch character after #")))))
+ (ls-read stream eof-error-p eof-value t)
+ (prog2 (ls-read stream)
+ (ls-read stream eof-error-p eof-value t)))))
+ ((#\J #\j)
+ (unless (char= (%peek-char stream) #\:)
+ (error "FFI descriptor must start with a semicolon."))
+ (let ((descriptor (subseq (read-until stream #'terminalp) 1))
+ (subdescriptors nil))
+ (do* ((start 0 (1+ end))
+ (end (position #\: descriptor :start start)
+ (position #\: descriptor :start start)))
+ ((null end)
+ (push (subseq descriptor start) subdescriptors)
+ `(oget *root* ,@(reverse subdescriptors)))
+ (push (subseq descriptor start end) subdescriptors))))
+ (otherwise
+ (cond
+ ((and ch (digit-char-p ch))
+ (let ((id (digit-char-p ch)))
+ (while (and (%peek-char stream)
+ (digit-char-p (%peek-char stream)))
+ (setf id (+ (* id 10) (digit-char-p (%read-char stream)))))
+ (ecase (%peek-char stream)
+ (#\=
+ (%read-char stream)
+ (if (find-labelled-object id)
+ (error "Duplicated label #~S=" id)
+ (progn
+ (add-labelled-object id *future-value*)
+ (let ((obj (ls-read stream eof-error-p eof-value t)))
+ ;; FIXME: somehow the more natural
+ ;; (setf (cdr (find-labelled-object id)) obj)
+ ;; doesn't work
+ (rplacd (find-labelled-object id) obj)
+ obj))))
+ (#\#
+ (%read-char stream)
+ (let ((cell (find-labelled-object id)))
+ (if cell
+ (if (eq (cdr cell) *future-value*)
+ (progn
+ (push (cons (funcall *make-fixup-function*)
+ id)
+ *fixup-locations*)
+ *fixup-value*)
+ (cdr cell))
+ (error "Invalid labelled object #~S#" id)))))))
+ (t
+ (error "Invalid dispatch character after #")))))))