Skip to content
Snippets Groups Projects
Commit e49874eb authored by toy's avatar toy
Browse files

Shorten the long lines to make TeX quieter.

parent 5e6c24e2
No related branches found
No related tags found
No related merge requests found
...@@ -631,10 +631,12 @@ function to initialize it, then returns a Lisp vector of all the ...@@ -631,10 +631,12 @@ function to initialize it, then returns a Lisp vector of all the
(let* ((num (slot f 'a)) (let* ((num (slot f 'a))
(result (make-array num))) (result (make-array num)))
;; ;;
;; Get a pointer to the array so that we don't have to keep extracting it: ;; Get a pointer to the array so that we don't have to keep
;; extracting it:
(with-alien ((a (* (array (* (struct foo)) 100)) (addr (slot f 'b)))) (with-alien ((a (* (array (* (struct foo)) 100)) (addr (slot f 'b))))
;; ;;
;; Loop over the first N elements and stash them in the result vector. ;; Loop over the first N elements and stash them in the
;; result vector.
(dotimes (i num) (dotimes (i num)
(setf (svref result i) (deref (deref a) i))) (setf (svref result i) (deref (deref a) i)))
result))) result)))
...@@ -809,22 +811,23 @@ must be an array of one of the following types: ...@@ -809,22 +811,23 @@ must be an array of one of the following types:
;; ... ... ;; ... ...
;; ;;
(let ((addr (+ 8 (logandc1 7 (kernel:get-lisp-obj-address data)))) (let ((addr (+ 8 (logandc1 7 (kernel:get-lisp-obj-address data))))
(type-size (let ((type (array-element-type data))) (type-size
(cond ((or (equal type '(signed-byte 8)) (let ((type (array-element-type data)))
(equal type '(unsigned-byte 8))) (cond ((or (equal type '(signed-byte 8))
1) (equal type '(unsigned-byte 8)))
((or (equal type '(signed-byte 16)) 1)
(equal type '(unsigned-byte 16))) ((or (equal type '(signed-byte 16))
2) (equal type '(unsigned-byte 16)))
((or (equal type '(signed-byte 32)) 2)
(equal type '(unsigned-byte 32))) ((or (equal type '(signed-byte 32))
4) (equal type '(unsigned-byte 32)))
((equal type 'single-float) 4)
4) ((equal type 'single-float)
((equal type 'double-float) 4)
8) ((equal type 'double-float)
(t 8)
(error "Unknown specialized array element type")))))) (t
(error "Unknown specialized array element type"))))))
(declare (type (unsigned-byte 32) addr) (declare (type (unsigned-byte 32) addr)
(optimize (speed 3) (safety 0) (ext:inhibit-warnings 3))) (optimize (speed 3) (safety 0) (ext:inhibit-warnings 3)))
(system:int-sap (the (unsigned-byte 32) (system:int-sap (the (unsigned-byte 32)
...@@ -952,7 +955,7 @@ whose contents is: ...@@ -952,7 +955,7 @@ whose contents is:
(setf (slot c-struct 's) "A Lisp String") (setf (slot c-struct 's) "A Lisp String")
(with-alien ((res (* (struct c-struct)) (with-alien ((res (* (struct c-struct))
(c-function 5 "Another Lisp String" (addr c-struct) ar))) (c-function 5 "Another Lisp String" (addr c-struct) ar)))
(format t "Returned from C function.~%") (format t "Returned from C function.~%")
(multiple-value-prog1 (multiple-value-prog1
(values (slot res 'x) (values (slot res 'x)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment