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

Alexander Repenning ralex at cs.colorado.edu
Fri Jan 9 01:05:33 UTC 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