![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to SPARC.prim.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / runtime|
Return to SPARC.prim.s CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / runtime |
1.1 root 1: /* Copyright 1989 by AT&T Bell Laboratories */
2: /* SPARC.prim.s
3: *
4: * J.H. Reppy
5: * Cornell University
6: * Ithaca, NY 14853
7: * [email protected]
8: *
9: * HISTORY:
10: * 03/15/89 created
11: * 11/20/89 revised for to use heap limit check.
12: *
13: * SPARC runtime code for ML. Registers are used as follows:
14: *
15: * %g7 : exception handler continuation
16: * %g6 : freespace pointer
17: * %g5 : store pointer
18: * %g4 : heap limit pointer
19: *
20: * %i2 = closure; can be ignored because contains no free vars
21: * %i0 = arg
22: * %i1 = continuation
23: * %i3 = base code pointer
24: *
25: * %o0,%o1 = arith. temps
26: * %g1-%g3,%l0-%l7,%i4-%i5 = misc. registers (contain only pointers or tagged ints)
27: * %o5 = pointer temp.
28: *
29: * %o2,%o3 = used for args to ml_mul & ml_div, also used as temp registers
30: * %o4,%o5 = temp registers
31: *
32: * %o6 = %sp (not used by ML)
33: * %i6 = %fp (not used by ML)
34: * %i7 = return address to C code (not used by ML)
35: * %o7 = not used
36: *
37: * There are four places in this file where garbage collection can be triggered:
38: * in array_v, create_s_v, scalb_v and in raise_real. It it important that only
39: * registers saved by _saveregs be live at these points. Also, only pointer
40: * registers can contain heap pointers at these points.
41: */
42:
43: #include <machine/asm_linkage.h>
44: #include <machine/trap.h>
45: #include "tags.h"
46: #include "prof.h"
47: #include "prim.h"
48:
49: /* Macros to fetch and store values in memory; use %o5 as an addressing register. */
50: #define FETCH(addr, reg) \
51: sethi %hi(addr),%o3; \
52: ld [%o3+%lo(addr)],reg
53: #define STORE(reg, addr) \
54: sethi %hi(addr),%o3; \
55: st reg,[%o3+%lo(addr)]
56:
57:
58: /* Macros to save and restore the global registers. We save %g1-%g7 in the
59: * corresponding locals of the new window. The C-routine/system call is
60: * guaranteed not to touch the local or in registers (which are the out registers
61: * of the ML window).
62: */
63: #define SAVE_ML_REGS \
64: mov %g1,%l1; \
65: mov %g2,%l2; \
66: mov %g3,%l3; \
67: mov %g4,%l4; \
68: mov %g5,%l5; \
69: mov %g6,%l6; \
70: mov %g7,%l7
71:
72: #define RESTORE_ML_REGS \
73: mov %l1,%g1; \
74: mov %l2,%g2; \
75: mov %l3,%g3; \
76: mov %l4,%g4; \
77: mov %l5,%g5; \
78: mov %l6,%g6; \
79: mov %l7,%g7
80:
81: /* The ML stack frame has the following layout (set up by restoreregs):
82: *
83: * +-----------------+
84: * %fp = %sp+80: | temp for floor |
85: * +-----------------+
86: * %sp+76: | addr of _ml_div |
87: * +-----------------+
88: * %sp+72: | addr of _ml_mul |
89: * +-----------------+
90: * %sp+68: | saved %g6 |
91: * +-----------------+
92: * %sp+64: | saved %g7 |
93: * +-----------------+
94: * | space to save |
95: * | in and local |
96: * %sp: | registers |
97: * +-----------------+
98: *
99: * the size of the frame is
100: */
101: #define ML_FRAMESIZE (WINDOWSIZE+20)
102:
103:
104: #define String(handle,len,str) \
105: .align 4; \
106: .word len*power_tags+tag_string; \
107: handle: .ascii str; \
108: .align 4
109:
110: #define Closure(name) \
111: .align 4; \
112: .word mak_desc(1,tag_record); \
113: name: .word 7f; \
114: .word 1; \
115: .word tag_backptr; \
116: 7:
117:
118: #define RAISE \
119: ld [%g7],%i2; \
120: jmp %i2; \
121: mov %g7,%i1 /* (delay slot) */
122:
123: #define CONTINUE \
124: ld [%i1],%i2; \
125: jmp %i2; \
126: nop
127:
128:
129: .seg "text"
130: .global _runvec
131: .align 4
132: .word mak_desc(8, tag_record)
133: _runvec:
134: .word _array_v
135: .word _callc_v
136: .word _create_b_v
137: .word _create_s_v
138: .word _floor_v
139: .word _logb_v
140: .word _scalb_v
141: .word _syscall_v
142:
143:
144: .global _startprim
145: _startprim:
146:
147:
148: /* array : (int * 'a) -> 'a array
149: * Allocate and initialize a new array. This can cause GC.
150: */
151: Closure(_array_v)
152: 1:
153: ld [%i0],%o0 /* get length into %o0 */
154: ld [%i0+4],%l0 /* get default into %l0 */
155: sra %o0,1,%o0 /* convert to sparc int */
156: sll %o0,width_tags,%o1 /* build the tag in %o1 */
157: or %o1,tag_array,%o1
158: sll %o0,2,%o0 /* scale length to bytes */
159: add %g4,%o0,%o4 /* check the heap limit */
160: addcc %g6,%o4,%g0
161: bvs 3f /* we hit the limit, so trap safely */
162: dec 4,%o0 /* length-- */
163: st %o1,[%g6-4] /* store the tag */
164: mov %g6,%i0 /* result := object addr. */
165: 2: /* initialization loop */
166: st %l0,[%g6] /* store default. */
167: deccc 4,%o0 /* length-- */
168: bge 2b
169: inc 4,%g6 /* freeptr++ (delay slot) */
170: /* end loop */
171: inc 4,%g6 /* freeptr++ */
172: CONTINUE
173: 3: /* we come here to do a safe GC trap. */
174: add %g0,0,%g0 /* a nop to get PC adjust right */
175: taddcctv %g6,%o4,%g0 /* cause the GC trap. */
176: ba 1b /* retry the allocation. */
177: nop
178:
179:
180: /* create_b : int -> string
181: * create_s : int -> string
182: * Create bytearray or string of given length. This can cause GC.
183: */
184: Closure(_create_b_v)
185: ba 2f
186: mov tag_bytearray,%l1 /* (delay slot) */
187:
188: Closure(_create_s_v)
189: mov tag_string,%l1
190:
191: 2: sra %i0,1,%o0 /* %o0 = length (sparc int) */
192: sll %o0,width_tags,%o2
193: or %o2,%l1,%o1 /* build the tag in %o1 */
194: add %o0,3,%o0 /* %o0 = length in words (no tag) */
195: sra %o0,2,%o0
196: sll %o0,2,%o0 /* %o0 = length in bytes (no tag) */
197: add %g4,%o0,%o4 /* Check the heap limit. */
198: addcc %g6,%o4,%g0
199: bvs 3f /* we hit the limit, so trap safely. */
200: st %o1,[%g6-4] /* store the tag */
201: mov %g6,%i0 /* result := object addr */
202: add %o0,4,%o0 /* %o0 = length in bytes (including tag) */
203: add %o0,%g6,%g6 /* freeptr += length */
204: CONTINUE
205: 3: /* we come here to do a safe GC trap. */
206: add %g0,0,%g0 /* a nop to get PC adjust right */
207: taddcctv %g6,%o4,%g0 /* cause the GC trap. */
208: ba 2b /* retry the allocation. */
209: nop
210:
211:
212: /* floor : real -> int
213: * Return the floor of the argument or else raise Float("floor") if out of range.
214: * We implement the range check by using an integer comparison with the high 32
215: * bits of the real value (which contains the biased exponent).
216: * (double)(2^30) == [0x41d00000, 0x0]
217: * (double)(-2^30) == [0xc1d00000, 0x0]
218: */
219: Closure(_floor_v)
220: ld [%i0],%f0 /* fetch arg into %f0, %f1. */
221: ld [%i0+4],%f1
222: ld [%i0],%o0 /* %o0 gets high word. */
223: tst %o0 /* negative ? */
224: blt 1f
225: nop
226: /* handle positive case */
227: set 0x41d00000,%o1 /* %o1 = 2^30 */
228: cmp %o0,%o1 /* if %o0 >= 2^30 then range error */
229: bge out_of_range
230: nop
231: fdtoi %f0,%f2 /* cvt to int (round towards 0) */
232: st %f2,[%sp+80]
233: ld [%sp+80],%o0 /* %o0 gets int result (via stack temp). */
234: ba 2f
235: nop
236: 1: /* handle negative case. */
237: set 0xc1d00000,%o1 /* %o1 = -2^30 */
238: cmp %o0,%o1 /* if %o0 < -2^30 then range error */
239: bge out_of_range /* not bl because of sign. */
240: nop
241: fdtoi %f0,%f2 /* cvt to int (round towards 0) */
242: st %f2,[%sp+80]
243: fitod %f2,%f4 /* cvt back to real to check for fraction */
244: fcmpd %f0,%f4 /* same value? */
245: ld [%sp+80],%o0 /* %o0 gets int result (via stack temp). */
246: fbe 2f /* check result of fcmpd */
247: nop
248: dec %o0 /* push one lower */
249: 2: /* cvt result to ML int, and continue */
250: add %o0,%o0,%o0
251: add %o0,1,%i0
252: CONTINUE
253:
254: out_of_range: /* out of range, so raise Float("floor"). */
255: set 1f,%i0
256: ba _raise_real
257: String(1, 5, "floor\0\0\0")
258:
259:
260: /* logb : real -> int
261: * Extract and unbias the exponent, return 0 for a zero exponent.
262: * The IEEE bias is 1023.
263: */
264: Closure(_logb_v)
265: ld [%i0],%o0 /* extract exponent. */
266: srl %o0,20,%o0
267: andcc %o0,0x7ff,%o0 /* if (exp == 0) */
268: beq 1f
269: nop
270: sll %o0,1,%o0 /* else unbias and cvt to ML int. */
271: sub %o0,2045,%i0 /* 2(n-1023)+1 == 2n-2045. */
272: 1: CONTINUE
273: 2: ba 1b
274: set 1,%i0 /* return ML zero (delay slot) */
275:
276:
277: /* scalb : (real * int) -> real
278: * Scale the first argument by 2 raised to the second argument. Raise
279: * Float("underflow") or Float("overflow") as appropriate.
280: */
281: Closure(_scalb_v)
282: taddcctv %g6,%g4,%g0 /* check the heap limit. */
283: ld [%i0+4],%o0 /* %o0 gets scale (second arg) */
284: sra %o0,1,%o0 /* cvt scale to sparc int */
285: ld [%i0],%i0 /* %i0 gets real (first arg) */
286: ld [%i0],%o1 /* %o1 gets high word of real value. */
287: set 0x7ff00000,%o3 /* %o3 gets exponent mask. */
288: andcc %o1,%o3,%o4 /* extract exponent into %o4. */
289: beq 1f /* if 0 then return same */
290: nop
291: srl %o4,20,%o4 /* cvt exp to int (delay slot). */
292: addcc %o4,%o0,%o0 /* %o0 = exp + scale */
293: ble under /* if new exp <= 0 then underflow */
294: nop
295: cmp %o0,2047 /* if new exp >= 2047 then overflow */
296: bge over
297: nop
298: andn %o1,%o3,%o1 /* mask out old exponent. */
299: sll %o0,20,%o0 /* shift new exp to exponent position. */
300: or %o1,%o0,%o1 /* set new exponent. */
301: ld [%i0+4],%o0 /* %o0 gets low word of real value. */
302: st %o1,[%g6] /* allocate the new real value */
303: st %o0,[%g6+4]
304: set mak_desc(8,tag_string),%o0
305: st %o0,[%g6-4]
306: mov %g6,%i0 /* set result. */
307: inc 12,%g6 /* storeptr += 3 */
308: 1: CONTINUE
309:
310: over: /* handle overflow */
311: set 1f,%i0
312: ba _raise_real
313: nop
314: String(1, 8, "overflow")
315: under: /* handle underflow */
316: set 1f,%i0
317: ba _raise_real
318: nop
319: String(1, 9, "underflow\0\0\0")
320:
321:
322: /* raise_real:
323: * Raise the exception Float with the string in %i0.
324: */
325: _raise_real:
326: taddcctv %g6,%g4,%g0 /* check the heap limit. */
327: set _real_e,%o0 /* allocate the exception. */
328: st %i0,[%g6]
329: st %o0,[%g6+4]
330: set mak_desc(2,tag_record),%o0
331: st %o0,[%g6-4]
332: mov %g6,%i0
333: inc 12,%g6 /* freeptr += 3 */
334: RAISE
335:
336:
337: .global _endprim
338: _endprim:
339:
340:
341: /* syscall : (int * string list * int) -> int
342: * Note: it is assumed that there are no more than five arguments, plus the code.
343: */
344: Closure(_syscall_v)
345: #define TMPSIZE 20 /* space to save upto five args */
346: #define TMPBASE WINDOWSIZE /* offset of start of temp save area. */
347: mov %i0,%o0
348: save %sp,-SA(WINDOWSIZE+TMPSIZE),%sp
349: SAVE_ML_REGS
350: ld [%i0+8],%o0 /* %o0 = argcount */
351: sra %o0,1,%o0 /* cvt to sparc int */
352: add %sp,TMPBASE,%o1 /* %o1 = base address of temp area */
353: ld [%i0+4],%o2 /* %o2 = arglist */
354: 1: /* loop: process arg list, saving in temp area */
355: deccc 1,%o0 /* if --argcount < 0 then done */
356: bl 3f
357: nop
358: ld [%o2],%o3 /* fetch next arg */
359: btst 1,%o3 /* is the arg an unboxed value? */
360: be 2f
361: ld [%o2+4],%o2 /* advance arg list pointer (delay slot) */
362: sra %o3,1,%o3 /* cvt unboxed arg to sparc int */
363: 2: st %o3,[%o1] /* store arg in temp area */
364: ba 1b
365: inc 4,%o1 /* tempptr++ (delay slot) */
366: /* end of loop */
367: 3: /* load the args into the output registers, we */
368: /* use all six registers even though there may */
369: /* be fewer arguments. */
370: ld [%i0],%o0 /* %o0 = system call number */
371: sra %o0,1,%o0 /* cvt to sparc int */
372: ld [%sp+TMPBASE],%o1
373: ld [%sp+TMPBASE+4],%o2
374: ld [%sp+TMPBASE+8],%o3
375: ld [%sp+TMPBASE+12],%o4
376: ld [%sp+TMPBASE+16],%o5
377: clr %g1 /* 0 is code for syscall. */
378: ta %g0
379: blu 5f
380: nop
381: sll %o0,1,%o0 /* cvt result to ML int */
382: inc 1,%o0
383: 4: RESTORE_ML_REGS
384: restore %o0,0,%i0 /* restore register window, returning result */
385: CONTINUE
386: 5: /* an error, so return -1 */
387: STORE (%o0, _errno)
388: ba 4b
389: set -1,%o0 /* (delay slot) */
390:
391: /* callc : ('b * 'a) -> int
392: * Call a C function with one argument.
393: */
394: Closure(_callc_v)
395: mov %i0,%o0
396: save %sp,-SA(WINDOWSIZE),%sp
397: SAVE_ML_REGS
398: ld [%i0],%o1 /* %o1 = address of the C function */
399: jmpl %o1,%o7 /* call the C function */
400: ld [%i0+4],%o0 /* %o0 = arg (delay slot) */
401: RESTORE_ML_REGS
402: restore %o0,0,%i0 /* restore ML register window, returning result */
403: FETCH (_cause, %o4)
404: tst %o4 /* if (cause != 0) */
405: bne _saveregs /* then return up to the C environment. */
406: nop /* (delay slot) */
407: CONTINUE
408:
409:
410: /* Space to save pointer and non-pointer registers; this is allocated here to
411: * insure quad-word alignment.
412: */
413: .seg "data"
414: .global _saved_ptrs,_saved_nonptrs
415: .align 8
416: _saved_ptrs:
417: .skip (32*4)
418: .align 8
419: _saved_nonptrs:
420: .skip (32*4)
421: .seg "text"
422:
423:
424: /* handle_c, return_c, saveregs and restoreregs:
425: *
426: * handle_c is the root exception handler continuation.
427: * return_c is the root return continuation.
428: * saveregs saves the current ML registers and returns to C code.
429: * restoreregs restores the ML registers and jumps to the ML code address
430: * in save_pc.
431: */
432: .global _handle_c, _return_c, _saveregs, _restoreregs
433: .global _inML, _fault_pending, _fault_code
434:
435: Closure(_handle_c)
436: ba set_cause
437: set CAUSE_EXN,%o4
438:
439: Closure(_return_c)
440: set CAUSE_RET,%o4
441: set_cause:
442: STORE (%o4, _cause)
443: _saveregs:
444: add %i3,-4096,%i3 /* adjust the base code ptr (sub 4096) */
445: set _saved_ptrs,%o3
446: std %i0,[%o3] /* save %i0, %i1 */
447: std %i2,[%o3+8] /* save %i2, %i3 */
448: std %i4,[%o3+16] /* save %i4, %i5 */
449: std %l0,[%o3+24] /* save %l0, %l1 */
450: std %l2,[%o3+32] /* save %l2, %l3 */
451: std %l4,[%o3+40] /* save %l4, %l5 */
452: std %l6,[%o3+48] /* save %l6, %l7 */
453: std %g2,[%o3+56] /* save %g2, %g3 */
454: st %g1,[%o3+64] /* save %g1 */
455: set _saved_nonptrs,%o3
456: std %o0,[%o3] /* save %o0, %o1 as non-pointers */
457: STORE (%g0, _inML) /* note that we are leaving ML code */
458: STORE (%g7, _saved_exnptr)
459: dec 4,%g6 /* adjust store pointer */
460: STORE (%g6, _saved_dataptr)
461: STORE (%g5, _saved_storeptr)
462: #ifdef OLD
463: set 0x7ffffffc,%o0 /* adjust limit ptr */
464: sub %o0,%g4,%g4
465: STORE (%g4, _saved_limit)
466: #endif
467: ldd [%sp+64],%g6 /* restore C registers %g6 & %g7. */
468: ret
469: restore /* restore C register window (delay slot) */
470:
471: _restoreregs:
472: save %sp,-SA(ML_FRAMESIZE),%sp
473: STORE (%sp, _bottom) /* record the base of the ML frame */
474: std %g6,[%sp+64] /* save C registers %g6 & %g7 */
475: set _ml_mul,%o0 /* set pointer to ml_mul */
476: st %o0,[%sp+72]
477: set _ml_div,%o0 /* set pointer to ml_div */
478: st %o0,[%sp+76]
479: FETCH (_saved_exnptr, %g7)
480: FETCH (_saved_dataptr, %g6)
481: inc 4,%g6 /* adjust store pointer */
482: FETCH (_saved_storeptr, %g5)
483: FETCH (_saved_limit, %g4)
484: set 0x7ffffffc,%o0 /* adjust limit ptr */
485: sub %o0,%g4,%g4
486: set 1,%o0 /* note that we are entering ML code */
487: STORE (%o0, _inML)
488: set _saved_ptrs,%o3
489: ldd [%o3],%i0 /* restore %i0, %i1 */
490: ldd [%o3+8],%i2 /* restore %i2, %i3 */
491: ldd [%o3+16],%i4 /* restore %i4, %i5 */
492: ldd [%o3+24],%l0 /* restore %l0, %l1 */
493: ldd [%o3+32],%l2 /* restore %l2, %l3 */
494: ldd [%o3+40],%l4 /* restore %l4, %l5 */
495: ldd [%o3+48],%l6 /* restore %l6, %l7 */
496: ldd [%o3+56],%g2 /* restore %g2, %g3 */
497: ld [%o3+64],%g1 /* restore %g1 */
498: set _saved_nonptrs,%o3
499: ldd [%o3],%o0 /* restore %o0, %o1 as non-pointers */
500: FETCH (_fault_pending, %o4) /* check for a pending fault */
501: tst %o4
502: bne _fault
503: nop
504: sub %i3,-4096,%i3 /* adjust the base code ptr (add 4096) */
505: FETCH (_saved_pc, %o4) /* fetch the ML code address. */
506: jmp %o4 /* invoke the ML code */
507: nop
508:
509: _fault: /* there is a pending fault */
510: clr %o4 /* clear the pending fault flag */
511: STORE (%o4, _fault_pending)
512: FETCH (_fault_code, %i0) /* get the fault exception packet. */
513: RAISE /* raise the exception */
514:
515: /** Integer multiplication and division routines **
516: *
517: * The arguments are %o2, %o3 and the result is in %o2.
518: * Note: this code assumes that .mul and .div don't trash any global or input
519: * registers.
520: */
521: .global .mul, .div
522:
523: /* ml_mul:
524: * multiply %o2 by %o3, returning the result in %o2
525: * Note: this code assumes that .mul doesn't trash any global or input
526: * registers.
527: */
528: _ml_mul:
529: save %sp,-SA(WINDOWSIZE),%sp
530: mov %i2,%o0
531: call .mul
532: mov %i3,%o1 /* (delay slot) */
533: bnz 1f /* if z is clear, then overflow */
534: restore %o0,0,%o2 /* result in %o2 (delay slot) */
535: retl
536: nop
537: 1: /* handle overflow. */
538: set _overflow_e,%i0
539: RAISE
540:
541: /* ml_div:
542: * divide %o2 by %o3, returning the result in %o2.
543: * Note: .div uses %g1, %g2 and %g3, so we must save them. We do this using the
544: * locals of the new window, since .div is a leaf routine.
545: */
546: _ml_div:
547: save %sp,-SA(WINDOWSIZE),%sp
548: addcc %i3,%g0,%o1 /* %o1 is divisor (and check for zero) */
549: bz 1f
550: /* save %g1, %g2 and %g3 (using new window) */
551: mov %g1,%l1 /* (delay slot) */
552: mov %g2,%l2
553: mov %g3,%l3
554: call .div
555: mov %i2,%o0 /* (delay slot) */
556: /* restore %g1, %g2 and %g3 */
557: mov %l3,%g3
558: mov %l2,%g2
559: mov %l1,%g1
560: ret
561: restore %o0,0,%o2 /* result in %o2 (delay slot) */
562: 1: /* handle zero divide */
563: restore /* restore ML window */
564: set _div_e,%i0
565: RAISE
566:
567:
568: /* this bogosity is for export.c */
569: .global _startptr
570: _startptr:
571: .long start
572:
573:
574: #include <sun4/trap.h>
575:
576: /* ml_longjmp:
577: * Restore the ML register window.
578: */
579: .global _ml_longjmp
580: _ml_longjmp:
581: t ST_FLUSH_WINDOWS /* flush all reg windows to the stack */
582: FETCH (_bottom, %fp) /* set %fp to the %sp of the ML frame */
583: sub %fp,SA(WINDOWSIZE),%sp
584: restore /* restore the ML frame, also restoring */
585: /* the local and in registers. */
586: ba _saveregs
587: nop
588:
589:
590: /* _set_fpsr:
591: *
592: * Load the floating-point status register with the given word.
593: */
594: .global _set_fsr
595: _set_fsr:
596: set fsrtmp,%o1
597: st %o0,[%o1]
598: retl
599: ld [%o1],%fsr /* (delay slot) */
600: .seg "data"
601: fsrtmp: .word 0
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.