1 /*===========================================================================
2 * FileName : imm-test.c
3 * About : Efficiency evaluation for immediate constant values (temporary)
4 *
5 * Copyright (C) 2005-2006 YamaKen
6 * Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
7 *
8 * All rights reserved.
9 *
10 * Redistribution and use in source and binary forms, with or without
11 * modification, are permitted provided that the following conditions
12 * are met:
13 *
14 * 1. Redistributions of source code must retain the above copyright
15 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
19 * 3. Neither the name of authors nor the names of its contributors
20 * may be used to endorse or promote products derived from this software
21 * without specific prior written permission.
22 *
23 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
24 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
25 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
27 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
29 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
30 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
31 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
32 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
33 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34 ===========================================================================*/
35
36 #define NULL ((void *)0)
37
38 #define SCM_VALUE_MASK (~0 ^ (SCM_GCBIT_MASK | SCM_TAG_MASK))
39
40 #define SCM_GCBIT_MASK 0x1
41 #define SCM_GCBIT_UNMARKED 0x0
42 #define SCM_GCBIT_MARKED 0x1
43
44 #define SCM_TAG_MASK 0x6
45 #define SCM_TAG_CONS 0x0
46 #define SCM_TAG_CLOSURE 0x2
47 #define SCM_TAG_OTHERS 0x4
48 #define SCM_TAG_IMM 0x6
49
50 #define SCM_IMM_TAG_MASK 0x18
51 #define SCM_IMM_TAG_CONST 0x00
52 #define SCM_IMM_TAG_CHAR 0x10
53 #define SCM_IMM_TAG_INT_EVEN 0x08
54 #define SCM_IMM_TAG_INT_ODD 0x18
55
56 #define SCM_IMM_CONST_OFFSET 5
57
58 #define SCM_IMMCONST(id) \
59 ((ScmObj)((id << SCM_IMM_CONST_OFFSET) | SCM_IMM_TAG_CONST | SCM_TAG_IMM))
60
61 #define SCM_FALSE SCM_IMMCONST(0x0)
62 #define SCM_NULL SCM_IMMCONST(0x1)
63 #define SCM_UNBOUND SCM_IMMCONST(0x2)
64 #define SCM_EOF SCM_IMMCONST(0x3)
65 #define SCM_UNDEF SCM_IMMCONST(0x4)
66 #define SCM_TRUE SCM_IMMCONST(0x5)
67
68 /* NULL|tag style const representation */
69 #define SCM_NULLTAG_CONST_FALSE ((ScmObj)((int)NULL | SCM_TAG_CONS))
70 #define SCM_NULLTAG_CONST_NULL ((ScmObj)((int)NULL | SCM_TAG_CLOSURE))
71 #define SCM_NULLTAG_CONST_UNBOUND ((ScmObj)((int)NULL | SCM_TAG_OTHERS))
72 #define SCM_NULLTAG_CONST_TRUE scm_ntc_true
73
74 #define FALSEP(obj) (obj == SCM_FALSE)
75 #define NULLTAG_CONST_FALSEP(obj) (obj == SCM_NULLTAG_CONST_FALSE)
76
77 #define NULLP(obj) (obj == SCM_NULL)
78 #define NULLTAG_CONST_NULLP(obj) (obj == SCM_NULLTAG_CONST_NULL)
79
80 #define CONSP(obj) ((((int)obj) & SCM_TAG_MASK) == SCM_TAG_CONS)
81 #define NULLTAG_CONST_CONSP(obj) \
82 (((((int)obj) & SCM_TAG_MASK) == SCM_TAG_CONS) \
83 && (obj != SCM_NULLTAG_CONST_FALSE))
84
85 #define CAR(cell) (((ScmCell *)cell)->car)
86 #define CDR(cell) (((ScmCell *)cell)->cdr)
87
88 typedef struct ScmCell_ ScmCell;
89 struct ScmCell_ {
90 void *car;
91 void *cdr;
92 };
93
94 typedef ScmCell *ScmObj;
95
96 ScmObj scm_ntc_true;
97
98 int
falsep(ScmObj obj)99 falsep(ScmObj obj)
100 {
101 return (obj == SCM_FALSE);
102 }
103
104 int
ntc_falsep(ScmObj obj)105 ntc_falsep(ScmObj obj)
106 {
107 return (obj == SCM_NULLTAG_CONST_FALSE);
108 }
109
110 int
nullp(ScmObj obj)111 nullp(ScmObj obj)
112 {
113 return (obj == SCM_NULL);
114 }
115
116 int
ntc_nullp(ScmObj obj)117 ntc_nullp(ScmObj obj)
118 {
119 return (obj == SCM_NULLTAG_CONST_NULL);
120 }
121
122 int
consp(ScmObj obj)123 consp(ScmObj obj)
124 {
125 return CONSP(obj);
126 }
127
128 int
ntc_consp(ScmObj obj)129 ntc_consp(ScmObj obj)
130 {
131 return NULLTAG_CONST_CONSP(obj);
132 }
133
134 ScmObj
memq(ScmObj key,ScmObj lst)135 memq(ScmObj key, ScmObj lst)
136 {
137 ScmObj rest;
138
139 for (rest = lst; CONSP(rest); rest = CDR(rest)) {
140 if (CAR(rest) == key)
141 return rest;
142 }
143 return SCM_FALSE;
144 }
145
146 ScmObj
ntc_memq(ScmObj key,ScmObj lst)147 ntc_memq(ScmObj key, ScmObj lst)
148 {
149 ScmObj rest;
150
151 for (rest = lst; NULLTAG_CONST_CONSP(rest); rest = CDR(rest)) {
152 if (CAR(rest) == key)
153 return rest;
154 }
155 return SCM_NULLTAG_CONST_FALSE;
156 }
157
158 ScmObj
and(ScmObj lst)159 and(ScmObj lst)
160 {
161 ScmObj rest;
162
163 for (rest = lst; CONSP(rest); rest = CDR(rest)) {
164 if (FALSEP(rest))
165 return SCM_FALSE;
166 }
167 return SCM_TRUE;
168 }
169
170 ScmObj
ntc_and(ScmObj lst)171 ntc_and(ScmObj lst)
172 {
173 ScmObj rest;
174
175 for (rest = lst; NULLTAG_CONST_CONSP(rest); rest = CDR(rest)) {
176 if (NULLTAG_CONST_FALSEP(rest))
177 return SCM_NULLTAG_CONST_FALSE;
178 }
179 return SCM_NULLTAG_CONST_TRUE;
180 }
181