/usr/share/doc/cl-uffi/examples/arrays.lisp is in cl-uffi 2.1.2-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: arrays.cl
;;;; Purpose: UFFI Example file to test arrays
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************
(in-package :cl-user)
(uffi:def-constant +column-length+ 10)
(uffi:def-constant +row-length+ 10)
(uffi:def-foreign-type long-ptr (* :long))
(defun test-array-1d ()
"Tests vector"
(let ((a (uffi:allocate-foreign-object :long +column-length+)))
(dotimes (i +column-length+)
(setf (uffi:deref-array a '(:array :long) i) (* i i)))
(dotimes (i +column-length+)
(format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
(uffi:free-foreign-object a))
(values))
(defun test-array-2d ()
"Tests 2d array"
(let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+)))
(dotimes (r +row-length+)
(declare (fixnum r))
(setf (uffi:deref-array a '(:array (* :long)) r)
(uffi:allocate-foreign-object :long +column-length+))
(let ((col (uffi:deref-array a '(:array (* :long)) r)))
(dotimes (c +column-length+)
(declare (fixnum c))
(setf (uffi:deref-array col '(:array :long) c) (+ (* r +column-length+) c)))))
(dotimes (r +row-length+)
(declare (fixnum r))
(format t "~&Row ~D: " r)
(let ((col (uffi:deref-array a '(:array (* :long)) r)))
(dotimes (c +column-length+)
(declare (fixnum c))
(let ((result (uffi:deref-array col '(:array :long) c)))
(format t "~d " result)))))
(uffi:free-foreign-object a))
(values))
#+examples-uffi
(test-array-1d)
#+examples-uffi
(test-array-2d)
|