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/branches/num64/runtime/gc/old-literals.c
ViewVC logotype

Annotation of /sml/branches/num64/runtime/gc/old-literals.c

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : jhr 4522 /*! \file old-literals.c
2 :     *
3 :     * This is the version 1 literals builder. We keep it around to ease
4 :     * the transition to the new scheme, but it can be removed from the runtime
5 : jhr 4877 * after the compiler switches over to the new scheme.
6 : jhr 4522 *
7 :     * \author John Reppy
8 :     */
9 :    
10 :     /*
11 :     * COPYRIGHT (c) 2017 The Fellowship of SML/NJ (http://www.smlnj.org)
12 :     * All rights reserved.
13 :     */
14 :    
15 :     #include "ml-base.h"
16 :     #include "ml-objects.h"
17 :     #include "heap.h"
18 :     #include <string.h>
19 :    
20 :     /* Codes for literal machine instructions (version 1):
21 :     * INT(i) 0x01 <i>
22 :     * RAW32[i] 0x02 <i>
23 :     * RAW32[i1,..,in] 0x03 <n> <i1> ... <in>
24 :     * RAW64[r] 0x04 <r>
25 :     * RAW64[r1,..,rn] 0x05 <n> <r1> ... <rn>
26 :     * STR[c1,..,cn] 0x06 <n> <c1> ... <cn>
27 :     * LIT(k) 0x07 <k> -- push stk[k] (for sharing)
28 :     * VECTOR(n) 0x08 <n>
29 :     * RECORD(n) 0x09 <n>
30 :     * RETURN 0xff
31 :     */
32 :     #define I_INT 0x01
33 :     #define I_RAW32 0x2
34 :     #define I_RAW32L 0x3
35 :     #define I_RAW64 0x4
36 :     #define I_RAW64L 0x5
37 :     #define I_STR 0x6
38 :     #define I_LIT 0x7
39 :     #define I_VECTOR 0x8
40 :     #define I_RECORD 0x9
41 :     #define I_RETURN 0xff
42 :    
43 :     #define _B0(p) ((p)[pc])
44 :     #define _B1(p) ((p)[pc+1])
45 :     #define _B2(p) ((p)[pc+2])
46 :     #define _B3(p) ((p)[pc+3])
47 :    
48 :     #define GET32(p) \
49 :     ((_B0(p) << 24) | (_B1(p) << 16) | (_B2(p) << 8) | _B3(p))
50 :    
51 :     /* the size of a list cons cell in bytes */
52 :     #define CONS_SZB (WORD_SZB*3)
53 :    
54 :     /* the amount of free space that we want in the allocation arena; this value must be
55 :     * less than MIN_ALLOC_SZB (defined in include/ml-limits.h)
56 :     */
57 :     #define FREE_REQ_SZB 64*ONE_K
58 :    
59 :     /* GetDouble:
60 :     */
61 :     PVT double GetDouble (Byte_t *p)
62 :     {
63 :     int i;
64 :     union {
65 :     double d;
66 :     Byte_t b[sizeof(double)];
67 :     } u;
68 :    
69 :     #ifdef BYTE_ORDER_LITTLE
70 :     for (i = sizeof(double)-1; i >= 0; i--) {
71 :     u.b[i] = *p++;
72 :     }
73 :     #else
74 :     for (i = 0; i < sizeof(double); i++) {
75 :     u.b[i] = p[i];
76 :     }
77 :     #endif
78 :    
79 :     return u.d;
80 :    
81 :     } /* end of GetDouble */
82 :    
83 :     /* OldLiterals:
84 :     *
85 :     * The Version 1 build literals function. We assume that the header has already
86 : jhr 4877 * been consumed in the version check (see build-literals.c), which means that the
87 :     * `pc` argument should point to the first command.
88 : jhr 4522 */
89 : jhr 4877 ml_val_t BuildLiteralsV1 (ml_state_t *msp, Byte_t *lits, int pc, int len)
90 : jhr 4522 {
91 :     ml_val_t stk, res;
92 :     Int32_t i, j, n;
93 :     Int32_t availSpace, spaceReq;
94 :     double d;
95 :    
96 :     #ifdef DEBUG_LITERALS
97 :     SayDebug("BuildLiteralsV1: lits = %p, len = %d\n", (void *)lits, len);
98 :     #endif
99 :     if (len <= 0) return ML_nil;
100 :    
101 :     /* A check that the available space is sufficient for the literal object that
102 :     * we are about to allocate. Note that the cons cell has already been accounted
103 :     * for in availSpace (but not in spaceReq).
104 :     */
105 :     #define GC_CHECK \
106 :     do { \
107 :     if (spaceReq > availSpace) { \
108 :     InvokeGCWithRoots (msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *)); \
109 :     availSpace = ((size_t)msp->ml_limitPtr - (size_t)msp->ml_allocPtr) - CONS_SZB; \
110 :     } \
111 :     } while (0)
112 :    
113 :     stk = ML_nil;
114 :     while (TRUE) {
115 :     ASSERT(pc < len);
116 : jhr 4877 /* ensure that there is at least 1Kb of available space -- enough for fixed-size
117 :     * objects.
118 :     */
119 :     availSpace = ((size_t)msp->ml_limitPtr - (size_t)msp->ml_allocPtr);
120 : jhr 4522 if (availSpace < ONE_K) {
121 :     if (NeedGC(msp, FREE_REQ_SZB))
122 :     InvokeGCWithRoots (msp, 0, (ml_val_t *)&lits, &stk, NIL(ml_val_t *));
123 :     availSpace = ((size_t)msp->ml_limitPtr - (size_t)msp->ml_allocPtr);
124 :     }
125 :     switch (lits[pc++]) {
126 :     case I_INT:
127 :     i = GET32(lits); pc += 4;
128 :     #ifdef DEBUG_LITERALS
129 :     SayDebug("[%2d]: INT(%d)\n", pc-5, i);
130 :     #endif
131 :     LIST_cons(msp, stk, INT_CtoML(i), stk);
132 :     break;
133 :     case I_RAW32:
134 :     i = GET32(lits); pc += 4;
135 :     #ifdef DEBUG_LITERALS
136 :     SayDebug("[%2d]: RAW32[%d]\n", pc-5, i);
137 :     #endif
138 : jhr 5229 res = INT32_CtoML(msp, i);
139 : jhr 4522 LIST_cons(msp, stk, res, stk);
140 :     break;
141 :     case I_RAW32L:
142 :     n = GET32(lits); pc += 4;
143 :     #ifdef DEBUG_LITERALS
144 :     SayDebug("[%2d]: RAW32L(%d) [...]\n", pc-5, n);
145 :     #endif
146 :     ASSERT(n > 0);
147 : jhr 4877 spaceReq = CONS_SZB + WORD_SZB + 4 * n;
148 : jhr 4522 /* FIXME: for large objects, we should be allocating them in the 1st generation */
149 :     GC_CHECK;
150 : jhr 5010 ML_AllocWrite (msp, 0, MAKE_DESC(n, DTAG_raw));
151 : jhr 4522 for (j = 1; j <= n; j++) {
152 :     i = GET32(lits); pc += 4;
153 :     ML_AllocWrite (msp, j, (ml_val_t)i);
154 :     }
155 :     res = ML_Alloc (msp, n);
156 :     LIST_cons(msp, stk, res, stk);
157 :     break;
158 :     case I_RAW64:
159 :     d = GetDouble(&(lits[pc])); pc += 8;
160 :     REAL64_ALLOC(msp, res, d);
161 :     #ifdef DEBUG_LITERALS
162 :     SayDebug("[%2d]: RAW64[%f] @ %#x\n", pc-5, d, res);
163 :     #endif
164 :     LIST_cons(msp, stk, res, stk);
165 :     break;
166 :     case I_RAW64L:
167 :     n = GET32(lits); pc += 4;
168 :     #ifdef DEBUG_LITERALS
169 :     SayDebug("[%2d]: RAW64L(%d) [...]\n", pc-5, n);
170 :     #endif
171 :     ASSERT(n > 0);
172 : jhr 4877 /* space request includes extra padding word */
173 :     spaceReq = CONS_SZB + 2 * WORD_SZB + 8 * n;
174 : jhr 4522 /* FIXME: for large objects, we should be allocating them in the 1st generation */
175 :     GC_CHECK;
176 :     #ifdef ALIGN_REALDS
177 :     /* Force REALD_SZB alignment (descriptor is off by one word) */
178 :     msp->ml_allocPtr = (ml_val_t *)((Addr_t)(msp->ml_allocPtr) | WORD_SZB);
179 :     #endif
180 :     j = 2*n; /* number of words */
181 :     ML_AllocWrite (msp, 0, MAKE_DESC(j, DTAG_raw64));
182 :     res = ML_Alloc (msp, j);
183 :     for (j = 0; j < n; j++) {
184 :     PTR_MLtoC(double, res)[j] = GetDouble(&(lits[pc])); pc += 8;
185 :     }
186 :     LIST_cons(msp, stk, res, stk);
187 :     break;
188 :     case I_STR:
189 :     n = GET32(lits); pc += 4;
190 :     #ifdef DEBUG_LITERALS
191 :     SayDebug("[%2d]: STR(%d) [...]", pc-5, n);
192 :     #endif
193 :     if (n == 0) {
194 :     #ifdef DEBUG_LITERALS
195 :     SayDebug("\n");
196 :     #endif
197 :     LIST_cons(msp, stk, ML_string0, stk);
198 :     break;
199 :     }
200 :     j = BYTES_TO_WORDS(n+1); /* include space for '\0' */
201 :     /* the space request includes space for the data-object header word and
202 :     * the sequence header object.
203 :     */
204 :     spaceReq = WORD_SZB*(j+1+3);
205 :     /* FIXME: for large strings, we should be allocating them in the 1st generation */
206 :     GC_CHECK;
207 :     /* allocate the data object */
208 : jhr 5010 ML_AllocWrite(msp, 0, MAKE_DESC(j, DTAG_raw));
209 : jhr 4522 ML_AllocWrite (msp, j, 0); /* so word-by-word string equality works */
210 :     res = ML_Alloc (msp, j);
211 :     #ifdef DEBUG_LITERALS
212 :     SayDebug(" @ %p (%d words)\n", (void *)res, j);
213 :     #endif
214 :     memcpy (PTR_MLtoC(void, res), &lits[pc], n); pc += n;
215 :     /* allocate the header object */
216 :     SEQHDR_ALLOC(msp, res, DESC_string, res, n);
217 :     /* push on stack */
218 :     LIST_cons(msp, stk, res, stk);
219 :     break;
220 :     case I_LIT:
221 :     n = GET32(lits); pc += 4;
222 :     for (j = 0, res = stk; j < n; j++) {
223 :     res = LIST_tl(res);
224 :     }
225 :     #ifdef DEBUG_LITERALS
226 :     SayDebug("[%2d]: LIT(%d) = %p\n", pc-5, n, (void *)LIST_hd(res));
227 :     #endif
228 :     LIST_cons(msp, stk, LIST_hd(res), stk);
229 :     break;
230 :     case I_VECTOR:
231 :     n = GET32(lits); pc += 4;
232 :     #ifdef DEBUG_LITERALS
233 :     SayDebug("[%2d]: VECTOR(%d) [", pc-5, n);
234 :     #endif
235 :     if (n == 0) {
236 :     #ifdef DEBUG_LITERALS
237 :     SayDebug("]\n");
238 :     #endif
239 :     LIST_cons(msp, stk, ML_vector0, stk);
240 :     break;
241 :     }
242 :     /* the space request includes space for the data-object header word and
243 :     * the sequence header object.
244 :     */
245 :     spaceReq = WORD_SZB*(n+1+3);
246 :     /* FIXME: for large vectors, we should be allocating them in the 1st generation */
247 :     GC_CHECK;
248 :     /* allocate the data object */
249 :     ML_AllocWrite(msp, 0, MAKE_DESC(n, DTAG_vec_data));
250 :     /* top of stack is last element in vector */
251 :     for (j = n; j > 0; j--) {
252 :     ML_AllocWrite(msp, j, LIST_hd(stk));
253 :     stk = LIST_tl(stk);
254 :     }
255 :     res = ML_Alloc(msp, n);
256 :     /* allocate the header object */
257 :     SEQHDR_ALLOC(msp, res, DESC_polyvec, res, n);
258 :     #ifdef DEBUG_LITERALS
259 :     SayDebug("...] @ %p\n", (void *)res);
260 :     #endif
261 :     LIST_cons(msp, stk, res, stk);
262 :     break;
263 :     case I_RECORD:
264 :     n = GET32(lits); pc += 4;
265 :     #ifdef DEBUG_LITERALS
266 :     SayDebug("[%2d]: RECORD(%d) [", pc-5, n);
267 :     #endif
268 :     if (n == 0) {
269 :     #ifdef DEBUG_LITERALS
270 :     SayDebug("]\n");
271 :     #endif
272 :     LIST_cons(msp, stk, ML_unit, stk);
273 :     break;
274 :     }
275 :     else {
276 : jhr 4877 spaceReq = WORD_SZB*(n+1);
277 : jhr 4522 GC_CHECK;
278 :     ML_AllocWrite(msp, 0, MAKE_DESC(n, DTAG_record));
279 :     }
280 : jhr 4877 /* top of stack is the last element in the record */
281 : jhr 4522 for (j = n; j > 0; j--) {
282 :     ML_AllocWrite(msp, j, LIST_hd(stk));
283 :     stk = LIST_tl(stk);
284 :     }
285 :     res = ML_Alloc(msp, n);
286 :     #ifdef DEBUG_LITERALS
287 :     SayDebug("...] @ %p\n", (void *)res);
288 :     #endif
289 :     LIST_cons(msp, stk, res, stk);
290 :     break;
291 :     case I_RETURN:
292 :     ASSERT(pc == len);
293 :     #ifdef DEBUG_LITERALS
294 :     SayDebug("[%2d]: RETURN(%p)\n", pc-5, (void *)LIST_hd(stk));
295 :     #endif
296 :     return (LIST_hd(stk));
297 :     break;
298 :     default:
299 :     Die ("bogus literal opcode #%x @ %d", lits[pc-1], pc-1);
300 :     } /* switch */
301 :     } /* while */
302 :    
303 : jhr 4877 } /* end of BuildLiteralsV1 */
304 : jhr 4522

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