[Openmcl-devel] getting CCL ready for CS graphics courses
Alexander Repenning
ralex at cs.colorado.edu
Thu Jan 8 17:05:33 PST 2009
Gary,
wow, a lot of information. This will take me some time to absorb ;-)
thank you.
At least for the vector caveat we have a solution. The approach taken
may sound a bit crazy. We are implementing vector constants with a
combination of Lisp readers and Universally Unique Identifiers.
Perhaps not super elegant, there is bound to be a better solution, but
it works. Code at the end. A call to a vector function looks like this
(glColor3fv {0.5 0.1 0.8})
which is pretty close to what students "know" from C. The only issue
is that getting the cached value is not that fast. The hash table
access it the bottleneck. Well, and if you read the {... } expression
over and over, say by recompiling, you memory leak these vectors.
Realistically not a problem.
The more Lispy way would be something like
(with-vector (v 0.5 0.1 0.8)
(glColor3fv v))
C or Java users don't like this. Perhaps more compelling to Lisp
programers is that this is actually quite a bit slower because the
vector needs to be allocated and initialized each time it is used (in
CCL this is about 5x slower).
On Jan 8, 2009, at 4:59 PM, Gary Byers wrote:
> 4) A lot of OpenGL functions take arguments and return results
> by value (as glColor3f does), so the idea of treating them as
> simple lisp functions makes sense. Other cases may be harder
> to map directly: glColor3fv takes a "vector" (C pointer) that's
> presumed to point to 3 :<GL>floats. If you want to support
> that, you may have to decide whether to expose the FFI (e.g.,
> make the caller stack-cons a "vector of 3 floats" and pass the raw
> pointer in, or do it for them (e.g., have the function
> accept a lisp vector and copy its contents to a foreign vector
> that the function allocates itself.) It's probably hard to
> automate the translation process, and it might be wise to
> just do the low-level thing and discourage students from using
> the "v" functions, at least initialy.
;;;;-*- Mode: Lisp; Package: LUI -*-
;*********************************************************************
;* *
;* M E M O R Y *
;* *
;*********************************************************************
;* Author : Alexander Repenning (alexander at agentsheets.com) *
;* http://www.agentsheets.com *
;* Copyright : (c) 1996-2008, AgentSheets Inc. *
;* Filename : memory.lisp *
;* Updated : 12/22/08 *
;* Version : *
;* 1.0 : based on AGL.lisp v 1.2.6 *
;* SW/HW : CCL 1.2 OS X, Mac PPC, Intel *
;* Abstract : Tools to create and access memory *
;* *
;******************************************************************
(in-package :lui)
(export '(sizeof make-vector dispose-vector))
;;______________________________________________________________
;; Universally Unique Identifier (UUID) |
;; http://en.wikipedia.org/wiki/Universally_Unique_Identifier |
;;_____________________________________________________________/
(defun UNIVERSALLY-UNIQUE-IDENTIFIER () "
Return an Universally Unique Identifier (UUID). An UUID is an
identifier standard
used in software construction, standardized by the Open Software
Foundation (OSF) as
part of the Distributed Computing Environment (DCE)"
(ccl::lisp-string-from-nsstring (#_CFUUIDCreateString (%null-ptr)
(#_CFUUIDCreate (%null-ptr)))))
;;_____________________
;; Sizeof |
;;____________________/
(defgeneric SIZEOF (Object)
(:documentation "the size of object in memory. Object can be
instance or type name"))
(defmethod SIZEOF ((Self float)) 4)
(defmethod SIZEOF ((Self double-float)) 8)
(defmethod SIZEOF ((Self fixnum)) 4)
(defmethod SIZEOF ((Type (eql 'float))) 4)
(defmethod SIZEOF ((Type (eql 'double-float))) 8)
(defmethod SIZEOF ((Type (eql 'fixnum))) 4)
(defmethod SIZEOF ((Self macptr))
(#_GetPtrSize Self))
;;_____________________
;; Memory Vectors |
;;____________________/
(defun MAKE-VECTOR (&rest Values) "
in: &rest Values
out: Vector.
Create a vector initialized with <Values>.
Vector is not automatically deallocated."
(let* ((Index 0)
(Size (reduce #'+ Values :key #'sizeof))
(&Vector (#_NewPtr Size)))
(dolist (Value Values &Vector)
(etypecase Value
(fixnum (setf (%get-long &Vector Index) Value))
(single-float (setf (%get-single-float &Vector Index) Value))
(double-float (setf (%get-double-float &Vector Index) Value)))
(incf Index (sizeof Value)))))
(defun DISPOSE-VECTOR (Vector) "
in: Vector.
Dispose of vector."
(#_DisposePtr Vector))
(defmacro WITH-VECTOR ((Vector &rest Values) &body Forms)
`(let ((,Vector (make-vector , at Values)))
(unwind-protect
, at Forms
(dispose-vector ,Vector))))
;;_____________________
;; Vectors Access |
;;____________________/
(defun GET-BYTE (Vector &optional (Offset 0)) "
in: Vector *bye, &optional Offset int default 0.
out: Byte byte.
Return byte at offset."
(%get-byte Vector Offset))
(defun GET-LONG (Vector &optional (Offset 0)) "
in: Vector *bye, &optional Offset int default 0.
out: Float
Return Float at byte offset."
(%get-long Vector Offset))
(defun GET-SINGLE-FLOAT (Vector &optional (Offset 0)) "
in: Vector *bye, &optional Offset int default 0.
out: Float
Return Float at byte offset."
(%get-single-float Vector Offset))
(defun GET-DOUBLE-FLOAT (Vector &optional (Offset 0)) "
in: Vector *bye, &optional Offset int default 0.
out: Float
Return Float at byte offset."
(%get-double-float Vector Offset))
;;_________________________________
;; Vector Constants with Reader |
;; e.g. {0.5 0.6 0.7} |
;;________________________________/
(defvar *Cached-Vectors* (make-hash-table :test #'eq) "Cached
pointers, do not save")
(defun GET-CACHED-VECTOR (Key &rest Values) "
in: Key symbol; &rest Values.
out: Vector
Returns vector. Use key to cache and implement constant pointers"
(or
(gethash Key *Cached-Vectors*)
(setf (gethash Key *Cached-Vectors*) (apply #'make-vector Values))))
(defun READ-NUMBER (Stream)
(read-from-string
(with-output-to-string (Out)
(loop
(let ((Char (read-char Stream nil nil)))
(case Char
((#\} #\Space)
(unread-char Char Stream)
(return))
(t (write-char Char Out))))))))
(defun VECTOR-READER (Stream Char)
(declare (ignore Char))
(let ((Numbers nil))
(loop
(let ((Char (read-char Stream nil #\])))
(case Char
(#\} (return `(get-cached-vector
',(intern (universally-unique-identifier))
,@(reverse Numbers))))
((#\Space #\Newline))
(t (unread-char Char Stream)
(push (read-number Stream) Numbers)))))))
(set-macro-character #\{ #'vector-reader)
#| Examples:
(sizeof pi)
(sizeof 3.14)
(make-vector 3.1415 7.5 6.7)
(with-vector (V 1.0 2.0 3.0)
(dotimes (i 3)
(print (get-single-float v (* i #.(sizeof 0.0))))))
;; eval a couple of times: notice, pointer address is different every
time
{3.14 5.0 3.0}
;; but
(defun TEST ()
{3.14 5.0 3.0})
;; this function will return the SAME vector, i.e., pointer at same
address
;; with same content every time, until you eval the function
definition again
;; consider this to be a constant: do not dispose
(test)
(get-single-float (test))
(get-single-float (test) #.(* 1 (sizeof 0.0)))
(get-single-float (test) #.(* 2 (sizeof 0.0)))
(defun TEST2 ()
(make-vector 3.14 5.0 3.0))
(test2)
(sizeof {0.5d0 0.6d0 0.7d0})
(sizeof {0.5 0.6 0.7})
(sizeof {1 2 3})
|#
Prof. Alexander Repenning
University of Colorado
Computer Science Department
Boulder, CO 80309-430
vCard: http://www.cs.colorado.edu/~ralex/AlexanderRepenning.vcf
More information about the Openmcl-devel
mailing list