[Openmcl-devel] getting CCL ready for CS graphics courses

Terje Norderhaug terje at in-progress.com
Fri Jan 9 01:37:44 UTC 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