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/ALPHA32.prim.asm
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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

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