3
$Id: valclass.scm,v 1.5 2002/02/08 03:08:55 cph Exp $
5
Copyright (c) 1989, 1990, 1999, 2002 Massachusetts Institute of Technology
7
This program is free software; you can redistribute it and/or modify
3
$Id: valclass.scm,v 1.9 2003/02/14 18:28:08 cph Exp $
5
Copyright 1989,1990,1999,2001,2002,2003 Massachusetts Institute of Technology
7
This file is part of MIT/GNU Scheme.
9
MIT/GNU Scheme is free software; you can redistribute it and/or modify
8
10
it under the terms of the GNU General Public License as published by
9
11
the Free Software Foundation; either version 2 of the License, or (at
10
12
your option) any later version.
12
This program is distributed in the hope that it will be useful, but
14
MIT/GNU Scheme is distributed in the hope that it will be useful, but
13
15
WITHOUT ANY WARRANTY; without even the implied warranty of
14
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15
17
General Public License for more details.
17
19
You should have received a copy of the GNU General Public License
18
along with this program; if not, write to the Free Software
19
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
along with MIT/GNU Scheme; if not, write to the Free Software
21
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
22
26
;;;; RTL Value Classes
73
77
(loop (car x) (cdr x) (cdr y))
79
(lambda (form environment)
80
(let ((name (cadr form))
81
(parent-name (caddr form)))
82
(let* ((name->variable
84
(symbol-append 'VALUE-CLASS= name)))
85
(variable (name->variable name))
86
(var-ref (close-syntax variable environment)))
92
(close-syntax (name->variable parent-name)
95
(DEFINE (,(symbol-append variable '?) CLASS)
96
(VALUE-CLASS/ANCESTOR-OR-SELF? CLASS ,variable))
97
(DEFINE (,(symbol-append 'REGISTER- variable '?) REGISTER)
98
(VALUE-CLASS/ANCESTOR-OR-SELF?
99
(REGISTER-VALUE-CLASS REGISTER)
101
(define-value-class value #f)
102
(define-value-class float value)
103
(define-value-class word value)
104
(define-value-class object word)
105
(define-value-class unboxed word)
106
(define-value-class address unboxed)
107
(define-value-class immediate unboxed)
108
(define-value-class ascii immediate)
109
(define-value-class datum immediate)
110
(define-value-class fixnum immediate)
111
(define-value-class type immediate))
b'\\ No newline at end of file'
80
(define-syntax define-value-class
82
(lambda (form environment)
83
(let ((name (cadr form))
84
(parent-name (caddr form)))
85
(let* ((name->variable
87
(symbol-append 'VALUE-CLASS= name)))
88
(variable (name->variable name)))
94
(close-syntax (name->variable parent-name)
97
(DEFINE (,(symbol-append variable '?) CLASS)
98
(VALUE-CLASS/ANCESTOR-OR-SELF? CLASS ,variable))
99
(DEFINE (,(symbol-append 'REGISTER- variable '?) REGISTER)
100
(VALUE-CLASS/ANCESTOR-OR-SELF?
101
(REGISTER-VALUE-CLASS REGISTER)
104
(define-value-class value #f)
105
(define-value-class float value)
106
(define-value-class word value)
107
(define-value-class object word)
108
(define-value-class unboxed word)
109
(define-value-class address unboxed)
110
(define-value-class immediate unboxed)
111
(define-value-class ascii immediate)
112
(define-value-class datum immediate)
113
(define-value-class fixnum immediate)
114
(define-value-class type immediate)
b'\\ No newline at end of file'
added
removed
src/compiler/rtlbase/valclass.scm
