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 439 - (view) (download)
Original Path: sml/branches/SMLNJ/src/runtime/mach-dep/HPPA.prim.asm

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

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