[Openmcl-devel] getting CCL ready for CS graphics courses
Terje Norderhaug
terje at in-progress.com
Thu Jan 8 17:37:44 PST 2009
On Jan 8, 2009, at 5:05 PM, Alexander Repenning wrote:
> 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.
What about only looking up the value at compile time? As in:
(glColor3fv #.{0.5 0.1 0.8})
> Well, and if you read the {... } expression
> over and over, say by recompiling, you memory leak these vectors.
> Realistically not a problem.
A weak hash table may solve that.
> 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
>
>
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/mailman/listinfo/openmcl-devel
More information about the Openmcl-devel
mailing list