From e4010c4542ebfdb0f95c15b391648eafa7d64949 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 18 Mar 2002 02:27:32 +0000 Subject: [PATCH] r1584: *** empty log message *** --- doc/ref.sgml | 6 +++--- examples/array-2d.cl | 37 +++++++++++++++++++++++++++++++++++++ src/objects.cl | 22 +++++++++++++++++++++- src/primitives.cl | 5 +++-- test-examples.cl | 5 +++-- tests/array-2d.cl | 37 +++++++++++++++++++++++++++++++++++++ 6 files changed, 104 insertions(+), 8 deletions(-) create mode 100644 examples/array-2d.cl create mode 100644 tests/array-2d.cl diff --git a/doc/ref.sgml b/doc/ref.sgml index 51d61b4..e8c45fd 100644 --- a/doc/ref.sgml +++ b/doc/ref.sgml @@ -496,7 +496,7 @@ structure. It's type is :pointer-self. - def-slot-value + get-slot-value Retrieves a value from a slot of a structure. Macro @@ -830,7 +830,7 @@ the array. Examples (def-struct ab (a :int) (b :double)) -(allocate-foreign-object 'ab) +(allocate-foreign-object ab) => #<ptr> @@ -958,7 +958,7 @@ the array. Syntax - def-pointer ptr type => value + deref-pointer ptr type => value diff --git a/examples/array-2d.cl b/examples/array-2d.cl new file mode 100644 index 0000000..9e344db --- /dev/null +++ b/examples/array-2d.cl @@ -0,0 +1,37 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: array-2d.cl +;;;; Purpose: UFFI Example file use 2-dimensional arrays +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: Mar 2002 +;;;; +;;;; $Id: array-2d.cl,v 1.1 2002/03/18 02:27:32 kevin Exp $ +;;;; +;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; +;;;; UFFI users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* + +(in-package :cl-user) + +(uffi:def-constant +column-length+ 10) + +(uffi:def-array long-array (:long 10)) + +(defun test-array-2d () + "Tests 2d array" + (let ((a (uffi:allocate-foreign-object long-array))) + (dotimes (i +column-length+) + (setf (uffi:deref-array a :long i) (* i i))) + (dotimes (i +column-length+) + (format "~&~D => ~D" i (uffi:deref-array a 'long-array i))) + (uffi:free-foreign-object a))) + +#+test-uffi +(test-array-2d) + + diff --git a/src/objects.cl b/src/objects.cl index 0f28115..0188430 100644 --- a/src/objects.cl +++ b/src/objects.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: objects.cl,v 1.6 2002/03/17 17:33:30 kevin Exp $ +;;;; $Id: objects.cl,v 1.7 2002/03/18 02:27:28 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -75,3 +75,23 @@ #+allegro obj ) + +(defmacro allocate-byte-array (nsize) + #+cmu + `(alien:make-alien (alien:unsigned 8) ,nsize) + #+lispworks + `(fli:allocate-foreign-object :type :byte :nelems ,nsize) + #+allegro + `(ff:allocate-fobject (array :byte ,nsize)) +) + +(defmacro deref-byte-array (array position) + #+cmu `(alien:deref ,array ,position) + #+lispworks `(fli:dereference ,array :index ,position) + #+allegro `(ff:fslot-value-typed '(:array :byte) :c ,array ,position) +) + + + + +) diff --git a/src/primitives.cl b/src/primitives.cl index 0048668..40bc449 100644 --- a/src/primitives.cl +++ b/src/primitives.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: primitives.cl,v 1.8 2002/03/17 17:33:30 kevin Exp $ +;;;; $Id: primitives.cl,v 1.9 2002/03/18 02:27:28 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -78,7 +78,8 @@ supports takes advantage of this optimization." (:char . c-call:char) (:unsigned-char . (alien:unsigned 8)) (:byte . (alien:unsigned 8)) - (:short . c-call:unsigned-short) (:unsigned-short c-call:unsigned-short) + (:short . c-call:unsigned-short) + (:unsigned-short . c-call:unsigned-short) (:int . alien:integer) (:unsigned-int . c-call:unsigned-int) (:long . c-call:long) (:unsigned-long . c-call:unsigned-long) (:float . c-call:float) (:double . c-call:double) diff --git a/test-examples.cl b/test-examples.cl index c8fa0ac..2a4c100 100644 --- a/test-examples.cl +++ b/test-examples.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: test-examples.cl,v 1.4 2002/03/17 17:33:30 kevin Exp $ +;;;; $Id: test-examples.cl,v 1.5 2002/03/18 02:27:32 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -26,7 +26,8 @@ :type "cl" :directory '(:relative "examples")) *load-truename*)))) - + + (load-test "array-2d") (load-test "strtol") (load-test "gettime") (load-test "getenv") diff --git a/tests/array-2d.cl b/tests/array-2d.cl new file mode 100644 index 0000000..9e344db --- /dev/null +++ b/tests/array-2d.cl @@ -0,0 +1,37 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: array-2d.cl +;;;; Purpose: UFFI Example file use 2-dimensional arrays +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: Mar 2002 +;;;; +;;;; $Id: array-2d.cl,v 1.1 2002/03/18 02:27:32 kevin Exp $ +;;;; +;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; +;;;; UFFI users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* + +(in-package :cl-user) + +(uffi:def-constant +column-length+ 10) + +(uffi:def-array long-array (:long 10)) + +(defun test-array-2d () + "Tests 2d array" + (let ((a (uffi:allocate-foreign-object long-array))) + (dotimes (i +column-length+) + (setf (uffi:deref-array a :long i) (* i i))) + (dotimes (i +column-length+) + (format "~&~D => ~D" i (uffi:deref-array a 'long-array i))) + (uffi:free-foreign-object a))) + +#+test-uffi +(test-array-2d) + + -- 2.34.1