head	1.3;
access;
symbols;
locks; strict;


1.3
date	94.10.31.04.11.27;	author ram;	state Exp;
branches;
next	1.2;

1.2
date	91.02.08.13.32.02;	author ram;	state Exp;
branches;
next	1.1;

1.1
date	90.02.06.17.24.01;	author ram;	state Exp;
branches;
next	;


desc
@@


1.3
log
@Fix headed boilerplate.
@
text
@;;; -*- Mode: Lisp; Package: Lisp -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: $")
;;;
;;; **********************************************************************
;;;
;;; DefRecord -- a thing to take the place of DefAlienStructure.

(in-package 'lisp)
(in-package 'system)
(export '(defrecord record-size))
(in-package 'lisp)

(defun concat-pnames* (name1 name2)
  (if name1
      (make-symbol (concatenate 'simple-string (symbol-name name1)
				(symbol-name name2)))
      name2))

#-new-compiler
(eval-when (compile)
  (setq lisp::*bootstrap-defmacro* t))


;;; We want to be able to do something like this:
;;;
;;; (defrecord message
;;;   (simplep boolean (words 1))
;;;   (size (signed-byte 32) (long-words 1))
;;;   (type (signed-byte 32) (long-words 1))
;;;   (local-port port (long-words 1))
;;;   (remote-port port (long-words 1))
;;;   (id (signed-byte 32) (long-words 1)))
;;;

(defmacro defrecord (name &rest slots)
  `(progn
    ,(do ((slots slots (cdr slots))
	   (bit-index 0)
	   (defops ())
	   (prefix (concat-pnames* name '-)))
	  ((null slots)
	   `(eval-when ,*alien-eval-when*
	     ,@@(nreverse defops)
	     (setf (get ',name 'record-size) ,bit-index)))
	(let* ((slot (car slots))
	       (slot-name (car slot))
	       (type (cadr slot))
	       (size (eval (caddr slot))))
	  (push
	   `(defoperator (,(concat-pnames prefix slot-name) ,type) ((,name ,name))
	      `(alien-index (alien-value ,,name) ,',bit-index ,',size))
	   defops)
	  (incf bit-index size)))))

(defun record-size (name)
  (or (get name 'record-size)
      (error "~S is not a defined record." name)))

#-new-compiler
(eval-when (compile)
  (setq lisp::*bootstrap-defmacro* nil))
@


1.2
log
@New file header with RCS header FILE-COMMENT.
@
text
@a5 2
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@@cs.cmu.edu.
@


1.1
log
@Initial revision
@
text
@d4 8
a11 5
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@@CMUC). 
@