Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/runtime/gc/build-literals.c
ViewVC logotype

Annotation of /sml/trunk/src/runtime/gc/build-literals.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 250 - (view) (download) (as text)

1 : monnier 249 /* build-literals.c
2 :     *
3 :     * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies.
4 :     */
5 :    
6 :     #include "ml-base.h"
7 :     #include "ml-objects.h"
8 :     #include "heap.h"
9 :    
10 :     /* Codes for literal machine instructions (version 1):
11 :     * INT(i) 0x01 <i>
12 :     * RAW32[i] 0x02 <i>
13 :     * RAW32[i1,..,in] 0x03 <n> <i1> ... <in>
14 :     * RAW64[r] 0x04 <r>
15 :     * RAW64[r1,..,rn] 0x05 <n> <r1> ... <rn>
16 :     * STR[c1,..,cn] 0x06 <n> <c1> ... <cn>
17 :     * LIT(k) 0x07 <k>
18 :     * VECTOR(n) 0x08 <n>
19 :     * RECORD(n) 0x09 <n>
20 :     * RETURN 0xff
21 :     */
22 :     #define V1_MAGIC 0x19981022
23 :     #define I_INT 0x01
24 :     #define I_RAW32 0x2
25 :     #define I_RAW32L 0x3
26 :     #define I_RAW64 0x4
27 :     #define I_RAW64L 0x5
28 :     #define I_STR 0x6
29 :     #define I_LIT 0x7
30 :     #define I_VECTOR 0x8
31 :     #define I_RECORD 0x9
32 :     #define I_RETURN 0xff
33 :    
34 :     #define _B0(p) ((p)[pc])
35 :     #define _B1(p) ((p)[pc+1])
36 :     #define _B2(p) ((p)[pc+2])
37 :     #define _B3(p) ((p)[pc+3])
38 :    
39 :     #define GET32(p) \
40 :     ((_B0(p) << 24) | (_B1(p) << 16) | (_B2(p) << 8) | _B3(p))
41 :    
42 :     /* GetDouble:
43 :     */
44 :     PVT double GetDouble (Byte_t *p)
45 :     {
46 :     int i;
47 :     union {
48 :     double d;
49 :     Byte_t b[sizeof(double)];
50 :     } u;
51 :    
52 :     #ifdef BYTE_ORDER_LITTLE
53 :     for (i = sizeof(double)-1; i >= 0; i--) {
54 :     u.b[i] = *p++;
55 :     }
56 :     #else
57 :     for (i = 0; i < sizeof(double); i++) {
58 :     u.b[i] = p[i];
59 :     }
60 :     #endif
61 :    
62 :     return u.d;
63 :    
64 :     } /* end of GetDouble */
65 :    
66 :    
67 :     /* BuildLiterals:
68 :     *
69 :     * NOTE: we allocate all of the objects in the first generation, and allocate
70 :     * the vector of literals in the allocation space.
71 :     */
72 :     ml_val_t BuildLiterals (ml_state_t *msp, Byte_t *lits, int len)
73 :     {
74 :     int pc = 0;
75 :     Word_t magic, maxDepth;
76 :     ml_val_t stk;
77 :     ml_val_t res;
78 :     Int32_t i, j, n;
79 :     double d;
80 :     int availSpace, spaceReq;
81 :    
82 :     #ifdef DEBUG_LITERALS
83 :     SayDebug("BuildLiterals: lits = %#x, len = %d\n", lits, len);
84 :     #endif
85 :     if (len <= 8) return ML_nil;
86 :    
87 :     magic = GET32(lits); pc += 4;
88 :     maxDepth = GET32(lits); pc += 4;
89 :    
90 :     if (magic != V1_MAGIC) {
91 :     Die("bogus literal magic number %#x", magic);
92 :     }
93 :    
94 :     stk = ML_nil;
95 :     availSpace = 0;
96 :     while (TRUE) {
97 :     ASSERT(pc < len);
98 :     availSpace -= 3*WORD_SZB; /* space for stack cons cell */
99 :     if (availSpace < ONE_K) {
100 :     if (NeedGC(msp, 64*ONE_K))
101 :     InvokeGCWithRoots (msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *));
102 :     availSpace = 64*ONE_K;
103 :     }
104 :     switch (lits[pc++]) {
105 :     case I_INT:
106 :     i = GET32(lits); pc += 4;
107 :     #ifdef DEBUG_LITERALS
108 :     SayDebug("[%2d]: INT(%d)\n", pc-5, i);
109 :     #endif
110 :     LIST_cons(msp, stk, INT_CtoML(i), stk);
111 :     break;
112 :     case I_RAW32:
113 :     i = GET32(lits); pc += 4;
114 :     #ifdef DEBUG_LITERALS
115 :     SayDebug("[%2d]: RAW32[%d]\n", pc-5, i);
116 :     #endif
117 :     INT32_ALLOC(msp, res, i);
118 :     LIST_cons(msp, stk, res, stk);
119 :     availSpace -= 2*WORD_SZB;
120 :     break;
121 :     case I_RAW32L:
122 :     n = GET32(lits); pc += 4;
123 :     #ifdef DEBUG_LITERALS
124 :     SayDebug("[%2d]: RAW32L(%d) [...]\n", pc-5, n);
125 :     #endif
126 :     ASSERT(n > 0);
127 :     spaceReq = 4*(n+1);
128 :     if ((spaceReq > availSpace) && NeedGC(msp, spaceReq)) {
129 :     InvokeGCWithRoots (msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *));
130 :     availSpace = 0;
131 :     }
132 :     else
133 :     availSpace -= spaceReq;
134 :     ML_AllocWrite (msp, 0, MAKE_DESC(n, DTAG_raw32));
135 :     for (j = 1; j <= n; j++) {
136 :     i = GET32(lits); pc += 4;
137 :     ML_AllocWrite (msp, j, (ml_val_t)i);
138 :     }
139 :     res = ML_Alloc (msp, n);
140 :     LIST_cons(msp, stk, res, stk);
141 :     break;
142 :     case I_RAW64:
143 :     d = GetDouble(&(lits[pc])); pc += 8;
144 :     REAL64_ALLOC(msp, res, d);
145 :     #ifdef DEBUG_LITERALS
146 :     SayDebug("[%2d]: RAW64[%f] @ %#x\n", pc-5, d, res);
147 :     #endif
148 :     LIST_cons(msp, stk, res, stk);
149 :     availSpace -= 4*WORD_SZB; /* extra 4 bytes for alignment padding */
150 :     break;
151 :     case I_RAW64L:
152 :     n = GET32(lits); pc += 4;
153 :     #ifdef DEBUG_LITERALS
154 :     SayDebug("[%2d]: RAW64L(%d) [...]\n", pc-5, n);
155 :     #endif
156 :     ASSERT(n > 0);
157 :     spaceReq = 8*(n+1);
158 :     if ((spaceReq > availSpace) && NeedGC(msp, spaceReq)) {
159 :     InvokeGCWithRoots (msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *));
160 :     availSpace = 0;
161 :     }
162 :     else
163 :     availSpace -= spaceReq;
164 :     #ifdef ALIGN_REALDS
165 :     /* Force REALD_SZB alignment (descriptor is off by one word) */
166 :     msp->ml_allocPtr = (ml_val_t *)((Addr_t)(msp->ml_allocPtr) | WORD_SZB);
167 :     #endif
168 :     j = 2*n; /* number of words */
169 :     ML_AllocWrite (msp, 0, MAKE_DESC(j, DTAG_raw64));
170 :     res = ML_Alloc (msp, j);
171 :     for (j = 0; j < n; j++) {
172 :     PTR_MLtoC(double, res)[j] = GetDouble(&(lits[pc])); pc += 8;
173 :     }
174 :     LIST_cons(msp, stk, res, stk);
175 :     break;
176 :     case I_STR:
177 :     n = GET32(lits); pc += 4;
178 :     #ifdef DEBUG_LITERALS
179 :     SayDebug("[%2d]: STR(%d) [...]", pc-5, n);
180 :     #endif
181 :     if (n == 0) {
182 :     #ifdef DEBUG_LITERALS
183 :     SayDebug("\n");
184 :     #endif
185 :     LIST_cons(msp, stk, ML_string0, stk);
186 :     break;
187 :     }
188 :     j = BYTES_TO_WORDS(n+1); /* include space for '\0' */
189 :     spaceReq = 4*(j+1);
190 :     if ((spaceReq > availSpace) && NeedGC(msp, spaceReq)) {
191 :     InvokeGCWithRoots (msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *));
192 :     availSpace = 0;
193 :     }
194 :     else
195 :     availSpace -= spaceReq;
196 :     /* allocate the data object */
197 :     ML_AllocWrite(msp, 0, MAKE_DESC(j, DTAG_raw32));
198 :     ML_AllocWrite (msp, j, 0); /* so word-by-word string equality works */
199 :     res = ML_Alloc (msp, j);
200 :     #ifdef DEBUG_LITERALS
201 :     SayDebug(" @ %#x (%d words)\n", res, j);
202 :     #endif
203 :     memcpy (PTR_MLtoC(void, res), &lits[pc], n); pc += n;
204 :     /* allocate the header object */
205 :     SEQHDR_ALLOC(msp, res, DESC_string, res, n);
206 :     /* push on stack */
207 :     LIST_cons(msp, stk, res, stk);
208 :     break;
209 :     case I_LIT:
210 :     n = GET32(lits); pc += 4;
211 :     for (j = 0, res = stk; j < n; j++) {
212 :     res = LIST_tl(res);
213 :     }
214 :     #ifdef DEBUG_LITERALS
215 :     SayDebug("[%2d]: LIT(%d) = %#x\n", pc-5, n, LIST_hd(res));
216 :     #endif
217 :     LIST_cons(msp, stk, LIST_hd(res), stk);
218 :     break;
219 :     case I_VECTOR:
220 :     n = GET32(lits); pc += 4;
221 :     #ifdef DEBUG_LITERALS
222 :     SayDebug("[%2d]: VECTOR(%d) [", pc-5, n);
223 :     #endif
224 :     if (n == 0) {
225 :     #ifdef DEBUG_LITERALS
226 :     SayDebug("]\n");
227 :     #endif
228 :     LIST_cons(msp, stk, ML_vector0, stk);
229 :     break;
230 :     }
231 :     spaceReq = 4*(n+1);
232 :     if ((spaceReq > availSpace) && NeedGC(msp, spaceReq)) {
233 :     InvokeGCWithRoots (msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *));
234 :     availSpace = 0;
235 :     }
236 :     else
237 :     availSpace -= spaceReq;
238 :     /* allocate the data object */
239 :     ML_AllocWrite(msp, 0, MAKE_DESC(n, DTAG_vec_data));
240 :     /* top of stack is last element in vector */
241 :     for (j = n; j > 0; j--) {
242 :     ML_AllocWrite(msp, j, LIST_hd(stk));
243 :     stk = LIST_tl(stk);
244 :     }
245 :     res = ML_Alloc(msp, n);
246 :     /* allocate the header object */
247 :     SEQHDR_ALLOC(msp, res, DESC_polyvec, res, n);
248 :     #ifdef DEBUG_LITERALS
249 :     SayDebug("...] @ %#x\n", res);
250 :     #endif
251 :     LIST_cons(msp, stk, res, stk);
252 :     break;
253 :     case I_RECORD:
254 :     n = GET32(lits); pc += 4;
255 :     #ifdef DEBUG_LITERALS
256 :     SayDebug("[%2d]: RECORD(%d) [", pc-5, n);
257 :     #endif
258 :     if (n == 0) {
259 :     #ifdef DEBUG_LITERALS
260 :     SayDebug("]\n");
261 :     #endif
262 :     LIST_cons(msp, stk, ML_unit, stk);
263 :     break;
264 :     }
265 :     else {
266 :     spaceReq = 4*(n+1);
267 :     if ((spaceReq > availSpace) && NeedGC(msp, spaceReq)) {
268 :     InvokeGCWithRoots (
269 :     msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *));
270 :     availSpace = 0;
271 :     }
272 :     else
273 :     availSpace -= spaceReq;
274 :     ML_AllocWrite(msp, 0, MAKE_DESC(n, DTAG_record));
275 :     }
276 :     /* top of stack is last element in record */
277 :     for (j = n; j > 0; j--) {
278 :     ML_AllocWrite(msp, j, LIST_hd(stk));
279 :     stk = LIST_tl(stk);
280 :     }
281 :     res = ML_Alloc(msp, n);
282 :     #ifdef DEBUG_LITERALS
283 :     SayDebug("...] @ %#x\n", res);
284 :     #endif
285 :     LIST_cons(msp, stk, res, stk);
286 :     break;
287 :     case I_RETURN:
288 :     ASSERT(pc == len);
289 :     #ifdef DEBUG_LITERALS
290 :     SayDebug("[%2d]: RETURN(%#x)\n", pc-5, LIST_hd(stk));
291 :     #endif
292 :     return (LIST_hd(stk));
293 :     break;
294 :     default:
295 :     Die ("bogus literal opcode #%x @ %d", lits[pc-1], pc-1);
296 :     } /* switch */
297 :     } /* while */
298 :    
299 :     } /* end of BuildLiterals */
300 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0