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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 /* HPPA.prim.asm
2 :     *
3 :     * COPYRIGHT (c) 1995 by AT&T Bell Laboratories.
4 :     */
5 :    
6 :     #include "ml-base.h"
7 :     #include "asm-base.h"
8 :     #include "ml-values.h"
9 :     #include "tags.h"
10 :     #include "ml-request.h"
11 :     #include "reg-mask.h"
12 :     #include "ml-limits.h"
13 :     #include "mlstate-offsets.h" /** machine generated file **/
14 :    
15 :     /* stack layout when executing in ML code. */
16 :    
17 :     /*
18 :     Note: stack grows from low to high memory addresses.
19 :    
20 :     low address ...
21 :     sp-116: | spill area |
22 :     +---------------------+
23 :     sp-112: | $$umul |
24 :     +---------------------+
25 :     sp-44: | %r2-%r18 |
26 :     +---------------------+
27 :     sp-40: | *ml_state |
28 :     +---------------------+
29 :     sp-32: | pseudoregs[2] |
30 :     +---------------------+
31 :     sp-28: | startgc |
32 :     +---------------------+
33 :     sp-24: | $$mul |
34 :     +---------------------+
35 :     sp-20: | $$div |
36 :     +---------------------+
37 :     sp-16: | $$udiv |
38 :     +---------------------+
39 :     sp-12: | cvti2dTmp |
40 :     +---------------------+
41 :     sp-8: | float64Tmp |
42 :     +---------------------+
43 :     sp:
44 :     high addresses ...
45 :    
46 :     */
47 :    
48 :     #define UDIV_OFFSET -16
49 :     #define DIV_OFFSET -20
50 :     #define MUL_OFFSET -24
51 :     #define STARTGC_OFFSET -28
52 :     #define PSEUDOREG_OFFSET -36
53 :     #define MLSTATE_OFFSET -40
54 :     #define REGSAVE_OFFSET -44
55 :     #define UMUL_OFFSET -112
56 :     #define ML_FRAMESIZE 4096
57 :    
58 :    
59 :     /* Note:
60 :     Use of the SavedStackPtr location
61 :     Lal George
62 :     12/13/95
63 :    
64 :     The SavedStackPtr location is used to restore the value of the stack
65 :     pointer so that the layout above can be accessed. This is particularly
66 :     relevant when an exception/trap is generated inside ml_mul, ml_div
67 :     and ml_udiv millicode. Registers that are trashed by the system
68 :     millicode are saved on top of the stack together with a
69 :     return address. When an exception occurs, the exception trap
70 :     handler forces the program counter to resume at the address
71 :     corresponding to request_fault. However, because of the extra stuff
72 :     on the stack, request_fault does not see the layout it expects!
73 :     The value in SavedStackPtr is used to restore the correct stack pointer.
74 :     The ML registers that were saved on the stack during the millicode
75 :     call, are ones that are not required to resume the trap handler
76 :     and can therefore be dropped on the floor.
77 :    
78 :     The value of the stack pointer is saved before branching into ML via
79 :     restoreregs, and is restored in saveregs and set_request---the two entry
80 :     points into C.
81 :    
82 :     This scheme adds 6 extra instructions to go from ML to C and back.
83 :     */
84 :    
85 :     /*
86 :     ml_roots layout
87 :     +---------------------+
88 :     root --> | ml_pc |
89 :     +---------------------+
90 :     +4: | ml_stdlink |
91 :     +---------------------+
92 :     +8: | ml_closure |
93 :     +---------------------+
94 :     +12: | ml_arg |
95 :     +---------------------+
96 :     +16: | ml_cont |
97 :     +---------------------+
98 :     +20: | ml_varptr |
99 :     +---------------------+
100 :     +24: | ml_baseptr |
101 :     +---------------------+
102 :     +28: | ml_exnptr |
103 :     +---------------------+
104 :     +32: | miscreg 0-14 |
105 :     +---------------------+
106 :     : :
107 :     */
108 :    
109 :     #define zero %r0
110 :     #define miscreg0 %r1
111 :     #define miscreg14 %r2
112 :     #define allocptr %r3
113 :     #define limitptr %r4
114 :     #define storeptr %r5
115 :     #define exnptr %r6
116 :     #define varptr %r7
117 :     #define baseptr %r8
118 :     #define stdlink %r9
119 :     #define stdclos %r10
120 :     #define stdarg %r11
121 :     #define stdcont %r12
122 :     #define miscreg1 %r13
123 :     #define miscreg2 %r14
124 :     #define miscreg3 %r15
125 :     #define miscreg4 %r16
126 :     #define miscreg5 %r17
127 :     #define miscreg6 %r18
128 :     #define miscreg7 %r19
129 :     #define maskreg %r20
130 :     #define exhausted %r21
131 :     #define miscreg8 %r22
132 :     #define miscreg9 %r23
133 :     #define miscreg10 %r24
134 :     #define miscreg11 %r25
135 :     #define miscreg12 %r26
136 :     #define reserved %r27
137 :     #define miscreg13 %r28
138 :     #define asmTmp %r29
139 :     #define sp %r30
140 :     #define gclink %r31
141 :    
142 :    
143 :    
144 :     #define tmp1 asmTmp
145 :     #define tmp2 miscreg10
146 :     #define tmp3 miscreg11
147 :     #define carg0 miscreg12
148 :     #define creturn miscreg13
149 :    
150 :     #define RSHIFT(r,n,t) extrs r, 31-(n), 32-(n), t
151 :     #define LSHIFT(r,n,t) zdep r, 31-(n), 32-(n), t
152 :    
153 :     #define LARGECONST(c, t) ldil L%c, t ! ldo R%c(t), t
154 :    
155 :    
156 :     #if (CALLEESAVE > 0)
157 :     #define CONTINUE \
158 :     comclr,> allocptr, limitptr, exhausted !\
159 :     ldi 1, exhausted !\
160 :     bv,n zero(stdcont)
161 :     #else
162 :     #define CONTINUE ???
163 :     #endif
164 :    
165 :     #define CHECKLIMIT(name,mask) \
166 :     combf,=,n zero, exhausted, CSYM(CONCAT(L$$, name)) !\
167 :     ldi mask, maskreg !\
168 :     copy stdlink, gclink !\
169 :     b,n saveregs1 !\
170 :     .label CSYM(CONCAT(L$$, name))
171 :    
172 :     /* All code must be in the data segment, since we cannot distinguish
173 :     * between a code and data segment offset.
174 :     */
175 :     .data
176 :    
177 :     SavedStackPtr .word 0
178 :    
179 :     ML_CODE_HDR(sigh_return_a)
180 :     ldi RET_MASK, maskreg
181 :     ldi REQ_SIG_RETURN, tmp2
182 :     b,n set_request
183 :    
184 :     ENTRY(sigh_resume)
185 :     ldi RET_MASK, maskreg
186 :     ldi REQ_SIG_RESUME, tmp2
187 :     b,n set_request
188 :    
189 :    
190 :     ML_CODE_HDR(pollh_return_a)
191 :     ldi RET_MASK, maskreg
192 :     ldi REQ_POLL_RETURN, tmp2
193 :     b,n set_request
194 :    
195 :    
196 :     ENTRY(pollh_resume)
197 :     ldi RET_MASK, maskreg
198 :     ldi REQ_POLL_RESUME, tmp2
199 :     b,n set_request
200 :    
201 :    
202 :     ML_CODE_HDR(handle_a)
203 :     ldi EXN_MASK, maskreg
204 :     ldi REQ_EXN, tmp2
205 :     b,n set_request
206 :    
207 :     ML_CODE_HDR(return_a)
208 :     ldi RET_MASK, maskreg
209 :     ldi REQ_RETURN, tmp2
210 :     b,n set_request
211 :    
212 :     ENTRY(request_fault)
213 :     ldi EXN_MASK, maskreg
214 :     ldi REQ_FAULT, tmp2
215 :     b,n set_request
216 :    
217 :     ML_CODE_HDR(bind_cfun_a)
218 :     CHECKLIMIT(bind_cfun_check, FUN_MASK)
219 :     ldi FUN_MASK, maskreg
220 :     ldi REQ_BIND_CFUN, tmp2
221 :     b,n set_request
222 :    
223 :     ML_CODE_HDR(build_literals_a)
224 :     CHECKLIMIT(build_literals_check, FUN_MASK)
225 :     ldi FUN_MASK, maskreg
226 :     ldi REQ_BUILD_LITERALS, tmp2
227 :     b,n set_request
228 :    
229 :     ML_CODE_HDR(callc_a)
230 :     CHECKLIMIT(callc_check, FUN_MASK)
231 :     ldi FUN_MASK, maskreg
232 :     ldi REQ_CALLC, tmp2
233 :     /* fall through */
234 :    
235 :     /* set_request --- a quick return to run_ml()
236 :     * liveIn = {tmp2, maskreg}
237 :     */
238 :     set_request
239 :     ldil L%SavedStackPtr, tmp1
240 :     ldo R%SavedStackPtr(tmp1), tmp1
241 :     ldw 0(tmp1), sp /* restore stack pointer */
242 :    
243 :     ldw MLSTATE_OFFSET(sp), tmp1
244 :     stw maskreg, MaskOffMSP(tmp1)
245 :     ldw VProcOffMSP(tmp1), maskreg /* use maskreg as VProc ptr */
246 :     stw zero, InMLOffVSP(maskreg) /* leaving ML */
247 :     stw allocptr, AllocPtrOffMSP(tmp1)
248 :     stw limitptr, LimitPtrOffMSP(tmp1)
249 :     stw storeptr, StorePtrOffMSP(tmp1)
250 :     stw stdlink, LinkRegOffMSP(tmp1)
251 :     stw stdlink, PCOffMSP(tmp1) /* address of called function */
252 :     stw stdarg, StdArgOffMSP(tmp1)
253 :     stw stdclos, StdClosOffMSP(tmp1)
254 :     stw stdcont, StdContOffMSP(tmp1)
255 :     stw varptr, VarPtrOffMSP(tmp1)
256 :     stw exnptr, ExnPtrOffMSP(tmp1)
257 :     copy tmp2, creturn /* return request */
258 :     #if (CALLEESAVE > 0)
259 :     stw miscreg0,MiscRegOffMSP(0)(tmp1)
260 :     #endif
261 :     #if (CALLEESAVE > 1)
262 :     stw miscreg1,MiscRegOffMSP(1)(tmp1)
263 :     #endif
264 :     #if (CALLEESAVE > 2)
265 :     stw miscreg2,MiscRegOffMSP(2)(tmp1)
266 :     #endif
267 :     #if (CALLEESAVE > 3)
268 :     stw miscreg3,MiscRegOffMSP(3)(tmp1)
269 :     #endif
270 :     #if (CALLEESAVE > 4)
271 :     stw miscreg4,MiscRegOffMSP(4)(tmp1)
272 :     #endif
273 :     #if (CALLEESAVE > 5)
274 :     stw miscreg5,MiscRegOffMSP(5)(tmp1)
275 :     #endif
276 :     #if (CALLEESAVE > 6)
277 :     stw miscreg6,MiscRegOffMSP(6)(tmp1)
278 :     #endif
279 :     #if (CALLEESAVE > 7)
280 :     stw miscreg7,MiscRegOffMSP(7)(tmp1)
281 :     #endif
282 :     #if (CALLEESAVE > 8)
283 :     stw miscreg8,MiscRegOffMSP(8)(tmp1)
284 :     #endif
285 :     #if (CALLEESAVE > 9)
286 :     ???
287 :     #endif
288 :     /* fall through */
289 :     restore_c_regs
290 :     ldw PSEUDOREG_OFFSET(sp), tmp2
291 :     stw tmp2, PseudoReg1OffMSP(tmp1)
292 :     ldw PSEUDOREG_OFFSET+4(sp), tmp2
293 :     stw tmp2, PseudoReg2OffMSP(tmp1)
294 :     ldw REGSAVE_OFFSET(sp), %r2
295 :     ldw REGSAVE_OFFSET-4(sp), %r3
296 :     ldw REGSAVE_OFFSET-8(sp), %r4
297 :     ldw REGSAVE_OFFSET-12(sp), %r5
298 :     ldw REGSAVE_OFFSET-16(sp), %r6
299 :     ldw REGSAVE_OFFSET-20(sp), %r7
300 :     ldw REGSAVE_OFFSET-24(sp), %r8
301 :     ldw REGSAVE_OFFSET-28(sp), %r9
302 :     ldw REGSAVE_OFFSET-32(sp), %r10
303 :     ldw REGSAVE_OFFSET-36(sp), %r11
304 :     ldw REGSAVE_OFFSET-40(sp), %r12
305 :     ldw REGSAVE_OFFSET-44(sp), %r13
306 :     ldw REGSAVE_OFFSET-48(sp), %r14
307 :     ldw REGSAVE_OFFSET-52(sp), %r15
308 :     ldw REGSAVE_OFFSET-56(sp), %r16
309 :     ldw REGSAVE_OFFSET-60(sp), %r17
310 :     ldw REGSAVE_OFFSET-64(sp), %r18
311 :     LARGECONST(-ML_FRAMESIZE, tmp3)
312 :     add tmp3, sp, sp /* discard the stack frame */
313 :     ldsid (%r2), tmp1
314 :     mtsp tmp1, %sr1
315 :     be,n 0(%sr1, %r2)
316 :    
317 :     /* saveregs
318 :    
319 :     There are two entry points for saveregs --- saveregs0 and saveregs1.
320 :    
321 :     Saveregs0 is called from inside ML to invoke a gc. This is
322 :     done using a BLE,n instruction. The return address (in gclink) with
323 :     nullification set, is at the wrong place unless one puts a NOP after
324 :     the BLR,n. Saveregs0 is used to correct the off-by-four value in gclink
325 :     or %r31.
326 :    
327 :     Saveregs1 is called internally (or everywhere else) where the return
328 :     address is standard link (stdlink) typically and needs no correction.
329 :    
330 :     */
331 :     .export saveregs0,ENTRY
332 :     ENTRY(saveregs0)
333 :     addi 0-4, gclink, gclink
334 :     /* fall through */
335 :    
336 :     saveregs1
337 :     ldil L%SavedStackPtr, tmp1
338 :     ldo R%SavedStackPtr(tmp1), tmp1
339 :     ldw 0(tmp1), sp /* restore saved stack pointer */
340 :    
341 :     ldw MLSTATE_OFFSET(sp), tmp1
342 :     stw maskreg, MaskOffMSP(tmp1)
343 :     ldw VProcOffMSP(tmp1), maskreg /* use maskreg as Vproc ptr */
344 :     stw zero, InMLOffVSP(maskreg) /* leaving ML */
345 :     stw allocptr, AllocPtrOffMSP(tmp1)
346 :     stw limitptr, LimitPtrOffMSP(tmp1)
347 :     stw storeptr, StorePtrOffMSP(tmp1)
348 :     stw stdarg, StdArgOffMSP(tmp1)
349 :     stw stdcont, StdContOffMSP(tmp1)
350 :     stw stdclos, StdClosOffMSP(tmp1)
351 :     stw stdlink, LinkRegOffMSP(tmp1)
352 :     stw gclink, PCOffMSP(tmp1)
353 :     stw exnptr, ExnPtrOffMSP(tmp1)
354 :     stw miscreg0, MiscRegOffMSP(0)(tmp1)
355 :     stw miscreg1, MiscRegOffMSP(1)(tmp1)
356 :     stw miscreg2, MiscRegOffMSP(2)(tmp1)
357 :     stw miscreg3, MiscRegOffMSP(3)(tmp1)
358 :     stw miscreg4, MiscRegOffMSP(4)(tmp1)
359 :     stw miscreg5, MiscRegOffMSP(5)(tmp1)
360 :     stw miscreg6, MiscRegOffMSP(6)(tmp1)
361 :     stw miscreg7, MiscRegOffMSP(7)(tmp1)
362 :     stw miscreg8, MiscRegOffMSP(8)(tmp1)
363 :     stw miscreg9, MiscRegOffMSP(9)(tmp1)
364 :     stw miscreg10, MiscRegOffMSP(10)(tmp1)
365 :     stw miscreg11, MiscRegOffMSP(11)(tmp1)
366 :     stw miscreg12, MiscRegOffMSP(12)(tmp1)
367 :     stw miscreg13, MiscRegOffMSP(13)(tmp1)
368 :     stw miscreg14, MiscRegOffMSP(14)(tmp1)
369 :     stw varptr, VarPtrOffMSP(tmp1)
370 :     ldil L%-8192, tmp3
371 :     ldo R%-8192(tmp3), tmp3
372 :     add tmp3, baseptr, baseptr
373 :     stw baseptr, BasePtrOffMSP(tmp1)
374 :     ldi REQ_GC, creturn
375 :     b,n restore_c_regs
376 :    
377 :     /* We need to find a way of creating a table of these constant
378 :     * values, rather than computing them each time around.
379 :     */
380 :     #define STORE_CODE_ADDR(proc, offset) \
381 :     ldil L%proc, tmp2 !\
382 :     ldo R%proc(tmp2), tmp2 !\
383 :     stw tmp2, offset(sp)
384 :    
385 :     BEGIN_PROC(restoreregs)
386 :     .export restoreregs,ENTRY
387 :     restoreregs
388 :     LARGECONST(ML_FRAMESIZE, tmp3)
389 :     add tmp3, sp, sp
390 :    
391 :     ldil L%SavedStackPtr, tmp1 /* save stack to restore */
392 :     ldo R%SavedStackPtr(tmp1), tmp1
393 :     stw sp, 0(tmp1)
394 :    
395 :     /* save the C registers */
396 :     stw %r2, REGSAVE_OFFSET(sp)
397 :     stw %r3, REGSAVE_OFFSET-4(sp)
398 :     stw %r4, REGSAVE_OFFSET-8(sp)
399 :     stw %r5, REGSAVE_OFFSET-12(sp)
400 :     stw %r6, REGSAVE_OFFSET-16(sp)
401 :     stw %r7, REGSAVE_OFFSET-20(sp)
402 :     stw %r8, REGSAVE_OFFSET-24(sp)
403 :     stw %r9, REGSAVE_OFFSET-28(sp)
404 :     stw %r10, REGSAVE_OFFSET-32(sp)
405 :     stw %r11, REGSAVE_OFFSET-36(sp)
406 :     stw %r12, REGSAVE_OFFSET-40(sp)
407 :     stw %r13, REGSAVE_OFFSET-44(sp)
408 :     stw %r14, REGSAVE_OFFSET-48(sp)
409 :     stw %r15, REGSAVE_OFFSET-52(sp)
410 :     stw %r16, REGSAVE_OFFSET-56(sp)
411 :     stw %r17, REGSAVE_OFFSET-60(sp)
412 :     stw %r18, REGSAVE_OFFSET-64(sp)
413 :    
414 :     /* create ML stack frame */
415 :     stw carg0, MLSTATE_OFFSET(sp)
416 :     copy carg0, tmp1
417 :    
418 :     STORE_CODE_ADDR(ml_udiv, UDIV_OFFSET)
419 :     STORE_CODE_ADDR(ml_div, DIV_OFFSET)
420 :     STORE_CODE_ADDR(ml_mul, MUL_OFFSET)
421 :     STORE_CODE_ADDR(ml_umul, UMUL_OFFSET)
422 :     STORE_CODE_ADDR(saveregs0, STARTGC_OFFSET)
423 :    
424 :     ldw PseudoReg1OffMSP(tmp1), tmp2
425 :     stw tmp2,PSEUDOREG_OFFSET(sp)
426 :     ldw PseudoReg2OffMSP(tmp1), tmp2
427 :     stw tmp2,PSEUDOREG_OFFSET+4(sp)
428 :    
429 :     ldw AllocPtrOffMSP(tmp1), allocptr
430 :     ldw LimitPtrOffMSP(tmp1), limitptr
431 :     ldw StorePtrOffMSP(tmp1), storeptr
432 :     ldi 1, tmp2
433 :     ldw VProcOffMSP(tmp1), maskreg
434 :     stw tmp2,InMLOffVSP(maskreg) /* entering ML code */
435 :     ldw StdArgOffMSP(tmp1), stdarg
436 :     ldw StdContOffMSP(tmp1), stdcont
437 :     ldw StdClosOffMSP(tmp1), stdclos
438 :     ldw ExnPtrOffMSP(tmp1), exnptr
439 :     ldw BasePtrOffMSP(tmp1), baseptr
440 :     ldil L%8192, tmp3
441 :     ldo R%8192(tmp3), tmp3
442 :     add tmp3, baseptr, baseptr /* adjust baseptr */
443 :     ldw MiscRegOffMSP(0)(tmp1), miscreg0
444 :     ldw MiscRegOffMSP(1)(tmp1), miscreg1
445 :     ldw MiscRegOffMSP(2)(tmp1), miscreg2
446 :     ldw MiscRegOffMSP(3)(tmp1), miscreg3
447 :     ldw MiscRegOffMSP(4)(tmp1), miscreg4
448 :     ldw MiscRegOffMSP(5)(tmp1), miscreg5
449 :     ldw MiscRegOffMSP(6)(tmp1), miscreg6
450 :     ldw MiscRegOffMSP(7)(tmp1), miscreg7
451 :     ldw MiscRegOffMSP(8)(tmp1), miscreg8
452 :     ldw MiscRegOffMSP(9)(tmp1), miscreg9
453 :     ldw MiscRegOffMSP(12)(tmp1), miscreg12
454 :     ldw MiscRegOffMSP(13)(tmp1), miscreg13
455 :     ldw MiscRegOffMSP(14)(tmp1), miscreg14
456 :     ldw LinkRegOffMSP(tmp1), stdlink
457 :     ldw VarPtrOffMSP(tmp1), varptr
458 :     ldw PCOffMSP(tmp1), gclink
459 :     /* check for pending signals */
460 :     ldw NPendingSysOffVSP(maskreg), tmp2
461 :     ldw NPendingOffVSP(maskreg), tmp3
462 :     add tmp2, tmp3, tmp2
463 :     combf,= tmp2, zero, pending_sigs
464 :     nop
465 :    
466 :     ml_go
467 :     ldw MiscRegOffMSP(10)(tmp1), miscreg10 /* tmp2 */
468 :     ldw MiscRegOffMSP(11)(tmp1), miscreg11 /* tmp3 */
469 :     mfsp %sr5, tmp1 /* for indexed loads */
470 :     mtsp tmp1, %sr3
471 :     comclr,> allocptr, limitptr, exhausted
472 :     ldi 1, exhausted
473 :     bv,n 0(gclink)
474 :    
475 :     pending_sigs
476 :     /* there are pending signals */
477 :     /* check if signals are masked */
478 :     ldw InSigHandlerOffVSP(maskreg), tmp2
479 :     combf,= tmp2, zero, ml_go
480 :     nop
481 :    
482 :     /* note that a handler trap is pending */
483 :     ldi 1, tmp2
484 :     stw tmp2, HandlerPendingOffVSP(maskreg)
485 :     copy limitptr,allocptr
486 :     b,n ml_go
487 :     END_PROC(restoreregs)
488 :    
489 :    
490 :     ENTRY(SaveFPRegs)
491 :     break 0,0 /* should never be called */
492 :    
493 :     ENTRY(RestoreFPRegs)
494 :     break 0,0 /* should never be called */
495 :    
496 :     /*
497 :     * array : (int * 'a) -> 'a array
498 :     */
499 :     ML_CODE_HDR(array_a)
500 :     CHECKLIMIT(array_check, FUN_MASK)
501 :     ldw 0(stdarg), tmp1 /* tmp1 := length (tagged int) */
502 :     RSHIFT(tmp1, 1, tmp1) /* tmp1 := length : untagged int */
503 :     ldi SMALL_OBJ_SZW, tmp2 /* is this a small object */
504 :     combt,< tmp2, tmp1, L$array_offline
505 :     nop
506 :     LSHIFT(tmp1, TAG_SHIFTW, tmp3) /* build descriptor in atmp3 */
507 :     ldi 0+MAKE_TAG(DTAG_array), tmp2
508 :     or tmp3, tmp2, tmp3
509 :     stw tmp3,0(allocptr) /* store descriptor */
510 :     addi 4, allocptr, allocptr
511 :     ldw 4(stdarg), tmp2 /* tmp2 := initial value */
512 :     copy allocptr, stdarg
513 :     LSHIFT(tmp1, 2, tmp1) /* tmp1 := length in bytes */
514 :     add tmp1, allocptr, tmp1 /* atmp1 is end of array */
515 :     L$array_loop /* loop: */
516 :     stw tmp2, 0(allocptr)
517 :     addi 4, allocptr, allocptr /* allocptr++ */
518 :     combf,= allocptr, tmp1, L$array_loop
519 :     nop
520 :     CONTINUE
521 :     L$array_offline /* off-line allocation of big arrays */
522 :     ldi FUN_MASK, maskreg
523 :     ldi REQ_ALLOC_ARRAY, tmp2
524 :     b,n set_request
525 :    
526 :    
527 :    
528 :     ML_CODE_HDR(create_r_a)
529 :     CHECKLIMIT(creat_r_check,FUN_MASK)
530 :     RSHIFT(stdarg, 1, tmp1)
531 :     LSHIFT(tmp1, 1, tmp2) /* tmp2 = length in words */
532 :     ldi SMALL_OBJ_SZW, tmp3
533 :     combt,< tmp3, tmp2, L$realarray_offline
534 :     nop
535 :     LSHIFT(tmp1, TAG_SHIFTW, tmp3) /* build descriptor in atmp3 */
536 :     ldi 0+MAKE_TAG(DTAG_realdarray), tmp1
537 :     or tmp3, tmp1, tmp3
538 :    
539 :     ldi 4, tmp1
540 :     or allocptr, tmp1, allocptr /* tag is unaligned, so that the */
541 :     /* first element is 8-byte aligned */
542 :     stw tmp3, 0(allocptr)
543 :     addi 4, allocptr, stdarg /* pointer to new realarray */
544 :     LSHIFT(tmp2, 2, tmp2)
545 :     addi 4, tmp2, tmp2
546 :     add allocptr, tmp2, allocptr
547 :     CONTINUE
548 :     L$realarray_offline
549 :     /* off-line allocation of big realarrays */
550 :     ldi FUN_MASK, maskreg
551 :     ldi REQ_ALLOC_REALDARRAY, tmp2
552 :     b,n set_request
553 :    
554 :    
555 :    
556 :     ML_CODE_HDR(create_b_a)
557 :     CHECKLIMIT(create_b_checked, FUN_MASK)
558 :     RSHIFT(stdarg, 1, tmp1) /* tmp1 := length (untagged) */
559 :     addi 3, tmp1, tmp2 /* tmp2 := length (words) */
560 :     RSHIFT(tmp2, 2, tmp2)
561 :     ldi SMALL_OBJ_SZW, tmp3 /* is this a small object? */
562 :     combt,< tmp3, tmp2, L$bytearray_offline /* no */
563 :     nop
564 :     LSHIFT(tmp1, TAG_SHIFTW, tmp3) /* descriptor in tmp3 */
565 :     ldi 0+MAKE_TAG(DTAG_bytearray), tmp1
566 :     or tmp1, tmp3, tmp3
567 :     stw tmp3, 0(allocptr) /* write out descriptor */
568 :     addi 4, allocptr, stdarg /* return result */
569 :     LSHIFT(tmp2, 2, tmp2) /* length in bytes */
570 :     addi 4, tmp2, tmp2 /* plus tag */
571 :     add tmp2, allocptr, allocptr /* bump allocptr */
572 :     CONTINUE
573 :     L$bytearray_offline /* big object */
574 :     ldi FUN_MASK, maskreg
575 :     ldi REQ_ALLOC_BYTEARRAY, tmp2
576 :     b,n set_request
577 :    
578 :    
579 :    
580 :     ML_CODE_HDR(create_s_a)
581 :     CHECKLIMIT(create_s_checked, FUN_MASK)
582 :     RSHIFT(stdarg, 1, tmp1) /* tmp1 := length: untagged int */
583 :     addi 4, tmp1, tmp2 /* tmp2 := length in words */
584 :     RSHIFT(tmp2, 2, tmp2)
585 :     ldi SMALL_OBJ_SZW, tmp3 /* is this a big object */
586 :     combt,< tmp3, tmp2, L$string_offline /* no */
587 :     nop
588 :     LSHIFT(tmp1, TAG_SHIFTW, tmp3) /* build descriptor in tmp3 */
589 :     ldi 0+MAKE_TAG(DTAG_string), tmp1
590 :     or tmp1, tmp3, tmp3
591 :     stw tmp3, 0(allocptr) /* save descriptor */
592 :     addi 4, allocptr, stdarg /* return result */
593 :     LSHIFT(tmp2, 2, tmp2) /* length in bytes */
594 :     addi 4, tmp2, tmp2 /* plus tag */
595 :     add tmp2, allocptr, allocptr/* bump allocptr */
596 :     stw zero, 0-4(allocptr) /* zero-terminate string */
597 :     CONTINUE
598 :     L$string_offline
599 :     ldi FUN_MASK, maskreg
600 :     ldi REQ_ALLOC_STRING, tmp2
601 :     b,n set_request
602 :    
603 :    
604 :    
605 :     ML_CODE_HDR(create_v_a)
606 :     CHECKLIMIT(create_v_checked,FUN_MASK)
607 :     ldw 0(stdarg), tmp1 /* tmp1 = tagged length */
608 :     RSHIFT(tmp1, 1, tmp1) /* tmp1 = untagged length */
609 :     ldi SMALL_OBJ_SZW, tmp3 /* is this a small object? */
610 :     combt,< tmp3, tmp1, L$vector_offline /* no */
611 :     nop
612 :     LSHIFT(tmp1, TAG_SHIFTW, tmp2) /* build descriptor in tmp2 */
613 :     ldi 0+MAKE_TAG(DTAG_vector), tmp3
614 :     or tmp3, tmp2, tmp2
615 :     stw tmp2, 0(allocptr) /* store descriptor */
616 :     addi 4, allocptr, allocptr /* allocptr++ */
617 :     ldw 4(stdarg), tmp2 /* tmp2 = list */
618 :     addi 0, allocptr, stdarg /* return result */
619 :     ldi 0+ML_nil, tmp3
620 :     L$vector_loop
621 :     ldw 0(tmp2), tmp1 /* tmp1 = hd(tmp2) */
622 :     ldw 4(tmp2), tmp2 /* tmp2 = tl(tmp2) */
623 :     stw tmp1, 0(allocptr) /* store word in vector */
624 :     addi 4, allocptr, allocptr /* allocptr++ */
625 :     combf,= tmp2, tmp3, L$vector_loop/* if (tmp2 <> nil) goto loop */
626 :     nop
627 :     CONTINUE
628 :     L$vector_offline
629 :     ldi FUN_MASK, maskreg
630 :     ldi REQ_ALLOC_VECTOR, tmp2
631 :     b,n set_request
632 :    
633 :     /* logb --- extract and unbias the exponent */
634 :     ML_CODE_HDR(logb_a)
635 :     ldw 0(stdarg), stdarg /* msb */
636 :     extru stdarg, 11, 12, stdarg /* throw out 20 low bits */
637 :     ldo 0x7ff(%r0), tmp1 /* retain 11 bits */
638 :     and stdarg, tmp1, stdarg
639 :     ldo 0-1023(stdarg), stdarg /* unbias */
640 :     LSHIFT(stdarg, 1, stdarg) /* tag as ML int */
641 :     addi 1, stdarg, stdarg
642 :     CONTINUE
643 :    
644 :    
645 :    
646 :     /* scalb(u:real,v:int) = u * 2 ^ v */
647 :     ML_CODE_HDR(scalb_a)
648 :     CHECKLIMIT(scalb_a_checked,FUN_MASK)
649 :     ldw 4(stdarg),tmp1 /* tmp1 := v tagged */
650 :     RSHIFT(tmp1, 1, tmp1) /* tmp1 := v */
651 :     ldw 0(stdarg),stdarg /* stdarg := u */
652 :     ldw 0(stdarg), tmp2 /* tmp2 := MSW(u) */
653 :     ldil L%0x7ff00000, tmp3 /* mask */
654 :     and tmp2, tmp3, tmp3 /* tmp3 := tmp2 & 0x7ff00000 */
655 :     combt,=,n tmp3, %r0, scalb_all_done /* u == 0.0 */
656 :    
657 :     RSHIFT(tmp3, 20, tmp3) /* tmp3 := ieee(exp) */
658 :     addo tmp3, tmp1, tmp3 /* tmp3 := scaled exponent */
659 :     combt,<,n tmp3, %r0, scalb_underflow
660 :    
661 :     ldi 2047, tmp1 /* max. ieee(exp) */
662 :     combt,<,n tmp1, tmp3, scalb_overflow
663 :    
664 :     ldil L%0x800fffff, tmp1 /* tmp1 := sign bit + mantissa mask */
665 :     ldo R%0x800fffff(tmp1), tmp1
666 :     and tmp1, tmp2, tmp1 /* tmp1 := original sign and mantessa*/
667 :     LSHIFT(tmp3, 20, tmp3) /* tmp3 := exp in right place*/
668 :     or tmp1, tmp3, tmp1 /* tmp1 := MSW(u) */
669 :     ldw 4(stdarg), tmp2 /* tmp2 := LSW(u) */
670 :     /* fall through */
671 :    
672 :     scalb_write_out /* {tmp1, tmp2} live on entry */
673 :     ldi 4, tmp3 /* align allocation pointer */
674 :     or tmp3, allocptr, allocptr
675 :     stw tmp1, 4(allocptr) /* store MSW */
676 :     stw tmp2, 8(allocptr) /* store LSW */
677 :     ldi 0+(DESC_reald),tmp3 /* store descriptor */
678 :     stw tmp3,0(allocptr)
679 :     addi 0x4,allocptr,stdarg /* return pointer to float */
680 :     addi 0xc,allocptr,allocptr /* bump allocation pointer */
681 :     /* fall through */
682 :    
683 :     scalb_all_done
684 :     /* BUG: The compiler supports arithmetic over denormalized
685 :     * numbers, but scalb barfs at them. Denormalized numbers
686 :     * are treated here as 0.0.
687 :     */
688 :     CONTINUE
689 :    
690 :     scalb_underflow
691 :     /* BUG: Incorrect behaviour on underflow, should return the
692 :     * denormalized number.
693 :     */
694 :     ldi 0, tmp1
695 :     ldi 0, tmp2
696 :     b,n scalb_write_out
697 :    
698 :     scalb_overflow
699 :     ldil L%0x7fffffff,tmp1
700 :     ldo R%0x7fffffff(tmp1),tmp1
701 :     addo tmp1,tmp1,0 /* generate trap */
702 :     /* should never execute the next instruction */
703 :    
704 :    
705 :     floor_MAXINT .double 1073741824.0
706 :    
707 :     ML_CODE_HDR(floor_a)
708 :     fldds 0(stdarg), %fr4 /* fr4 := argument */
709 :     ldil L%floor_MAXINT, tmp1 /* fr5 get maxint */
710 :     ldo R%floor_MAXINT(tmp1), tmp1
711 :     fldds 0(tmp1), %fr5
712 :     fabs,dbl %fr4, %fr4 /* fr4 := abs (argument) */
713 :     fcmp,dbl,< %fr4, %fr5 /* check for overflow */
714 :     fldds 0(stdarg), %fr4 /* reload argument */
715 :     ftest
716 :     b,n floor_overflow
717 :    
718 :     ldi 0x60e, tmp1 /* set rounding mode to -inf */
719 :     stw tmp1, 0-4(sp) /* store in temp scratch */
720 :     fldws 0-4(sp), %fr0L
721 :     fcnvfx,dbl,sgl %fr4, %fr4R
722 :    
723 :     stw zero,0-4(sp)
724 :     fldws 0-4(sp),%fr0L
725 :     fstws %fr4R,0-4(sp)
726 :     ldw 0-4(sp), stdarg
727 :     add stdarg, stdarg, stdarg
728 :     ldo 1(stdarg), stdarg
729 :     CONTINUE
730 :     floor_overflow
731 :     ldil L%0x7fffffff,tmp1
732 :     ldo R%0x7fffffff(tmp1),tmp1
733 :     addo tmp1,tmp1,zero
734 :    
735 :    
736 :     /* try_lock_a */
737 :     ML_CODE_HDR(try_lock_a)
738 :     CHECKLIMIT(try_lock_check,FUN_MASK)
739 :     ldw 0(stdarg), tmp1
740 :     ldi 0+ML_true, tmp2
741 :     stw tmp2, 0(stdarg)
742 :     copy tmp2, stdarg
743 :     CONTINUE
744 :    
745 :    
746 :     ML_CODE_HDR(unlock_a)
747 :     CHECKLIMIT(unlock_check, FUN_MASK)
748 :     ldi 0+ML_false, tmp1
749 :     stw tmp1, 0(stdarg)
750 :     ldi 0+ML_unit, stdarg
751 :     CONTINUE
752 :    
753 :    
754 :    
755 :    
756 :     /* milli code routines */
757 :    
758 :     /*
759 :     millicode:
760 :     inputs in %r26 (arg0) and %r25 (arg1)
761 :     result in %r29 (ret1)
762 :    
763 :     saved: %r25, %r26, %r1 --- trashed by millicode routines
764 :     %r31 --- trashed by BLE
765 :    
766 :     Note: If the millicode were inlined in this data segment then it would
767 :     not be necessary to do this cross-segment jump.
768 :     */
769 :    
770 :     /* Note: Offset -20(sp) is used by DoMillicode */
771 :     #define MILLI_LOCAL_AREA 24 /* multiple of 8 */
772 :     #define millicodeSave \
773 :     addi MILLI_LOCAL_AREA, sp, sp !\
774 :     stw %r1, 0-4(sp) !\
775 :     stw %r25,0-8(sp) !\
776 :     stw %r26,0-12(sp) !\
777 :     stw %r31,0-16(sp)
778 :    
779 :     #define millicodeRestore \
780 :     ldw 0-16(sp), %r31 !\
781 :     ldw 0-12(sp), %r26 !\
782 :     ldw 0-8(sp), %r25 !\
783 :     ldw 0-4(sp), %r1 !\
784 :     addi 0-MILLI_LOCAL_AREA, sp, sp !\
785 :     addi 0-4, gclink, gclink !\
786 :     bv,n 0(gclink)
787 :    
788 :     #define InvokeMillicode(proc) \
789 :     millicodeSave !\
790 :     ldil L%proc, %r1 !\
791 :     ldo R%proc(%r1), %r1 !\
792 :     ldsid (%r1), %r29 !\
793 :     mtsp %r29, %sr1 !\
794 :     ble,n 0(%sr1, %r1) !\
795 :     nop !\
796 :     millicodeRestore
797 :    
798 :     .export ml_mul,ENTRY
799 :     .export ml_umul,ENTRY
800 :     .export ml_div,ENTRY
801 :     .export ml_udiv,ENTRY
802 :    
803 :     floatingZero .double 0.0
804 :     floatingOne .double 1.0
805 :    
806 :     /* The bogus addit,= below is to cause an immediate trap */
807 :     #define divByZeroCheck(lab) \
808 :     combf,= %r0, %r25, lab !\
809 :     nop !\
810 :     ldil L%floatingZero, %r29 !\
811 :     ldo R%floatingZero(%r29), %r29 !\
812 :     fldds 0(%r29), %fr4 !\
813 :     ldil L%floatingOne, %r29 !\
814 :     ldo R%floatingOne(%r29), %r29 !\
815 :     fldds 0(%r29), %fr5 !\
816 :     fdiv,dbl %fr5, %fr4, %fr4 !\
817 :     fstds %fr4, 0(sp) !\
818 :     .label lab
819 :    
820 :     ENTRY(ml_mul)
821 :     InvokeMillicode(do_mulI)
822 :     ENTRY(ml_umul)
823 :     InvokeMillicode(do_mulU)
824 :     ENTRY(ml_udiv)
825 :     divByZeroCheck(noUdivByZero)
826 :     InvokeMillicode(do_divU)
827 :    
828 :     ENTRY(ml_div)
829 :     divByZeroCheck(noDivByZero)
830 :     comibf,= 0-1, %r25, mlDivNoOverflow
831 :     nop
832 :     ldil L%0x7fffffff,tmp1 /* raise overflow */
833 :     ldo R%0x7fffffff(tmp1),tmp1
834 :     addo tmp1,tmp1,zero
835 :     break 0,0 /* should never be executed */
836 :     mlDivNoOverflow
837 :     InvokeMillicode(do_divI)
838 :    
839 :     /*----------------------------------------------------------------*/
840 :     .code
841 :    
842 :     #define DoMillicode(proc) \
843 :     stw %r31, 0-20(sp) !\
844 :     bl,n proc, %r31 !\
845 :     nop !\
846 :     ldw 0-20(sp), %r31 !\
847 :     ldsid (%r31), %r1 !\
848 :     mtsp %r1, %sr1 !\
849 :     be,n 0(%sr1, %r31)
850 :    
851 :     .import $$divI,MILLICODE
852 :     .import $$divU,MILLICODE
853 :     .import $$muloI,MILLICODE
854 :     .import $$mulU,MILLICODE
855 :    
856 :     .export do_mulI,ENTRY
857 :     .export do_mulU,ENTRY
858 :     .export do_divI,ENTRY
859 :     .export do_divU,ENTRY
860 :    
861 :     do_mulI
862 :     DoMillicode($$muloI)
863 :     do_mulU
864 :     DoMillicode($$mulU)
865 :     do_divI
866 :     DoMillicode($$divI)
867 :     do_divU
868 :     DoMillicode($$divU)
869 :    
870 :    
871 :     .export FlushICache,ENTRY
872 :     FlushICache
873 :     .proc
874 :     .callinfo
875 :    
876 :     .enter
877 :     ldsid (26), 23 /* get space id from short pointer */
878 :     mtsp 23, 2 /* stick it in scratch space reg */
879 :    
880 :     depi 0,31,4,26 /* align address to cache line */
881 :     addi 15,25,25 /* align size upwards */
882 :     depi 0,31,4,25
883 :     ldi 16,22 /* r22 := minimum cache line size */
884 :     ldi -16,21 /* r21 := -(minimum cache line size) */
885 :    
886 :     fic_loop
887 :     fdc 0(2,26)
888 :     sync
889 :     /* fic can't use short pointer so
890 :     * use the space reg set up above
891 :     */
892 :     fic,m 22(2,26)
893 :    
894 :     nop /* 7 cycle delay. See programming note */
895 :     nop /* for SYNC in arch. ref. manual */
896 :     nop
897 :     nop
898 :     nop
899 :     nop
900 :     nop
901 :    
902 :     addb,>= 21,25,fic_loop /* add stride to count, branch */
903 :     nop
904 :     .leave
905 :     .procend
906 :    
907 :    
908 :    
909 :    
910 :     /* set_fsr - set IEEE floating point enables. */
911 :     /* saving and restoring tmp1 is temporary paranoia */
912 :    
913 :     .export set_fsr,ENTRY
914 :     set_fsr
915 :     .proc
916 :     .callinfo FRAME=64
917 :     .enter
918 :     stw zero,0-4(sp)
919 :     fldws 0-4(sp),%fr0L
920 :     .leave
921 :     .procend
922 :    
923 :     .export pointer2space
924 :     pointer2space
925 :     .proc
926 :     .callinfo
927 :     .entry
928 :     bv 0(2)
929 :     ldsid (26), 28
930 :     .leave
931 :     .procend
932 :    
933 :     .end ; End of program

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