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/SMLNJ/src/runtime/mach-dep/ALPHA32.prim.asm
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/runtime/mach-dep/ALPHA32.prim.asm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 243 - (view) (download)

1 : monnier 2 /* ALPHA32.prim.asm
2 :     *
3 :     * ALPHA32 runtime code for ML.
4 :     *
5 :     * ML register usage follows:
6 :     *
7 :     * register C callee ML use
8 :     * save?
9 :     * -------- --------- -------
10 :     * $0 no standard arg
11 :     * $1 no standard continuation
12 :     * $2 no standard closure
13 :     * $3 no standard link register
14 :     * $4 no base address register
15 : monnier 239 * $5-$8 no miscellaneous registers
16 : monnier 2 * $9 yes heap limit pointer
17 :     * $10 yes var pointer
18 :     * $11 yes heap-limit comparison flag, and arith temporary
19 : monnier 239 * $12 yes store list pointer
20 : monnier 2 * $13 yes allocation pointer
21 :     * $14 yes exception continuation
22 : monnier 239 * $15 yes miscellaneous register
23 :     * $16-$25 no miscellaneous registers
24 :     * $26 no ml-pc
25 :     * $27 no miscellaneous register
26 : monnier 2 * $28 no assembler temporary
27 :     * $29 - reserved for C (global pointer)
28 :     * $30 - reserved for C (stack pointer)
29 : monnier 239 * $31 - constant zero
30 : monnier 2 */
31 :    
32 :     #include <regdef.h>
33 :     #include "ml-base.h"
34 :     #include "asm-base.h"
35 :     #include "ml-values.h"
36 :     #include "tags.h"
37 :     #include "ml-request.h"
38 :     #include "ml-limits.h"
39 :     #include "mlstate-offsets.h" /** this file is generated **/
40 :    
41 :    
42 :     #define STDARG $0 /* standard arg (ml_arg) */
43 :     #define STDCONT $1 /* standard continuation (ml_cont) */
44 :     #define STDCLOS $2 /* standard closure (ml_closure) */
45 :     #define STDLINK $3 /* ptr to just-entered std function (ml_link) */
46 : monnier 239 #define MISCREG0 $5
47 :     #define MISCREG1 $6
48 :     #define MISCREG2 $7
49 : monnier 2 #define LIMITPTR $9 /* end of heap - 4096 (ml_limitptr) */
50 :     #define VARPTR $10 /* per-thread var pointer (ml_varptr) */
51 :     #define NEEDGC $11 /* arith temp; also, heap-limit comparison flag */
52 :     #define STOREPTR $12 /* store pointer (ml_storeptr) */
53 :     #define ALLOCPTR $13 /* freespace pointer (ml_allocptr) */
54 :     #define EXNCONT $14 /* exception handler (ml_exncont) */
55 : monnier 239 #define PC $26 /* address to return/goto in ML */
56 : monnier 2 /* assembler-temp $28 */
57 :     /* globalptr $29 reserved for C and assembler */
58 :     /* stackptr $30 stack pointer */
59 :     /* zero $31 zero */
60 :    
61 :     #define CRESULT $0
62 :     #define CARG0 $16
63 :    
64 :     #define ATMP1 $20
65 :     #define ATMP2 $21
66 :     #define ATMP3 $22
67 :     #define ATMP4 $23
68 : monnier 239 #define PTRTMP $24
69 : monnier 2
70 :     /* The ML stack frame has the following layout (set up by restoreregs):
71 :     * +-------------------+
72 :     * sp+124 | ml_divlu |
73 :     * +-------------------+
74 :     * sp+120 | ml_divl |
75 :     * +-------------------+
76 :     * sp+116 | pseudo reg 2 |
77 :     * +-------------------+
78 :     * sp+112 | pseudo reg 1 |
79 :     * +-------------------+
80 :     * sp+104: | temporary storage | temporary use by floating
81 :     * +-------------------+ point code.
82 :     * sp+96: | temporary storage |
83 :     * +-------------------+
84 :     * sp+88: | saved $30 |
85 :     * +-------------------+
86 :     * sp+80: | saved $29 |
87 :     * +-------------------+
88 : monnier 239 * sp+72: | saved $26 |
89 : monnier 2 * +-------------------+
90 :     * sp+64: | saved $15 |
91 :     * +-------------------+
92 :     * sp+56: | saved $14 |
93 :     * +-------------------+
94 :     * sp+48: | saved $13 |
95 :     * +-------------------+
96 :     * sp+40: | saved $12 |
97 :     * +-------------------+
98 :     * sp+32: | saved $11 |
99 :     * +-------------------+
100 :     * sp+24: | saved $10 |
101 :     * +-------------------+
102 :     * sp+16: | saved $9 |
103 :     * +-------------------+
104 :     * sp+8: | addr of saveregs |
105 :     * +-------------------+
106 :     * sp: | ptr to MLState |
107 :     * +-------------------+
108 :     */
109 :    
110 :     #define ML_FRAMESIZE 4096
111 :     #define MLSTATE_OFFSET 0
112 :     #define STARTGC_OFFSET 8
113 :     #define REGSAVE_OFFSET 16
114 :     #define PSEUDOREG_OFFSET 112
115 :     #define ML_DIVL_OFFSET 120
116 :     #define ML_DIVLU_OFFSET 124
117 :    
118 :     #ifdef ALLIGN_ALLOCATION
119 :     # define ALLOCALIGN \
120 :     addl ALLOCPTR,4,ALLOCPTR; \
121 :     bic ALLOCPTR,4,ALLOCPTR;
122 :     #else
123 :     # define ALLOCALIGN
124 :     #endif
125 :    
126 : monnier 239 #define CONTINUE \
127 :     ALLOCALIGN \
128 :     cmplt LIMITPTR,ALLOCPTR,NEEDGC; \
129 : monnier 2 jmp (STDCONT);
130 :    
131 : monnier 239 #define CHECKLIMIT \
132 : monnier 243 mov STDLINK, PC; \
133 : monnier 239 beq NEEDGC,3f; \
134 :     br saveregs; \
135 : monnier 2 3:
136 :    
137 :    
138 :     DATA
139 :     .align 3
140 :     one_half: .t_floating 0.5
141 :     fsr_bits: .quad 0x8a70000000000000
142 :    
143 :     TEXT
144 :    
145 :    
146 :     /* sigh_return_a:
147 :     * The return continuation for the ML signal handler.
148 :     */
149 :     ML_CODE_HDR(sigh_return_a)
150 :     mov REQ_SIG_RETURN,ATMP1
151 : monnier 239 mov ML_unit, STDLINK
152 :     mov ML_unit, STDCLOS
153 :     mov ML_unit, PC
154 : monnier 2 br set_request
155 :    
156 :    
157 :     /* sigh_resume:
158 :     * Resume execution at the point at which a handler trap occurred. This is a
159 :     * standard two-argument function, thus the closure is in ml_cont (%stdcont).
160 :     */
161 :     ENTRY(sigh_resume)
162 :     mov REQ_SIG_RESUME,ATMP1
163 : monnier 239 mov ML_unit, STDLINK
164 :     mov ML_unit, STDCLOS
165 :     mov ML_unit, PC
166 : monnier 2 br set_request
167 :    
168 :     /* pollh_return_a
169 :     * The return continuation for the ML poll handler.
170 :     */
171 :     ML_CODE_HDR(pollh_return_a)
172 :     mov REQ_POLL_RESUME,ATMP1
173 : monnier 239 mov ML_unit, STDLINK
174 :     mov ML_unit, STDCLOS
175 :     mov ML_unit, PC
176 : monnier 2 br set_request
177 :    
178 :     /* pollh_resume:
179 :     * Resume execution at the point at which a poll event occurred.
180 :     */
181 :     ENTRY(pollh_resume)
182 :     mov REQ_POLL_RETURN,ATMP1
183 : monnier 239 mov ML_unit, STDLINK
184 :     mov ML_unit, STDCLOS
185 :     mov ML_unit, PC
186 : monnier 2 br set_request
187 :    
188 :     ML_CODE_HDR(handle_a)
189 :     mov REQ_EXN,ATMP1
190 : monnier 239 mov STDLINK, PC
191 : monnier 2 br set_request
192 :    
193 :     ML_CODE_HDR(return_a)
194 :     mov REQ_RETURN,ATMP1
195 : monnier 239 mov ML_unit, STDLINK
196 :     mov ML_unit, STDCLOS
197 :     mov ML_unit, PC
198 : monnier 2 br set_request
199 :    
200 :     ENTRY(request_fault)
201 :     mov REQ_FAULT,ATMP1
202 : monnier 239 mov STDLINK, PC
203 : monnier 2 br set_request
204 :    
205 :     /* bind_cfun : (string * string) -> c_function
206 :     */
207 :     ML_CODE_HDR(bind_cfun_a)
208 : monnier 239 CHECKLIMIT
209 : monnier 2 mov REQ_BIND_CFUN,ATMP1
210 :     br set_request
211 :    
212 :     ML_CODE_HDR(build_literals_a)
213 : monnier 239 CHECKLIMIT
214 : monnier 2 mov REQ_BUILD_LITERALS,ATMP1
215 :     br set_request
216 :    
217 :     ML_CODE_HDR(callc_a)
218 : monnier 239 CHECKLIMIT
219 : monnier 2 mov REQ_CALLC,ATMP1
220 : monnier 239 br set_request
221 :    
222 :     BEGIN_PROC(saveregs)
223 :     ENTRY(saveregs)
224 :     mov REQ_GC,ATMP1
225 :    
226 : monnier 2 /* fall through */
227 :    
228 : monnier 239 set_request:
229 :     ldq PTRTMP,MLSTATE_OFFSET(sp) /* get the ML state ptr */
230 : monnier 2 ldq NEEDGC,VProcOffMSP(PTRTMP) /* use NEEDGC for VProcPtr */
231 :     stl zero,InMLOffVSP(NEEDGC) /* note that we have left ML */
232 :     stl ALLOCPTR,AllocPtrOffMSP(PTRTMP)
233 :     stl LIMITPTR,LimitPtrOffMSP(PTRTMP)
234 :     stl STOREPTR,StorePtrOffMSP(PTRTMP)
235 :     stl STDLINK,LinkRegOffMSP(PTRTMP)
236 : monnier 239 stl PC,PCOffMSP(PTRTMP)
237 : monnier 2 stl STDARG,StdArgOffMSP(PTRTMP)
238 :     stl STDCLOS,StdClosOffMSP(PTRTMP)
239 :     stl STDCONT,StdContOffMSP(PTRTMP)
240 :     stl VARPTR,VarPtrOffMSP(PTRTMP)
241 :     stl EXNCONT,ExnPtrOffMSP(PTRTMP)
242 :     mov ATMP1,CRESULT /* return request */
243 : monnier 239 stl MISCREG0,Misc0OffMSP(PTRTMP)
244 :     stl MISCREG1,Misc1OffMSP(PTRTMP)
245 :     stl MISCREG2,Misc2OffMSP(PTRTMP)
246 :     /* fall through */
247 :     .end saveregs
248 :    
249 : monnier 2 /* restore callee-save C registers */
250 :     restore_c_regs:
251 :     ldq $30,REGSAVE_OFFSET+72(sp)
252 :     ldq $29,REGSAVE_OFFSET+64(sp)
253 :     ldq $26,REGSAVE_OFFSET+56(sp)
254 :     ldq $15,REGSAVE_OFFSET+48(sp)
255 :     ldq $14,REGSAVE_OFFSET+40(sp)
256 :     ldq $13,REGSAVE_OFFSET+32(sp)
257 :     ldq $12,REGSAVE_OFFSET+24(sp)
258 :     ldq $11,REGSAVE_OFFSET+16(sp)
259 :     ldq $10,REGSAVE_OFFSET+8(sp)
260 :     ldq $9 ,REGSAVE_OFFSET(sp)
261 :     addq sp,ML_FRAMESIZE /* discard the stack frame */
262 :     jmp ($26) /* return to run_ml() */
263 :    
264 :    
265 :     BEGIN_PROC(restoreregs)
266 :     ENTRY(restoreregs)
267 :     subq sp,ML_FRAMESIZE /* allocate a stack frame */
268 :     .frame sp,ML_FRAMESIZE,zero
269 :     .mask 0xe000fe00,0
270 :     /* save the C registers */
271 :     lda $3,saveregs
272 :     stq CARG0,MLSTATE_OFFSET(sp) /* save MLState ptr for return to C */
273 :     stq $3,STARTGC_OFFSET(sp) /* so ML can find saveregs! */
274 :     lda $3,ml_divl /* address of ml_divl */
275 :     stl $3,ML_DIVL_OFFSET(sp)
276 :     lda $3,ml_divlu /* address of ml_divlu */
277 :     stl $3,ML_DIVLU_OFFSET(sp)
278 :     stq $30,REGSAVE_OFFSET+72(sp)
279 :     stq $29,REGSAVE_OFFSET+64(sp)
280 :     stq $26,REGSAVE_OFFSET+56(sp)
281 :     stq $15,REGSAVE_OFFSET+48(sp)
282 :     stq $14,REGSAVE_OFFSET+40(sp)
283 :     stq $13,REGSAVE_OFFSET+32(sp)
284 :     stq $12,REGSAVE_OFFSET+24(sp)
285 :     stq $11,REGSAVE_OFFSET+16(sp)
286 :     stq $10,REGSAVE_OFFSET+8(sp)
287 :     stq $9,REGSAVE_OFFSET(sp)
288 :     mov CARG0,PTRTMP /* put MLState ptr in ptrtmp */
289 :    
290 :     ldl ALLOCPTR,AllocPtrOffMSP(PTRTMP)
291 :     ldl LIMITPTR,LimitPtrOffMSP(PTRTMP)
292 :     ldl STOREPTR,StorePtrOffMSP(PTRTMP)
293 :     ldl NEEDGC,VProcOffMSP(PTRTMP) /* use NEEDGC for VProc Ptr */
294 :     mov 1,ATMP1
295 :     .set noreorder /* the order here is important */
296 :     stl ATMP1,InMLOffVSP(NEEDGC) /* note that we are entering ML code */
297 :     ldl STDARG,StdArgOffMSP(PTRTMP)
298 :     ldl STDCONT,StdContOffMSP(PTRTMP)
299 :     ldl STDCLOS,StdClosOffMSP(PTRTMP)
300 :     ldl EXNCONT,ExnPtrOffMSP(PTRTMP)
301 : monnier 239 ldl MISCREG0,Misc0OffMSP(PTRTMP)
302 :     ldl MISCREG1,Misc1OffMSP(PTRTMP)
303 :     ldl MISCREG2,Misc2OffMSP(PTRTMP)
304 : monnier 2 ldl STDLINK,LinkRegOffMSP(PTRTMP)
305 : monnier 239 ldl PC,PCOffMSP(PTRTMP)
306 : monnier 2 ldl VARPTR,VarPtrOffMSP(PTRTMP)
307 :     /* check for pending signals */
308 :     ldl PTRTMP,NPendingSysOffVSP(NEEDGC)
309 :     .set noat
310 :     ldl $28,NPendingOffVSP(NEEDGC)
311 :     addq PTRTMP,$28,PTRTMP
312 :     .set at
313 :     bne PTRTMP,pending_sigs
314 :     .end restoreregs
315 :     .ent ml_go
316 :     ENTRY(ml_go)
317 :     ALLOCALIGN
318 :     cmplt LIMITPTR,ALLOCPTR,NEEDGC
319 : monnier 239 jmp (PC) /* jump/return to ML code */
320 : monnier 2 .end ml_go
321 :    
322 :     pending_sigs: /* there are pending signals */
323 :     /* check if we are currently handling a signal */
324 :     ldl PTRTMP,InSigHandlerOffVSP(NEEDGC)
325 :     bne PTRTMP,ml_go
326 :     /* note that a handler trap is pending */
327 :     mov 1,PTRTMP
328 :     stl PTRTMP,HandlerPendingOffVSP(NEEDGC)
329 :     mov ALLOCPTR,LIMITPTR
330 :     br ml_go
331 :     .set reorder
332 :    
333 :    
334 :     /* SaveFPRegs:
335 :     *
336 :     * void SaveFPRegs (Word_t *p)
337 :     *
338 :     * Save the C callee-save FP registers starting at the given address.
339 :     */
340 :     TEXT
341 :     BEGIN_PROC(SaveFPRegs)
342 :     ENTRY(SaveFPRegs)
343 :     stt $f2,0(a0)
344 :     stt $f3,8(a0)
345 :     stt $f4,16(a0)
346 :     stt $f5,24(a0)
347 :     stt $f6,32(a0)
348 :     stt $f7,40(a0)
349 :     stt $f8,48(a0)
350 :     stt $f9,56(a0)
351 :     jmp (ra) /* return */
352 :     END_PROC(SaveFPRegs)
353 :    
354 :     /* RestoreFPRegs:
355 :     *
356 :     * void RestoreFPRegs (Word_t *p)
357 :     *
358 :     * Restore the C callee-save FP registers from the given address.
359 :     */
360 :     BEGIN_PROC(RestoreFPRegs)
361 :     ENTRY(RestoreFPRegs) /* floats address passed as parm */
362 :     ldt $f2,0(a0) /* retrieve float registers */
363 :     ldt $f3,8(a0)
364 :     ldt $f4,16(a0)
365 :     ldt $f5,24(a0)
366 :     ldt $f6,32(a0)
367 :     ldt $f7,40(a0)
368 :     ldt $f8,48(a0)
369 :     ldt $f9,56(a0)
370 :     jmp (ra)
371 :     END_PROC(RestoreFPRegs)
372 :    
373 :    
374 :     /** Primitive object allocation routines **/
375 :    
376 :     /* array : (int * 'a) -> 'a array
377 :     * Allocate and initialize a new array. This can cause GC.
378 :     */
379 :     ML_CODE_HDR(array_a)
380 : monnier 239 CHECKLIMIT
381 : monnier 223
382 :     ldl ATMP1,0(STDARG) /* tmp1 := length in words */
383 :     sra ATMP1,1,ATMP2 /* tmp2 := length (untagged) */
384 :     subl ATMP2,SMALL_OBJ_SZW,ATMP3 /* is this a small object? */
385 :     bgt ATMP3,2f /* branch if large object */
386 :    
387 :     ldl STDARG,4(STDARG) /* initial value */
388 :     sll ATMP2,TAG_SHIFTW,ATMP3 /* build descriptor in tmp3 */
389 :     or ATMP3,MAKE_TAG(DTAG_arr_data),ATMP3
390 : monnier 2 stl ATMP3,0(ALLOCPTR) /* store descriptor */
391 :     addq ALLOCPTR,4 /* allocptr++ */
392 : monnier 223 mov ALLOCPTR,ATMP3 /* array data ptr in tmp3 */
393 :     1:
394 :     stl STDARG,0(ALLOCPTR) /* initialize array */
395 :     subl ATMP2, 1, ATMP2
396 :     addq ALLOCPTR,4
397 :     bne ATMP2,1b
398 :    
399 :     /* allocate array header */
400 :     mov DESC_polyarr,ATMP2 /* descriptor in tmp2 */
401 :     stl ATMP2,0(ALLOCPTR) /* store descriptor */
402 :     addq ALLOCPTR, 4 /* allocptr++ */
403 :     mov ALLOCPTR,STDARG /* result = header addr */
404 :     stl ATMP3, 0(ALLOCPTR) /* store pointer to data */
405 :     stl ATMP1, 4(ALLOCPTR)
406 :     addq ALLOCPTR,8
407 : monnier 2 CONTINUE
408 :    
409 : monnier 223 2: /* off-line allocation of big arrays */
410 : monnier 2 mov REQ_ALLOC_ARRAY,ATMP1
411 : monnier 239 mov STDLINK, PC
412 : monnier 2 br set_request
413 :    
414 :     /* create_r : int -> realarray
415 :     * Create a new realarray.
416 :     */
417 :     ML_CODE_HDR(create_r_a)
418 : monnier 239 CHECKLIMIT
419 : monnier 223
420 :     sra STDARG,1,ATMP2 /* atmp2 = length (untagged int) */
421 :     sll ATMP2,1,ATMP2 /* atmp2 = length in words */
422 : monnier 2 subl ATMP2,SMALL_OBJ_SZW,ATMP3
423 :     bgt ATMP3,1f /* is this a small object? */
424 : monnier 223 /* allocate the data object */
425 :     sll ATMP2,TAG_SHIFTW,ATMP1 /* build data descriptor in tmp1 */
426 :     or ATMP1, MAKE_TAG(DTAG_raw64),ATMP1
427 : monnier 2 #ifdef ALIGN_REALDS
428 :     or ALLOCPTR,4,ALLOCPTR /* tag is unaligned, so that the */
429 :     /* first element is 8-byte aligned */
430 :     #endif
431 : monnier 223 stl ATMP1,0(ALLOCPTR) /* store the descriptor */
432 :     addq ALLOCPTR,4 /* allocptr++ */
433 :     mov ALLOCPTR,ATMP3 /* tmp3 = data object */
434 :     sll ATMP2, 2, ATMP2 /* tmp2 = length in bytes */
435 :     addq ALLOCPTR, ATMP2,ALLOCPTR /* allocptr += length */
436 :     /* allocate the header object */
437 :     mov DESC_real64arr,ATMP1
438 :     stl ATMP1,0(ALLOCPTR) /* header descriptor */
439 :     addq ALLOCPTR,4 /* allocptr++ */
440 :     stl ATMP3,0(ALLOCPTR) /* header data field */
441 :     stl STDARG,4(ALLOCPTR) /* header length field */
442 :     mov ALLOCPTR,STDARG /* stdarg = header object */
443 :     addq ALLOCPTR,8
444 : monnier 2 CONTINUE
445 :    
446 :     1: /* off-line allocation of big realarrays */
447 :     mov REQ_ALLOC_REALDARRAY,ATMP1
448 : monnier 239 mov STDLINK, PC
449 : monnier 2 br set_request
450 :    
451 :     /* create_b : int -> bytearray
452 :     * Create a bytearray of the given length.
453 :     */
454 :     ML_CODE_HDR(create_b_a)
455 : monnier 239 CHECKLIMIT
456 : monnier 223
457 :     sra STDARG,1,ATMP2 /* atmp2 = length (untagged int) */
458 :     addq ATMP2,3,ATMP2 /* atmp2 = length in words */
459 : monnier 2 sra ATMP2,2
460 :     subq ATMP2,SMALL_OBJ_SZW,ATMP3 /* is this a small object? */
461 :     bgt ATMP3,1f
462 : monnier 223 /* allocate the data object */
463 :     sll ATMP2,TAG_SHIFTW,ATMP1 /* build descriptor in atmp1 */
464 :     or ATMP1,MAKE_TAG(DTAG_raw32),ATMP1
465 :     stl ATMP1,0(ALLOCPTR) /* store the data descriptor */
466 :     addq ALLOCPTR,4 /* allocptr++ */
467 :     mov ALLOCPTR,ATMP3 /* tmp3 = data object */
468 :     sll ATMP2,2 /* tmp2 = length in bytes */
469 :     addq ALLOCPTR,ATMP2,ALLOCPTR /* allocptr += total length */
470 :     /* allocate the header object */
471 :     mov DESC_word8arr,ATMP1 /* header descriptor */
472 :     stl ATMP1,0(ALLOCPTR)
473 :     addq ALLOCPTR,4 /* allocptr++ */
474 :     stl ATMP3,0(ALLOCPTR) /* header data field */
475 :     stl STDARG,4(ALLOCPTR) /* header length field */
476 :     mov ALLOCPTR,STDARG /* stdarg = header object */
477 :     addq ALLOCPTR,8 /* allocptr += 2 */
478 : monnier 2 CONTINUE
479 :     1: /* off-line allocation of big bytearrays */
480 :     mov REQ_ALLOC_BYTEARRAY,ATMP1
481 : monnier 239 mov STDLINK, PC
482 : monnier 2 br set_request
483 :    
484 :     /* create_s : int -> string
485 :     * Create a string of the given length (assume length >0).
486 :     */
487 :     ML_CODE_HDR(create_s_a)
488 : monnier 239 CHECKLIMIT
489 : monnier 223
490 :     sra STDARG,1,ATMP2 /* tmp2 = length (untagged int) */
491 :     addq ATMP2,4,ATMP2 /* atmp2 = length in words */
492 : monnier 2 sra ATMP2,2
493 :     subq ATMP2,SMALL_OBJ_SZW,ATMP3
494 : monnier 223 bgt ATMP3,1f /* is this a small object? */
495 :    
496 :     sll ATMP2,TAG_SHIFTW,ATMP1 /* build descriptor in atmp3 */
497 :     or ATMP1,MAKE_TAG(DTAG_raw32),ATMP1
498 :     stl ATMP1,0(ALLOCPTR) /* store the data descriptor */
499 :     addq ALLOCPTR,4 /* allocptr++ */
500 :     mov ALLOCPTR,ATMP3 /* tmp3 = data object */
501 :     sll ATMP2,2 /* tmp2 = length in bytes */
502 :     addq ALLOCPTR,ATMP2,ALLOCPTR /* allocptr += total length */
503 :     stl zero,-4(ALLOCPTR) /* store zero in last word */
504 :     /* Allocate the header object */
505 :     mov DESC_string, ATMP1 /* header descriptor */
506 :     stl ATMP1,0(ALLOCPTR)
507 :     addq ALLOCPTR,4 /* allocptr++ */
508 :     stl ATMP3,0(ALLOCPTR) /* header data field */
509 :     stl STDARG,4(ALLOCPTR) /* heder length field */
510 :     mov ALLOCPTR,STDARG /* stdarg = header object */
511 :     addq ALLOCPTR,8
512 : monnier 2 CONTINUE
513 :     1: /* off-line allocation of big strings */
514 :     mov REQ_ALLOC_STRING,ATMP1
515 : monnier 239 mov STDLINK, PC
516 : monnier 2 br set_request
517 :    
518 :     /* create_v_a : (int * 'a list) -> 'a vector
519 :     * Create a vector with elements taken from a list.
520 :     * NOTE: the front-end ensures that list cannot be nil.
521 :     */
522 :     ML_CODE_HDR(create_v_a)
523 : monnier 239 CHECKLIMIT
524 : monnier 223
525 :     ldl ATMP1,0(STDARG) /* tmp1 := length (tagged int) */
526 :     sra ATMP1,1,ATMP2 /* tmp2 := length (untagged) */
527 :     subq ATMP2,SMALL_OBJ_SZW,ATMP3
528 :     bgt ATMP3,1f /* is this a small object? */
529 :    
530 :     sll ATMP2,TAG_SHIFTW,ATMP2 /* build descriptor in tmp2 */
531 :     or ATMP2,MAKE_TAG(DTAG_vec_data),ATMP2
532 :     stl ATMP2,0(ALLOCPTR) /* store descriptor */
533 :     addq ALLOCPTR,4 /* allocptr++ */
534 :     ldl ATMP2,4(STDARG) /* atmp2 := list */
535 :     mov ALLOCPTR,STDARG /* stdarg := vector */
536 :     2: /* loop: */
537 :     ldl ATMP3,0(ATMP2) /* tmp3 := hd(tmp2) */
538 :     ldl ATMP2,4(ATMP2) /* tmp2 := tl(tmp2) */
539 :     stl ATMP3,0(ALLOCPTR) /* store word in vector */
540 :     addq ALLOCPTR,4 /* allocptr++ */
541 :     cmpeq ATMP2,ML_nil,ATMP3 /* tmp3 := 1 if tmp2=ML_nil */
542 :     beq ATMP3, 2b
543 :     /* allocate header object */
544 :     mov DESC_polyvec,ATMP3 /* descriptor in tmp3 */
545 :     stl ATMP3,0(ALLOCPTR) /* store descriptor */
546 :     addq ALLOCPTR,4 /* allocptr++ */
547 :     stl STDARG,0(ALLOCPTR) /* header data field */
548 :     stl ATMP1,4(ALLOCPTR) /* header length */
549 :     mov ALLOCPTR, STDARG /* result = header object */
550 :     addq ALLOCPTR, 8 /* allocptr += 2 */
551 : monnier 2 CONTINUE
552 :    
553 :     1: /* off-line allocation for large vectors */
554 :     mov REQ_ALLOC_VECTOR,ATMP1
555 : monnier 239 mov STDLINK, PC
556 : monnier 2 br set_request
557 :    
558 :     /* Floating exceptions raised (assuming ROP's are never passed to functions):
559 :     * DIVIDE BY ZERO - (div)
560 :     * OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate
561 :     *
562 :     * floor raises integer overflow if the float is out of 32-bit range,
563 : monnier 8 * Does not check for out-of-range ; it's up to the ML code to do that first. */
564 : monnier 2 #ifdef NEW_FLOOR
565 :     DATA
566 :     .align 3
567 :     floor_MAXFLOAT: .quad 0x4330080000000000
568 :    
569 :     .text
570 :    
571 :     ML_CODE_HDR(floor_a)
572 :     /* check for overflow */
573 :     ldgp gp, 0(STDLINK)
574 :     ldt $f0, 0(STDARG)
575 :    
576 :     subq $30, 16, $30 /* allocate stack space */
577 :     /* Do floor; neat thing is that this works
578 :     ** for both +ve and -ve floating point numbers!
579 :     */
580 :     ldt $f1, floor_MAXFLOAT
581 :     addtm $f0, $f1, $f1
582 :     stt $f1, 0($30)
583 :     ldl ATMP1, 0($30)
584 :     addl ATMP1, ATMP1, ATMP1
585 :     addl ATMP1, 1, STDARG
586 :    
587 :     addq $30, 16, $30
588 :     CONTINUE
589 :    
590 :     #else /* !NEW_FLOOR */
591 :     DATA
592 :     .align 3
593 :     floor_HALF: .t_floating 0.5
594 :    
595 :     .text
596 :    
597 :     ML_CODE_HDR(floor_a)
598 :     ldgp gp, 0(STDLINK)
599 :     ldt $f0, 0(STDARG) /* get argument */
600 :     subq $30, 16, $30 /* allocate stack space */
601 :     fblt $f0, floor_negative_arg
602 :    
603 :     floor_positive_arg:
604 :     cvttqc $f0, $f1
605 :     stt $f1, 0($30)
606 :     ldl ATMP1, 0($30)
607 :     addl ATMP1, ATMP1, ATMP1
608 :     addl ATMP1, 1, STDARG
609 :    
610 :     addq $30, 16, $30
611 :     CONTINUE
612 :    
613 :    
614 :     floor_negative_arg:
615 :    
616 :     /* cvttqm (x) = cvttq (2*x - 0.5) / 2 */
617 :     /* cvttq (x-0.5) loses for odd integers which IEEE round to evens */
618 :     ldt $f1, floor_HALF
619 :     addt $f0, $f0, $f0
620 :     subt $f0, $f1, $f0
621 :     cvttq $f0, $f0
622 :     stt $f0, 0($30)
623 :     ldl STDARG, 0($30)
624 :     /* STDARG now holds either 2*floor(x) or 2*floor(x)+1. */
625 :     /* convert to ml int by setting least bit! */
626 :     bis STDARG, 1, STDARG
627 :    
628 :     addq $30, 16, $30
629 :     CONTINUE
630 :    
631 :     #endif
632 :    
633 :    
634 :     ML_CODE_HDR(logb_a)
635 :     ldq STDARG,(STDARG) /* get argument */
636 :     srl STDARG,52 /* throw out 52 low bits */
637 :     and STDARG,0x07ff /* clear all but 11 low bits */
638 :     subq STDARG,1023 /* subtract 1023 */
639 :     sll STDARG,1 /* make room for tag bit */
640 :     addq STDARG,1 /* add the tag bit */
641 :     CONTINUE
642 :    
643 :     ML_CODE_HDR(scalb_a)
644 : monnier 239 CHECKLIMIT
645 : monnier 2 ldl PTRTMP,0(STDARG) /* address of float */
646 :     ldq ATMP2,0(PTRTMP) /* get float */
647 :     ldl ATMP1,4(STDARG) /* get tagged n */
648 :     sra ATMP1,1,ATMP1 /* real n */
649 :     beq ATMP1,9f /* branch if n=0 */
650 :     sra ATMP2,52,ATMP3 /* shift out fraction of float */
651 :     and ATMP3,0xfff,ATMP3 /* just exponent of float */
652 :     addq ATMP3,ATMP1,ATMP3 /* n + exponent */
653 :     ble ATMP3,6f /* branch if underflow */
654 :     sll ATMP1,52,ATMP1 /* n in exponent position */
655 :     addqv ATMP2,ATMP1,ATMP1 /* add n to exponent, with overflow */
656 :     3: /* return float in atmp1 */
657 :     or ALLOCPTR,4,ALLOCPTR /* unalign allocptr to align float */
658 :     mov DESC_reald,ATMP2 /* get desc */
659 :     stl ATMP2,0(ALLOCPTR) /* store desc */
660 :     stq ATMP1,4(ALLOCPTR) /* store float */
661 :     addq ALLOCPTR,4,STDARG /* return boxed float */
662 :     addq ALLOCPTR,12,ALLOCPTR /* set allocptr */
663 :     CONTINUE
664 :     6: /* underflow -- return zero */
665 :     mov 0,ATMP1
666 :     br 3b
667 :     9: /* n=0 -- return original float */
668 :     mov PTRTMP,STDARG
669 :     CONTINUE
670 :    
671 :     /* ml_divl
672 :     * Incoming parameters in $16 and $17, result in $0
673 :     */
674 :     ENTRY(ml_divl) /* divide longword */
675 :     beq $17, divZero /* check for div-by-zero */
676 :     ornot $31, $17, $0 /* is divisor -1 */
677 :     bne $0, do_ml_divl /* NO */
678 :     sublv $31, $16, $0 /* is dividend largest negative int */
679 :     trapb /* YES */
680 :     do_ml_divl:
681 :     divl $16, $17, $0 /* do divl */
682 :     ret $31, ($26), 1
683 :    
684 :    
685 :     /* ml_divlu
686 :     * Incoming parameters in $16 and $17, result in $0
687 :     */
688 :     ENTRY(ml_divlu) /* divide longwork unsigned */
689 :     beq $17, divZero /* check for div-by-zero */
690 :     divlu $16, $17, $0 /* do divlu */
691 :     ret $31, ($26), 1
692 :    
693 :     divZero:
694 :     lda $16, -2($31) /* generate div-by-zero */
695 :     call_pal 0xaa /* gentrap */
696 :    
697 :    
698 :     /* try_lock : spin_lock -> bool
699 :     * low-level test-and-set style primitive for mutual-exclusion among
700 :     * processors.
701 :     */
702 :     ML_CODE_HDR(try_lock_a)
703 :     #if (MAX_PROCS > 1)
704 :     ???
705 :     #else (MAX_PROCS == 1)
706 :     ldl ATMP1,0(STDARG)
707 :     mov ML_false,ATMP2
708 :     stl ATMP2,0(STDARG)
709 :     mov ATMP1,STDARG
710 :     CONTINUE
711 :     #endif
712 :    
713 :     /* unlock : releases a spin lock
714 :     */
715 :     ML_CODE_HDR(unlock_a)
716 :     #if (MAX_PROCS > 1)
717 :     ???
718 :     #else (MAX_PROCS == 1)
719 :     mov ML_true,ATMP1
720 :     stl ATMP1,0(STDARG)
721 :     mov ML_unit,STDARG
722 :     CONTINUE
723 :     #endif
724 :    
725 :     /* SetFSR:
726 :     * Turn on floating-point overflow, underflow and zero-divide exceptions.
727 :     */
728 :     BEGIN_PROC(SetFSR)
729 :     ENTRY(SetFSR)
730 :     trapb /* trap barrier just in case */
731 :     ldt $f1,fsr_bits /* normal rounding,iov,ovf,dze,inv */
732 :     mt_fpcr $f1 /* set floating point control reg */
733 :     jmp ($26)
734 :     END_PROC(SetFSR)
735 :    
736 :     /* FlushICache:
737 :     * C callable instruction cache flush function
738 :     */
739 :     BEGIN_PROC(FlushICache)
740 :     ENTRY(FlushICache)
741 :     .frame $30,0,$26,0
742 :     .prologue 0
743 :     call_pal 0x86 /* imb */
744 :     ret $31,($26),1
745 :     END_PROC(FlushICache)
746 :    

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