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/mach-dep/X86.prim.asm
ViewVC logotype

Annotation of /sml/trunk/src/runtime/mach-dep/X86.prim.asm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 439 - (view) (download)
Original Path: sml/branches/SMLNJ/src/runtime/mach-dep/X86.prim.asm

1 : monnier 249 /* X86.prim.asm
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * This was derived from I386.prim.s, by Mark Leone (mleone@cs.cmu.edu)
6 :     *
7 : monnier 439 * Completely rewritten and changed to use assyntax.h, by Lal George.
8 : monnier 249 */
9 :    
10 :     #include "ml-base.h"
11 :     #include "asm-base.h"
12 :     #include "ml-values.h"
13 :     #include "tags.h"
14 :     #include "ml-request.h"
15 :     #include "ml-limits.h"
16 : monnier 439 #include "assyntax.h"
17 :    
18 : monnier 249 /* XXX: May no longer be needed */
19 :     #ifndef VREGS
20 :     # define VREGS
21 :     #endif
22 :    
23 :     /*
24 :     *
25 :     * The 386 registers are used as follows:
26 :     *
27 :     * EAX - temp1 (see the code generator, x86/x86.sml)
28 :     * EBX - misc0
29 :     * ECX - misc1
30 :     * EDX - misc2
31 :     * ESI - standard continuation (ml_cont, see ml_state.h)
32 :     * EBP - standard argument (ml_arg)
33 :     * EDI - free space pointer (ml_allocptr)
34 :     * ESP - stack pointer
35 :     * EIP - program counter (ml_pc)
36 :     */
37 :    
38 :     /* Registers (see x86/x86.sml): */
39 : monnier 439 #define temp EAX
40 :     #define misc0 EBX
41 :     #define misc1 ECX
42 :     #define misc2 EDX
43 :     #define stdcont ESI
44 :     #define stdarg EBP
45 :     #define allocptr EDI
46 :     #define stackptr ESP
47 : monnier 249
48 :     /* other reg uses */
49 : monnier 439 #define creturn EAX
50 : monnier 249
51 :     /* Stack frame */
52 : monnier 439 #define tempmem REGOFF(0,ESP)
53 :     #define baseptr REGOFF(4,ESP)
54 :     #define exncont REGOFF(8,ESP)
55 :     #define limitptr REGOFF(12,ESP)
56 :     #define pc REGOFF(16,ESP)
57 :     #define unused_1 REGOFF(20,ESP)
58 :     #define storeptr REGOFF(24,ESP)
59 :     #define varptr REGOFF(28,ESP)
60 :     #define start_gc REGOFF(32,ESP)
61 :     #define unused_2 REGOFF(36,ESP)
62 :     #define eaxSpill REGOFF(40,ESP) /* eax=0 */
63 :     #define ecxSpill REGOFF(44,ESP) /* ecx=1 */
64 :     #define edxSpill REGOFF(48,ESP) /* edx=2 */
65 :     #define ebxSpill REGOFF(52,ESP) /* ebx=3 */
66 :     #define espSpill REGOFF(56,ESP) /* esp=4 */
67 :     #define ebpSpill REGOFF(60,ESP) /* ebp=5 */
68 :     #define esiSpill REGOFF(64,ESP) /* esi=6 */
69 :     #define ediSpill REGOFF(68,ESP) /* edi=7 */
70 :     #define stdlink REGOFF(72,ESP)
71 :     #define stdclos REGOFF(76,ESP)
72 : monnier 249
73 :     #define ML_STATE_OFFSET 176
74 : monnier 439 #define mlstate_ptr REGOFF(ML_STATE_OFFSET, ESP)
75 : monnier 249 #define freg8 184 /* double word aligned */
76 :     #define freg9 192
77 :     #define freg31 368 /* 152 + (31-8)*8 */
78 :     #define fpTempMem 376 /* freg31 + 8 */
79 :     #define SpillAreaStart 512 /* starting offset */
80 :     #define ML_FRAME_SIZE (8192)
81 :    
82 :     #define via
83 :    
84 : monnier 439 SEG_DATA
85 :     ALIGNDATA4
86 : monnier 249 request_w: /* place to put the request code */
87 : monnier 439 D_LONG 0
88 :     GLOBL ML_X86Frame
89 : monnier 249 LABEL(CSYM(ML_X86Frame)) /* ptr to the ml frame (gives C access to limitptr) */
90 : monnier 439 D_LONG 0
91 : monnier 249
92 :     SavedSP:
93 : monnier 439 D_LONG 0 /* Value of stack pointer to restore */
94 : monnier 249
95 :    
96 :     #include "mlstate-offsets.h" /** this file is generated **/
97 :    
98 :    
99 :     /*
100 :     * 386 function call conventions:
101 :     * [true for gcc and dynix3 cc; untested for others]
102 :     *
103 :     * Caller save registers: eax, ecx, edx
104 :     * Callee save registers: ebx, esi, edi, and ebp.
105 :     * Floating point state is caller-save.
106 :     * Arguments passed on stack. Rightmost argument pushed first.
107 :     * Word-sized result returned in %eax.
108 :     */
109 :    
110 : monnier 439 #define cresult EAX
111 : monnier 249
112 :     #define CALLEE_SAVE \
113 : monnier 439 PUSH_L(EBX); \
114 :     PUSH_L(ESI); \
115 :     PUSH_L(EDI); \
116 :     PUSH_L(EBP)
117 : monnier 249
118 :     #define CALLEE_RESTORE \
119 : monnier 439 POP_L(EBP); \
120 :     POP_L(EDI); \
121 :     POP_L(ESI); \
122 :     POP_L(EBX)
123 : monnier 249
124 :     /* MOVE copies one memory location to another, using a specified temporary. */
125 :    
126 :     #define MOVE(src,tmp,dest) \
127 : monnier 439 MOV_L(src, tmp); \
128 :     MOV_L(tmp, dest)
129 : monnier 249
130 :     #define CONTINUE \
131 : monnier 439 JMP(stdcont)
132 : monnier 249
133 :     #define CHECKLIMIT \
134 :     1:; \
135 :     MOVE(stdlink, temp, pc) ; \
136 : monnier 439 CMP_L(limitptr, allocptr); \
137 :     JB(9f); \
138 :     CALL(saveregs); \
139 :     JMP(1b); \
140 : monnier 249 9:
141 :    
142 :     /**********************************************************************/
143 : monnier 439 SEG_TEXT
144 :     ALIGNTEXT4
145 : monnier 249
146 :     ML_CODE_HDR(sigh_return_a)
147 : monnier 439 MOV_L(CONST(ML_unit),stdlink)
148 :     MOV_L(CONST(ML_unit),stdclos)
149 :     MOV_L(CONST(ML_unit),pc)
150 :     MOV_L(CONST(REQ_SIG_RETURN), request_w)
151 :     JMP(CSYM(set_request))
152 : monnier 249
153 :     /* sigh_resume:
154 :     * Resume execution at the point at which a handler trap occurred. This is a
155 :     * standard two-argument function, thus the closure is in ml_cont.
156 :     */
157 :    
158 :     ENTRY(sigh_resume)
159 : monnier 439 MOV_L(CONST(REQ_SIG_RESUME), request_w)
160 :     JMP(CSYM(set_request))
161 : monnier 249
162 :     /* pollh_return_a:
163 :     * The return continuation for the ML poll handler.
164 :     */
165 :     ML_CODE_HDR(pollh_return_a)
166 : monnier 439 MOV_L(CONST(REQ_POLL_RETURN), request_w)
167 :     MOV_L(CONST(ML_unit),stdlink)
168 :     MOV_L(CONST(ML_unit),stdclos)
169 :     MOV_L(CONST(ML_unit),pc)
170 :     JMP(CSYM(set_request))
171 : monnier 249
172 :     /* pollh_resume:
173 :     * Resume execution at the point at which a poll event occurred.
174 :     */
175 :     ENTRY(pollh_resume)
176 : monnier 439 MOV_L(CONST(REQ_POLL_RESUME), request_w)
177 :     JMP(CSYM(set_request))
178 : monnier 249
179 :     ML_CODE_HDR(handle_a)
180 : monnier 439 MOV_L(CONST(REQ_EXN), request_w)
181 :     MOVE(stdlink,temp,pc)
182 :     JMP(CSYM(set_request))
183 : monnier 249
184 :     ML_CODE_HDR(return_a)
185 : monnier 439 MOV_L(CONST(REQ_RETURN), request_w)
186 :     MOV_L(CONST(ML_unit),stdlink)
187 :     MOV_L(CONST(ML_unit),stdclos)
188 :     MOV_L(CONST(ML_unit),pc)
189 :     JMP(CSYM(set_request))
190 : monnier 249
191 :     /* Request a fault. The floating point coprocessor must be reset
192 :     * (thus trashing the FP registers) since we don't know whether a
193 :     * value has been pushed into the temporary "register". This is OK
194 :     * because no floating point registers will be live at the start of
195 :     * the exception handler.
196 :     */
197 :     ENTRY(request_fault)
198 : monnier 439 CALL(CSYM(FPEEnable)) /* Doesn't trash any general regs. */
199 :     MOV_L(CONST(REQ_FAULT), request_w)
200 :     MOVE(stdlink,temp,pc)
201 :     JMP(CSYM(set_request))
202 : monnier 249
203 :     /* bind_cfun : (string * string) -> c_function
204 :     */
205 :     ML_CODE_HDR(bind_cfun_a)
206 :     CHECKLIMIT
207 : monnier 439 MOV_L(CONST(REQ_BIND_CFUN), request_w)
208 :     JMP(CSYM(set_request))
209 : monnier 249
210 :     ML_CODE_HDR(build_literals_a)
211 :     CHECKLIMIT
212 : monnier 439 MOV_L(CONST(REQ_BUILD_LITERALS), request_w)
213 :     JMP(CSYM(set_request))
214 : monnier 249
215 :     ML_CODE_HDR(callc_a)
216 :     CHECKLIMIT
217 : monnier 439 MOV_L(CONST(REQ_CALLC), request_w)
218 :     JMP(CSYM(set_request))
219 : monnier 249
220 :     ENTRY(saveregs)
221 : monnier 439 POP_L(pc)
222 :     MOV_L(CONST(REQ_GC), request_w)
223 : monnier 249 /* fall into set_request */
224 :    
225 :     ENTRY(set_request)
226 :     /* temp holds mlstate_ptr, valid request in request_w */
227 :     /* Save registers */
228 : monnier 439 MOV_L(mlstate_ptr, temp)
229 :     MOV_L(allocptr, REGOFF(AllocPtrOffMSP,temp))
230 :     MOV_L(stdarg, REGOFF(StdArgOffMSP,temp))
231 :     MOV_L(stdcont, REGOFF(StdContOffMSP,temp))
232 : monnier 249
233 :     #define temp2 allocptr
234 :     /* note that we have left ML code */
235 : monnier 439 MOV_L(REGOFF(VProcOffMSP,temp), temp2)
236 :     MOV_L(CONST(0), REGOFF(InMLOffVSP,temp2))
237 : monnier 249
238 : monnier 439 MOV_L(misc0, REGOFF(Misc0OffMSP,temp))
239 :     MOV_L(misc1, REGOFF(Misc1OffMSP,temp))
240 :     MOV_L(misc2, REGOFF(Misc2OffMSP,temp))
241 : monnier 249
242 :     /* Save vregs before the stack frame is popped. */
243 : monnier 439 MOVE(limitptr,temp2, REGOFF(LimitPtrOffMSP,temp))
244 :     MOVE(exncont, temp2, REGOFF(ExnPtrOffMSP,temp))
245 :     MOVE(stdclos, temp2, REGOFF(StdClosOffMSP,temp))
246 :     MOVE(stdlink, temp2, REGOFF(LinkRegOffMSP,temp))
247 :     MOVE(pc, temp2, REGOFF(PCOffMSP,temp))
248 :     MOVE(storeptr,temp2, REGOFF(StorePtrOffMSP,temp))
249 :     MOVE(varptr, temp2, REGOFF(VarPtrOffMSP,temp))
250 : monnier 249 #undef temp2
251 :    
252 :     /* return val of function is request code */
253 : monnier 439 MOV_L(request_w,creturn)
254 : monnier 249
255 :     /* Pop the stack frame and return to run_ml(). */
256 : monnier 439 MOV_L(SavedSP, ESP)
257 : monnier 249 CALLEE_RESTORE
258 : monnier 439 RET
259 : monnier 249
260 : monnier 439 SEG_TEXT
261 :     ALIGNTEXT4
262 : monnier 249 ENTRY(restoreregs)
263 : monnier 439 MOV_L(4(ESP), temp) /* Get argument (MLState ptr). */
264 : monnier 249 CALLEE_SAVE
265 :    
266 : monnier 439 MOV_L(ESP, SavedSP) /* save stack pointer */
267 : monnier 249
268 :     /* Align on 8 byte boundary. Assumes that the stack
269 :     * starts out being at least word aligned. But who knows ...
270 :     */
271 : monnier 439 OR_L(CONST(4), ESP)
272 :     SUB_L(CONST(4), ESP) /* stack grows from high to low */
273 : monnier 249
274 : monnier 439 #define temp2 EBX
275 : monnier 249 /* Allocate and initialize the ML stack frame. */
276 : monnier 439 SUB_L(CONST(ML_FRAME_SIZE), ESP)
277 :     MOVE(REGOFF(ExnPtrOffMSP, temp), temp2, exncont)
278 :     MOVE(REGOFF(LimitPtrOffMSP, temp), temp2, limitptr)
279 :     MOVE(REGOFF(StorePtrOffMSP, temp), temp2, storeptr)
280 :     MOVE(REGOFF(VarPtrOffMSP, temp), temp2, varptr)
281 :     LEA_L(CSYM(saveregs), temp2)
282 :     MOV_L(temp2,start_gc)
283 :     MOV_L(temp, mlstate_ptr)
284 : monnier 249
285 :     /* vregs */
286 :     MOVE (LinkRegOffMSP(temp), temp2, stdlink)
287 :     MOVE (StdClosOffMSP(temp), temp2, stdclos)
288 :     #undef temp2
289 :    
290 :     /* Load ML registers. */
291 : monnier 439 MOV_L(REGOFF(AllocPtrOffMSP,temp), allocptr)
292 :     MOV_L(REGOFF(StdContOffMSP,temp), stdcont)
293 :     MOV_L(REGOFF(StdArgOffMSP,temp), stdarg)
294 :     MOV_L(REGOFF(Misc0OffMSP,temp), misc0)
295 :     MOV_L(REGOFF(Misc1OffMSP,temp), misc1)
296 :     MOV_L(REGOFF(Misc2OffMSP,temp), misc2)
297 : monnier 249
298 : monnier 439 MOV_L(ESP,CSYM(ML_X86Frame)) /* frame ptr for signal handler. */
299 : monnier 249
300 : monnier 439 PUSH_L(misc2) /* free up a register */
301 :     PUSH_L(temp) /* save msp temporarily */
302 : monnier 249
303 :     #define tmpreg misc2
304 :    
305 :     /* note that we're entering ML */
306 : monnier 439 MOV_L(REGOFF(VProcOffMSP,temp),temp) /* temp is now vsp */
307 : monnier 249 #define vsp temp
308 : monnier 439 MOV_L(CONST(1),REGOFF(InMLOffVSP,vsp))
309 : monnier 249
310 :     /* handle signals */
311 : monnier 439 MOV_L(REGOFF(NPendingSysOffVSP,vsp),tmpreg)
312 :     ADD_L(REGOFF(NPendingOffVSP,vsp),tmpreg)
313 :     CMP_L(CONST(0),tmpreg)
314 :    
315 : monnier 249 #undef tmpreg
316 : monnier 439 JNE(pending)
317 : monnier 249
318 :     restore_and_jmp_ml:
319 : monnier 439 POP_L(temp) /* restore temp to msp */
320 :     POP_L(misc2)
321 : monnier 249
322 :     jmp_ml:
323 : monnier 439 CMP_L(limitptr, allocptr)
324 :     JMP(REGOFF(PCOffMSP,temp)) /* Jump to ML code. */
325 : monnier 249
326 :    
327 :     pending:
328 : monnier 439 /* Currently handling signal? */
329 :     CMP_L(CONST(0), REGOFF(InSigHandlerOffVSP,vsp))
330 :     JNE(restore_and_jmp_ml)
331 :     /* handler trap is now pending */
332 :     movl IMMED(1),HandlerPendingOffVSP(vsp)
333 : monnier 249
334 :     /* must restore here because limitptr is on stack */ /* XXX */
335 : monnier 439 POP_L(temp) /* restore temp to msp */
336 :     POP_L(misc2)
337 : monnier 249
338 : monnier 439 MOV_L(allocptr,limitptr)
339 :     JMP(jmp_ml) /* Jump to ML code. */
340 : monnier 249 #undef vsp
341 :    
342 :     /* ----------------------------------------------------------------------
343 :     * array : (int * 'a) -> 'a array
344 :     * Allocate and initialize a new array. This can cause GC.
345 :     */
346 :     ML_CODE_HDR(array_a)
347 :     CHECKLIMIT
348 : monnier 439 MOV_L(REGIND(stdarg),temp) /* temp := length in words */
349 :     SAR_L(CONST(1),temp) /* temp := length untagged */
350 :     CMP_L(CONST(SMALL_OBJ_SZW),temp) /* is this a small object */
351 :     JGE(3f)
352 : monnier 249
353 :     #define temp1 misc0
354 :     #define temp2 misc1
355 : monnier 439 PUSH_L(misc0) /* save misc0 */
356 :     PUSH_L(misc1) /* save misc1 */
357 : monnier 249
358 : monnier 439 MOV_L(temp, temp1)
359 :     SAL_L(CONST(TAG_SHIFTW),temp1) /* build descriptor in temp1 */
360 :     OR_L(CONST(MAKE_TAG(DTAG_arr_data)),temp1)
361 :     MOV_L(temp1,REGIND(allocptr)) /* store descriptor */
362 :     ADD_L(CONST(4),allocptr) /* allocptr++ */
363 :     MOV_L(allocptr, temp1) /* temp1 := array data ptr */
364 :     MOV_L(REGOFF(4,stdarg), temp2) /* temp2 := initial value */
365 : monnier 249 2:
366 : monnier 439 MOV_L(temp2, REGIND(allocptr)) /* initialize array */
367 :     ADD_L(CONST(4), allocptr)
368 :     SUB_L(CONST(1), temp)
369 :     JNE(2b)
370 : monnier 249
371 :     /* Allocate array header */
372 : monnier 439 MOV_L(CONST(DESC_polyarr),REGIND(allocptr)) /* descriptor in temp */
373 :     ADD_L(CONST(4), allocptr) /* allocptr++ */
374 :     MOV_L(REGIND(stdarg), temp) /* temp := length */
375 :     MOV_L(allocptr, stdarg) /* result = header addr */
376 :     MOV_L(temp1, REGIND(allocptr)) /* store pointer to data */
377 :     MOV_L(temp, REGOFF(4,allocptr)) /* store length */
378 :     ADD_L(CONST(8), allocptr)
379 : monnier 249
380 : monnier 439 POP_L(misc1)
381 :     POP_L(misc0)
382 : monnier 249 CONTINUE
383 :     #undef temp1
384 :     #undef temp2
385 :     3:
386 : monnier 439 MOV_L(CONST(REQ_ALLOC_ARRAY), request_w)
387 : monnier 249 MOVE (stdlink, temp, pc)
388 : monnier 439 JMP(CSYM(set_request))
389 : monnier 249
390 :    
391 :     /* create_r : int -> realarray */
392 :     ML_CODE_HDR(create_r_a)
393 :     CHECKLIMIT
394 :     #define temp1 misc0
395 : monnier 439 PUSH_L(misc0) /* free temp1 */
396 :     MOV_L(stdarg,temp) /* temp := length */
397 :     SAR_L(CONST(1),temp) /* temp := untagged length */
398 :     SHL_L(CONST(1),temp) /* temp := length in words */
399 :     CMP_L(CONST(SMALL_OBJ_SZW),temp)
400 :     JGE(2f)
401 : monnier 249
402 : monnier 439 OR_L(CONST(4),allocptr) /* align allocptr */
403 : monnier 249
404 :     /* allocate the data object */
405 : monnier 439 MOV_L(temp, temp1)
406 :     SHL_L(CONST(TAG_SHIFTW),temp1) /* temp1 := descriptor */
407 :     OR_L(CONST(MAKE_TAG(DTAG_raw64)),temp1)
408 :     MOV_L(temp1,REGIND(allocptr)) /* store descriptor */
409 :     ADD_L(CONST(4), allocptr) /* allocptr++ */
410 :     MOV_L(allocptr, temp1) /* temp1 := data object */
411 :     SHL_L(CONST(2),temp) /* temp := length in bytes */
412 :     ADD_L(temp, allocptr) /* allocptr += length */
413 : monnier 249
414 :     /* allocate the header object */
415 : monnier 439 MOV_L(CONST(DESC_real64arr),REGIND(allocptr))/* header descriptor */
416 :     ADD_L(CONST(4), allocptr) /* allocptr++ */
417 :     MOV_L(temp1, REGIND(allocptr)) /* header data field */
418 :     MOV_L(stdarg, REGOFF(4,allocptr)) /* header length field */
419 :     MOV_L(allocptr, stdarg) /* stdarg := header object */
420 :     ADD_L(CONST(8), allocptr) /* allocptr += 2 */
421 : monnier 249
422 : monnier 439 POP_L(misc0) /* restore temp1 */
423 : monnier 249 CONTINUE
424 :     2:
425 : monnier 439 POP_L(misc0) /* restore temp1 */
426 :     MOV_L(CONST(REQ_ALLOC_REALDARRAY), request_w)
427 : monnier 249 MOVE (stdlink, temp, pc)
428 : monnier 439 JMP(CSYM(set_request))
429 : monnier 249 #undef temp1
430 :    
431 :    
432 :     /* create_b : int -> bytearray */
433 :     ML_CODE_HDR(create_b_a)
434 :     CHECKLIMIT
435 : monnier 439 MOV_L(stdarg,temp) /* temp := length(tagged int) */
436 :     SAR_L(CONST(1),temp) /* temp := length(untagged) */
437 :     ADD_L(CONST(3),temp)
438 :     SAR_L(CONST(2),temp) /* temp := length(words) */
439 :     CMP_L(CONST(SMALL_OBJ_SZW),temp) /* small object? */
440 :     JMP(2f)
441 :     JGE(2f) /* XXXXX */
442 : monnier 249
443 :     #define temp1 misc0
444 : monnier 439 PUSH_L(misc0)
445 : monnier 249
446 :     /* allocate teh data object */
447 : monnier 439 MOV_L(temp, temp1) /* temp1 := descriptor */
448 :     SHL_L(CONST(TAG_SHIFTW),temp1)
449 :     OR_L(CONST(MAKE_TAG(DTAG_raw32)),temp1)
450 :     MOV_L(temp1, REGIND(allocptr)) /* store descriptor */
451 :     ADD_L(CONST(4), allocptr) /* allocptr++ */
452 :     MOV_L(allocptr, temp1) /* temp1 := data object */
453 :     SHL_L(CONST(2), temp) /* temp := length in bytes */
454 :     ADD_L(temp, allocptr) /* allocptr += length */
455 : monnier 249
456 :     /* allocate the header object */
457 : monnier 439 MOV_L(CONST(DESC_word8arr), REGIND(allocptr))/* header descriptor */
458 :     ADD_L(CONST(4),allocptr) /* allocptr++ */
459 :     MOV_L(temp1, REGIND(allocptr)) /* header data field */
460 :     MOV_L(stdarg, REGOFF(4,allocptr)) /* header length field */
461 :     MOV_L(allocptr, stdarg) /* stdarg := header object */
462 :     ADD_L(CONST(8),allocptr) /* allocptr := 2 */
463 :     POP_L(misc0)
464 : monnier 249 CONTINUE
465 :     #undef temp1
466 :     2:
467 : monnier 439 MOV_L(CONST(REQ_ALLOC_BYTEARRAY), request_w)
468 : monnier 249 MOVE (stdlink, temp, pc)
469 : monnier 439 JMP(CSYM(set_request))
470 : monnier 249
471 :    
472 :     /* create_s : int -> string */
473 :     ML_CODE_HDR(create_s_a)
474 :     CHECKLIMIT
475 : monnier 439 MOV_L(stdarg,temp)
476 :     SAR_L(CONST(1),temp) /* temp := length(untagged) */
477 :     ADD_L(CONST(4),temp)
478 :     SAR_L(CONST(2),temp) /* temp := length(words) */
479 :     CMP_L(CONST(SMALL_OBJ_SZW),temp)
480 :     JGE(2f)
481 : monnier 249
482 : monnier 439 PUSH_L(misc0) /* free misc0 */
483 : monnier 249 #define temp1 misc0
484 :    
485 : monnier 439 MOV_L(temp, temp1)
486 :     SHL_L(CONST(TAG_SHIFTW),temp1) /* build descriptor in temp1 */
487 :     OR_L(CONST(MAKE_TAG(DTAG_raw32)), temp1)
488 :     MOV_L(temp1, REGIND(allocptr))/* store the data pointer */
489 :     ADD_L(CONST(4),allocptr) /* allocptr++ */
490 : monnier 249
491 : monnier 439 MOV_L(allocptr, temp1) /* temp1 := data object */
492 :     SHL_L(CONST(2),temp) /* temp := length in bytes */
493 :     ADD_L(temp, allocptr) /* allocptr += length */
494 :     MOV_L(CONST(0),REGOFF(-4,allocptr)) /* zero out the last word */
495 : monnier 249
496 :     /* allocate the header object */
497 : monnier 439 MOV_L(CONST(DESC_string), temp) /* header descriptor */
498 :     MOV_L(temp, REGIND(allocptr))
499 :     ADD_L(CONST(4), allocptr) /* allocptr++ */
500 :     MOV_L(temp1, REGIND(allocptr))/* header data field */
501 :     MOV_L(stdarg, REGOFF(4,allocptr)) /* header length field */
502 :     MOV_L(allocptr, stdarg) /* stdarg := header object */
503 :     ADD_L(CONST(8), allocptr)
504 : monnier 249
505 : monnier 439 POP_L(misc0) /* restore misc0 */
506 : monnier 249 #undef temp1
507 :     CONTINUE
508 :     2:
509 : monnier 439 MOV_L(CONST(REQ_ALLOC_STRING), request_w)
510 : monnier 249 MOVE (stdlink, temp, pc)
511 : monnier 439 JMP(CSYM(set_request))
512 : monnier 249
513 :     /* create_v_a : int * 'a list -> 'a vector
514 :     * creates a vector with elements taken from a list.
515 :     * n.b. The frontend ensures that list cannot be nil.
516 :     */
517 :     ML_CODE_HDR(create_v_a)
518 :     CHECKLIMIT
519 : monnier 439 PUSH_L(misc0)
520 :     PUSH_L(misc1)
521 : monnier 249 #define temp1 misc0
522 :     #define temp2 misc1
523 : monnier 439 MOV_L(REGIND(stdarg),temp) /* temp := length(tagged) */
524 :     MOV_L(temp, temp1)
525 :     SAR_L(CONST(1),temp1) /* temp1 := length(untagged) */
526 :     CMP_L(CONST(SMALL_OBJ_SZW),temp1)
527 :     JGE(3f)
528 : monnier 249
529 :    
530 : monnier 439 SHL_L(CONST(TAG_SHIFTW),temp1) /* build descriptor in temp1 */
531 :     OR_L(CONST(MAKE_TAG(DTAG_vec_data)),temp1)
532 :     MOV_L(temp1,REGIND(allocptr)) /* store descriptor */
533 :     ADD_L(CONST(4),allocptr) /* allocptr++ */
534 :     MOV_L(REGOFF(4,stdarg),temp1) /* temp1 := list */
535 :     MOV_L(allocptr,stdarg) /* stdarg := vector */
536 : monnier 249
537 :     2:
538 : monnier 439 MOV_L(REGIND(temp1),temp2) /* temp2 := hd(temp1) */
539 :     MOV_L(temp2, REGIND(allocptr)) /* store word in vector */
540 :     ADD_L(CONST(4), allocptr) /* allocptr++ */
541 :     MOV_L(REGOFF(4,temp1),temp1) /* temp1 := tl(temp1) */
542 :     CMP_L(CONST(ML_nil),temp1) /* temp1 = nil? */
543 :     JNE(2b)
544 : monnier 249
545 :     /* allocate header object */
546 : monnier 439 MOV_L(CONST(DESC_polyvec),temp1)/* descriptor in temp1 */
547 :     MOV_L(temp1, REGIND(allocptr)) /* store descriptor */
548 :     ADD_L(CONST(4),allocptr) /* allocptr++ */
549 :     MOV_L(stdarg, REGIND(allocptr)) /* header data field */
550 :     MOV_L(temp, REGOFF(4,allocptr)) /* header length */
551 :     MOV_L(allocptr, stdarg) /* result = header object */
552 :     ADD_L(CONST(8),allocptr) /* allocptr += 2 */
553 : monnier 249
554 : monnier 439 POP_L(misc1)
555 :     POP_L(misc0)
556 : monnier 249 CONTINUE
557 :     3:
558 : monnier 439 POP_L(misc1)
559 :     POP_L(misc0)
560 :     MOV_L(CONST(REQ_ALLOC_VECTOR), request_w)
561 : monnier 249 MOVE (stdlink, temp, pc)
562 : monnier 439 JMP(CSYM(set_request))
563 : monnier 249 #undef temp1
564 :     #undef temp2
565 :    
566 :     /* try_lock: spin_lock -> bool.
567 :     * low-level test-and-set style primitive for mutual-exclusion among
568 :     * processors. For now, we only provide a uni-processor trivial version.
569 :     */
570 :     ML_CODE_HDR(try_lock_a)
571 :     #if (MAX_PROCS > 1)
572 :     # error multiple processors not supported
573 :     #else /* (MAX_PROCS == 1) */
574 : monnier 439 MOV_L(REGIND(stdarg), temp) /* Get old value of lock. */
575 :     MOV_L(CONST(1), REGIND(stdarg)) /* Set the lock to ML_false. */
576 :     MOV_L(temp, stdarg) /* Return old value of lock. */
577 : monnier 249 CONTINUE
578 :     #endif
579 :    
580 :     /* unlock : releases a spin lock
581 :     */
582 :     ML_CODE_HDR(unlock_a)
583 :     #if (MAX_PROCS > 1)
584 :     # error multiple processors not supported
585 :     #else /* (MAX_PROCS == 1) */
586 : monnier 439 MOV_L(CONST(3), REGIND(stdarg)) /* Store ML_true into lock. */
587 :     MOV_L(CONST(1), stdarg) /* Return unit. */
588 : monnier 249 CONTINUE
589 :     #endif
590 :    
591 :    
592 :     /********************* Floating point functions. *********************/
593 :    
594 :     #define FPOP fstp %st /* Pop the floating point register stack. */
595 :    
596 :    
597 :     /* Temporary storage for the old and new floating point control
598 :     word. We don't use the stack to for this, since doing so would
599 :     change the offsets of the pseudo-registers. */
600 :     DATA
601 :     ALIGN4
602 :     old_controlwd:
603 :     .word 0
604 :     new_controlwd:
605 :     .word 0
606 :     TEXT
607 :     ALIGN4
608 :    
609 :     /*
610 :     * Initialize the 80387 floating point coprocessor. First, the floating
611 :     * point control word is initialized (undefined fields are left
612 :     * unchanged). Rounding control is set to "nearest" (although floor_a
613 :     * needs "toward negative infinity"). Precision control is set to
614 :     * "double". The precision, underflow, denormal
615 :     * overflow, zero divide, and invalid operation exceptions
616 :     * are masked. Next, seven of the eight available entries on the
617 :     * floating point register stack are claimed (see x86/x86.sml).
618 :     *
619 :     * NB: this cannot trash any registers because it's called from request_fault.
620 :     */
621 :     ENTRY(FPEEnable)
622 : monnier 439 FINIT
623 :     SUB_L(CONST(4), ESP) /* Temp space. Keep stack aligned. */
624 :     FSTCW(REGIND(ESP)) /* Store FP control word. */
625 :     /* Keep undefined fields, clear others. */
626 :     AND_W(CONST(0xf0c0), REGIND(ESP))
627 :     OR_W(CONST(0x023f), REGIND(ESP)) /* Set fields (see above). */
628 :     FLDCW(REGIND(ESP)) /* Install new control word. */
629 :     ADD_L(CONST(4), ESP)
630 :     RET
631 : monnier 249
632 :     #if (defined(OPSYS_LINUX) || defined(OPSYS_SOLARIS))
633 :     ENTRY(fegetround)
634 : monnier 439 SUB_L(CONST(4), ESP) /* allocate temporary space */
635 :     FSTCW(REGIND(ESP)) /* store fp control word */
636 :     SAR_L(CONST(10),REGIND(ESP))/* rounding mode is at bit 10 and 11 */
637 :     AND_L(CONST(3), REGIND(ESP))/* mask two bits */
638 :     MOV_L(REGIND(ESP),EAX) /* return rounding mode */
639 :     ADD_L(CONST(4), ESP) /* deallocate space */
640 :     RET
641 : monnier 249
642 :     ENTRY(fesetround)
643 : monnier 439 SUB_L(CONST(4), ESP) /* allocate temporary space */
644 :     FSTCW(REGIND(ESP)) /* store fp control word */
645 :     AND_W(CONST(0xf3ff), REGIND(ESP)) /* Clear rounding field. */
646 :     MOV_L(REGOFF(8,ESP), EAX) /* new rounding mode */
647 :     SAL_L(CONST(10), EAX) /* move to right place */
648 :     OR_L(EAX,REGIND(ESP)) /* new control word */
649 :     FLDCW(REGIND(ESP)) /* load new control word */
650 :     ADD_L(CONST(4), ESP) /* deallocate space */
651 :     RET
652 : monnier 249 #endif
653 :    
654 :    
655 :     /* floor : real -> int
656 :     Return the nearest integer that is less or equal to the argument.
657 :     Caller's responsibility to make sure arg is in range. */
658 :    
659 :     ML_CODE_HDR(floor_a)
660 : monnier 439 FSTCW(old_controlwd) /* Get FP control word. */
661 :     MOV_W(old_controlwd, AX)
662 :     AND_W(CONST(0xf3ff), AX) /* Clear rounding field. */
663 :     OR_W(CONST(0x0400), AX) /* Round towards neg. infinity. */
664 :     MOV_W(AX, new_controlwd)
665 :     FLDCW(new_controlwd) /* Install new control word. */
666 : monnier 249
667 : monnier 439 FLD_D(REGIND(stdarg))
668 :     SUB_L(CONST(4), ESP)
669 :     FISTP_L(REGIND(ESP)) /* Round, store, and pop. */
670 :     POP_L(stdarg)
671 :     SAL_L(CONST(1), stdarg) /* Tag the resulting integer. */
672 :     INC_L(stdarg)
673 : monnier 249
674 : monnier 439 FLDCW(old_controlwd) /* Restore old FP control word. */
675 : monnier 249 CONTINUE
676 :    
677 :     /* logb : real -> int
678 :     * Extract the unbiased exponent pointed to by stdarg.
679 :     * Note: Using fxtract, and fistl does not work for inf's and nan's.
680 :     */
681 :     ML_CODE_HDR(logb_a)
682 : monnier 439 MOV_L(REGOFF(4,stdarg),temp) /* msb for little endian arch */
683 :     SAR_L(CONST(20), temp) /* throw out 20 bits */
684 :     AND_L(CONST(0x7ff),temp) /* clear all but 11 low bits */
685 :     SUB_L(CONST(1023), temp) /* unbias */
686 :     SAL_L(CONST(1), temp) /* room for tag bit */
687 :     ADD_L(CONST(1), temp) /* tag bit */
688 :     MOV_L(temp, stdarg)
689 : monnier 249 CONTINUE
690 :    
691 :    
692 :     /* scalb : (real * int) -> real
693 :     * Scale the first argument by 2 raised to the second argument. Raise
694 :     * Float("underflow") or Float("overflow") as appropriate.
695 :     * NB: We assume the first floating point "register" is
696 :     * caller-save, so we can use it here (see x86/x86.sml). */
697 :    
698 :     ML_CODE_HDR(scalb_a)
699 :     CHECKLIMIT
700 : monnier 439 PUSH_L(REGOFF(4,stdarg)) /* Get copy of scalar. */
701 :     SAR_L(CONST(1), REGIND(ESP)) /* Untag it. */
702 :     FILD_L(REGIND(ESP)) /* Load it ... */
703 : monnier 249 /* fstp %st(1) */ /* ... into 1st FP reg. */
704 : monnier 439 MOV_L(REGIND(stdarg), temp) /* Get pointer to real. */
705 :     FLD_D(REGIND(temp)) /* Load it into temp. */
706 : monnier 249
707 : monnier 439 FSCALE /* Multiply exponent by scalar. */
708 :     MOV_L(CONST(DESC_reald), REGIND(allocptr))
709 :     FSTP_D(REGOFF(4,allocptr)) /* Store resulting float. */
710 :     ADD_L(CONST(4), allocptr) /* Allocate word for tag. */
711 :     MOV_L(allocptr, stdarg) /* Return a pointer to the float. */
712 :     ADD_L(CONST(8), allocptr) /* Allocate room for float. */
713 :     FSTP_D(REGIND(ESP))
714 :     ADD_L(CONST(4), ESP) /* Discard copy of scalar. */
715 : monnier 249 CONTINUE
716 :    
717 :     /* end of X86.prim.asm */

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