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

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