![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to MIPS.prim.nw 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 MIPS.prim.nw CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / runtime |
1.1 root 1: \section{Assembly-language primitives for the run-time system}
2: This file is derived from the similar file for the VAX.
3: We include [[<regdef.h>]], which defines names for the registers.
4: <<*>>=
5: #include "tags.h"
6: #include "prof.h"
7: #include "ml.h"
8: #include "prim.h"
9: <<register definitions>>
10: <<[[String]] and [[Closure]] definitions>>
11: .data
12: <<data segment items>>
13: .text
14: <<run vector>>
15: <<array>>
16: <<string and bytearray>>
17: <<C linkage>>
18: <<calling C routines>>
19: <<system calls>>
20: <<floating point>>
21: /* this bogosity is for export.c */
22: .globl startptr
23: startptr: .word __start /* just a guess... */
24:
25:
26: @ We define a couple of macros for creating strings and closures.
27: When calling [[String]] we should use a literal string whose length
28: is a multiple of~4.
29:
30: The closure of a primitive function
31: is a record of length~1, containing a pointer to the first
32: instruction in the function.
33: All closures have length~1 because there aren't any free variables in any
34: of the primitive functions.
35: <<[[String]] and [[Closure]] definitions>>=
36: #define String(handle,len,str) .align 2;\
37: .set noreorder;\
38: .word len*power_tags+tag_string;\
39: handle: .ascii str;\
40: .set reorder
41: #define Closure(name) .align 2;\
42: .set noreorder;\
43: .word mak_desc(1,tag_record);\
44: name: .word 9f; /* address of routine */ \
45: .word 1; /* here for historical reasons */\
46: .word tag_backptr;\
47: .set reorder;\
48: 9:
49: @ \subsection{Allocation and garbage collection}
50: Put a brief summary here: gc is caused by storing beyond the end of high
51: memory.
52: For that reason we store the last word of objects first.
53:
54: @ \subsection{Register usage}
55: \input regs
56: <<register definitions>>=
57: #define stdarg 2
58: #define stdcont 3
59: #define stdclos 4
60: #define storeptr 22
61: #define dataptr 23
62: #define exnptr 30
63: #define artemp1 24
64: #define artemp2 25
65: #define artemp3 20
66: #define ptrtemp 21
67: @ The MIPS version of Unix doesn't put underscores in front of global names.
68:
69: First we define the global [[runvec]].
70: This is an Ml object that represents the substructure [[A]] in
71: {\tt boot/assembly.sig}.
72: All the ML functions will call these primitives by grabbing them
73: out of this record, which contains pointers to all the primitives.
74: <<run vector>>=
75:
76: .globl runvec
77: .align 2
78: .word mak_desc(8,tag_record)
79: runvec:
80: .word array_v
81: .word callc_v
82: .word create_b_v
83: .word create_s_v
84: .word floor_v
85: .word logb_v
86: .word scalb_v
87: .word syscall_v
88:
89: @ \subsection{Creating arrays, strings, and bytearrays}
90: [[array(m,x)]] creates an array of length $n$, each element initialized
91: to $x$.
92: (The corresponding record creation code is not implemented as a primitive;
93: the ML compiler generates that code in line.)
94: $n$~is a tagged integer representing the length in words;
95: $x$ can be any value.
96: This routine will loop forever (or until something strange happens
97: in memory) if $n<0$.
98:
99: We need to be careful in the implementation to make sure all register values
100: are sensible when garbage collection might occur.
101:
102: If the order of instructions seems a little strange, it's because we try to
103: make sensible use of load delay slots.
104: <<array>>=
105: Closure(array_v)
106: lw $artemp1,0($stdarg) /* tagged length in $artemp1 */
107: lw $10,4($stdarg) /* get initial value in $10 */
108: sra $artemp1,1 /* drop the tag bit */
109: sll $artemp2,$artemp1,width_tags /* length for descr into $artemp2 */
110: ori $artemp2,tag_array /* complete descriptor into $artemp2 */
111: sll $artemp1,2 /* get length in bytes into $artemp1 */
112: .set noreorder /* can't reorder because collection might occur */
113: add $artemp3,$artemp1,$dataptr /* $artemp3 points to last word
114: of new array*/
115: badgc1: sw $0,($artemp3) /* clear; causes allocation */
116: .set reorder /* can rearrange instructions again */
117: <<load bad pc into [[$artemp2]]; branch to [[badpc]] if == [[$artemp1]]>>=
118: la $artemp2,badgc1
119: beq $artemp1,$artemp2,badpc
120: @ At this point garbage collection may have occurred.
121: Ordinarily, we couldn't rely
122: on the value in [[$artemp3]], because it's not forwarded.
123: However, this is one of the special garbage collection locations,
124: so we do know that [[$artemp3]] is sensible.
125: But, since we really want something larger, we recompute it,
126: using the (possibly changed) value of the data pointer.
127: Extra cleverness here might enable us to save one instruction.
128: <<array>>=
129: sw $artemp2,0($dataptr) /* store the descriptor */
130: add $dataptr,4 /* points to new object */
131: add $artemp3,$artemp1,$dataptr /* beyond last word of new array*/
132: add $stdarg,$dataptr,$0 /* put ptr in return register
133: (return val = arg of continuation) */
134: <<store the initial value in every slot, leaving [[$dataptr]] pointing to the first free word>>
135: lw $10,0($stdcont) /* grab continuation */
136: j $10 /* return */
137:
138: @ With some clever thinking, the size of this loop could probably be cut
139: from four instructions to three instructions.
140: <<store the initial value in every slot, leaving [[$dataptr]] pointing to the first free word>>=
141: b 2f
142: 1: sw $10,0($dataptr) /* store the value */
143: addi $dataptr,4 /* on to the next word */
144: 2: bne $dataptr,$artemp3,1b /* if not off the end, repeat */
145:
146:
147: @ [[create_b(n)]] creates a byte-array of length $n$, and
148: [[create_s(n)]] creates a string of length $n$.
149:
150: We use the same code to create byte arrays and strings, since the only
151: difference is in the tags.
152: The odd arrangement of closures (odd because each one starts a new record)
153: causes no problems because this code isn't in the garbage-collectible region.
154: <<string and bytearray>>=
155: Closure(create_b_v)
156: addi $artemp3,$0,tag_bytearray /* tag into $artemp3 */
157: b 2f
158: Closure(create_s_v)
159: addi $artemp3,$0,tag_string /* tag into $artemp3 */
160: 2:
161: @ The length computation may be a bit confusing.
162: We are handed a tagged integer $2n+1$, and we need to compute the required
163: number of words, which is $\lfloor{n+3\over 4}\rfloor$.
164: This is just $\lfloor{(2n+1)+5\over 8}\rfloor$.
165: However, we'll save an instruction later if we happen to have one more than
166: the number of words tucked away in a register,
167: because $1+\lfloor{n+3\over 4}\rfloor$ is the number of words
168: we're taking from the data space (we include the descriptor).
169: So we compute $(2n+1)+13$ and continue accordingly
170: <<string and bytearray>>=
171: addi $artemp1,$stdarg,13 /* $2n+14$ */
172: sra $artemp1,3 /* number of words in string+tag */
173: sll $artemp1,2 /* # of bytes allocated for str+tag */
174: .set noreorder /* don't cross gc boundary */
175: add $artemp2,$artemp1,$dataptr /* beyond last word of string */
176: badgc2: sw $0,-4($artemp2) /* clear last; causes allocation */
177: .set reorder
178: sra $artemp2,$stdarg,1 /* untagged length in bytes */
179: sll $artemp2,width_tags /* room for descriptor */
180: or $artemp2,$artemp3 /* descriptor */
181: sw $artemp2,0($dataptr) /* store descriptor */
182: addi $stdarg,$dataptr,4 /* pointer to new string */
183: add $dataptr,$artemp1 /* advance; save 1 instruction */
184: lw $10,0($stdcont) /* grab continuation */
185: j $10 /* return */
186:
187: <<load bad pc into [[$artemp2]]; branch to [[badpc]] if == [[$artemp1]]>>=
188: la $artemp2,badgc2
189: beq $artemp1,$artemp2,badpc
190:
191: @ \subsection{Linkage with C code}
192: C always gains control first, and stuffs something appropriate into
193: the register save areas before starting ML by calling [[restoreregs]].
194: It also puts something appropriate in the ML [[saved_pc]].
195: [[restoreregs]] squirrels away the current state of the C runtime stack,
196: restores the ML registers, and finally jumps to the saved program counter.
197:
198: When ML wants to call C, it calls [[saveregs]], which saves the ML state
199: in the appropriate save areas, then restores the C runtime stack and returns.
200: Before returning to C, it sets [[cause]] to something appropriate.
201:
202: All programs must ensure that [[restoreregs]] {\em never} calls itself
203: recursively, because it is {\em not} reentrant.
204:
205: The C end of this connection is on display in the [[runML()]] function of
206: [[~ml/src/runtime/callgc.c]].
207: <<data segment items>>=
208: bottom: .word 0 /* C's saved stack pointer */
209: <<C linkage>>=
210: .globl saveregs
211: .globl handle_c
212: .globl return_c
213: .globl restoreregs
214: .ent restoreregs
215: restoreregs:
216: <<save caller's stuff using MIPS calling conventions>>
217: <<enable floating point overflow and zerodivide exceptions>>
218: sw $sp,bottom /* save C's stack pointer */
219: <<if [[saved_pc]] points to a bad spot, adjust it (destroys arithmetic temps)>>
220: <<restore the ML registers>>
221: .set noat /* This trick will cause a warning, but the code is OK */
222: lw $at,saved_pc /* grab the saved program counter */
223: j $at /* and continue executing at that spot */
224: .set at
225:
226: @ The next two functions are an exception handler and a continuation for
227: ML programs called from C.
228: Although neither appears to return any result (by manipulating [[$stdarg]],
229: they do return results.
230: It's just that the C code on the other end gets the result out of
231: [[saved_ptrs[0],]] where it expects to find [[$stdarg]].
232: <<C linkage>>=
233: Closure(handle_c) /* exception handler for ML functions called from C */
234: li $artemp1,CAUSE_EXN
235: sw $artemp1,cause
236: b saveregs
237: Closure(return_c) /* continuation for ML functions called from C */
238: li $artemp1,CAUSE_RET
239: sw $artemp1,cause
240: saveregs:
241: <<save the ML registers>>
242: lw $sp,bottom /* recover C's stack pointer */
243: <<restore caller's stuff using MIPS calling conventions>>
244: j $31 /* return to C program */
245: .end restoreregs
246:
247: <<enable floating point overflow and zerodivide exceptions>>=
248: .set noat
249: cfc1 $at,$31 /* grab fpa control register */
250: ori $at,$at,0x600 /* set O and Z bits */
251: ctc1 $at,$31 /* return fpa control register */
252: .set at
253:
254: @ The MIPS calling conventions are described in gory detail in Appendix~D
255: of the MIPS book; pages D-18 and following.
256:
257: At the moment we don't save any floating point registers.
258: We save (on the stack) nine general-purpose registers, the global pointer,
259: and the return address.
260:
261: We always have to allocate at least 16 bytes for argument build,
262: because any C function might be varargs, and might begin by
263: spilling all of its registers into the argument build area (Hanson).
264: We allocate exactly sixteen bytes, planning to fiddle the stack if
265: (God forbid) we are ever asked to issue a system call with more than
266: 16 bytes worth of arguments.
267:
268: <<save caller's stuff using MIPS calling conventions>>=
269: #define regspace 44
270: #define localspace 4
271: #define argbuild 16
272: #define framesize (regspace+localspace+argbuild) /* must be multiple of 8 */
273: #define frameoffset (0-localspace)
274: subu $sp,framesize
275: <<give .mask and save the C registers>>
276:
277: <<restore caller's stuff using MIPS calling conventions>>=
278: <<restore the C registers>>
279: addu $sp,framesize
280: @ We don't save floating point regs yet.
281: <<give .mask and save the C registers>>=
282: .mask 0xd0ff0000,0-localspace
283: sw $31,argbuild+40($sp)
284: sw $30,argbuild+36($sp)
285: sw $gp,argbuild+32($sp)
286: sw $23,argbuild+28($sp)
287: sw $22,argbuild+24($sp)
288: sw $21,argbuild+20($sp)
289: sw $20,argbuild+16($sp)
290: sw $19,argbuild+12($sp)
291: sw $18,argbuild+8($sp)
292: sw $17,argbuild+4($sp)
293: sw $16,argbuild($sp)
294: <<restore the C registers>>=
295: lw $31,argbuild+40($sp)
296: lw $30,argbuild+36($sp)
297: lw $gp,argbuild+32($sp)
298: lw $23,argbuild+28($sp)
299: lw $22,argbuild+24($sp)
300: lw $21,argbuild+20($sp)
301: lw $20,argbuild+16($sp)
302: lw $19,argbuild+12($sp)
303: lw $18,argbuild+8($sp)
304: lw $17,argbuild+4($sp)
305: lw $16,argbuild($sp)
306:
307:
308: @ There are two save areas; one for pointers and one for non-pointers.
309: (The pointer area may, of course, include tagged integers.)
310: The pointer area has special spots for standard argument, continuation,
311: and closure.
312: In addition there are special save areas for the special registers.
313: Register 31 is to be maintained constant relative to the program counter,
314: so we store the difference with [[saved_pc]].
315: <<save the ML registers>>=
316: /* needn't save $1 */
317: /* the big three: argument, continuation, closure */
318: sw $stdarg,saved_ptrs
319: sw $stdcont,saved_ptrs+4
320: sw $stdclos,saved_ptrs+8
321:
322: /* All the miscellaneous guys */
323: sw $5,saved_ptrs+12
324: sw $6,saved_ptrs+16
325: sw $7,saved_ptrs+20
326: sw $8,saved_ptrs+24
327: sw $9,saved_ptrs+28
328: sw $10,saved_ptrs+32
329: sw $11,saved_ptrs+36
330: sw $12,saved_ptrs+40
331: sw $13,saved_ptrs+44
332: sw $14,saved_ptrs+48
333: sw $15,saved_ptrs+52
334: sw $16,saved_ptrs+56
335: sw $17,saved_ptrs+60
336: sw $18,saved_ptrs+64
337: sw $19,saved_ptrs+68
338:
339: sw $21, saved_ptrs+72
340:
341: sw $artemp1,saved_nonptrs
342: sw $artemp2,saved_nonptrs+4
343: sw $artemp3,saved_nonptrs+8
344:
345: /* don't touch registers $26 and $27 */
346:
347: sw $storeptr,saved_storeptr
348: sw $dataptr,saved_dataptr
349: sw $exnptr,saved_exnptr
350:
351: <<save $[[$31]]-[[saved_pc]]$ in [[saved_pc_diff]] (destroys [[$artemp1]])>>
352:
353:
354: <<restore the ML registers>>=
355: /* the big three: argument, continuation, closure */
356: lw $stdarg,saved_ptrs
357: lw $stdcont,saved_ptrs+4
358: lw $stdclos,saved_ptrs+8
359:
360: /* All the miscellaneous guys */
361: lw $5,saved_ptrs+12
362: lw $6,saved_ptrs+16
363: lw $7,saved_ptrs+20
364: lw $8,saved_ptrs+24
365: lw $9,saved_ptrs+28
366: lw $10,saved_ptrs+32
367: lw $11,saved_ptrs+36
368: lw $12,saved_ptrs+40
369: lw $13,saved_ptrs+44
370: lw $14,saved_ptrs+48
371: lw $15,saved_ptrs+52
372: lw $16,saved_ptrs+56
373: lw $17,saved_ptrs+60
374: lw $18,saved_ptrs+64
375: lw $19,saved_ptrs+68
376:
377: lw $21, saved_ptrs+72
378:
379: <<restore [[$31]] from [[saved_pc]] \& [[saved_pc_diff]] (destroys [[$artemp1]])>>
380: lw $artemp1,saved_nonptrs
381: lw $artemp2,saved_nonptrs+4
382: lw $artemp3,saved_nonptrs+8
383:
384: /* don't touch registers $26 and $27 */
385:
386: lw $storeptr,saved_storeptr
387: lw $dataptr,saved_dataptr
388: lw $exnptr,saved_exnptr
389:
390: <<save $[[$31]]-[[saved_pc]]$ in [[saved_pc_diff]] (destroys [[$artemp1]])>>=
391: lw $artemp1,saved_pc
392: subu $artemp1,$31,$artemp1 /* mustn't overflow */
393: sw $artemp1,saved_pc_diff
394: <<restore [[$31]] from [[saved_pc]] \& [[saved_pc_diff]] (destroys [[$artemp1]])>>=
395: lw $artemp1,saved_pc
396: lw $31,saved_pc_diff
397: addu $31,$artemp1 /* mustn't overflow */
398: <<data segment items>>=
399: saved_pc_diff: .word 0
400:
401:
402: @ Because the Mips has no indexed addressing modes, there are special
403: circumstances under which we have to adjust the program counter before
404: a garbage collection.
405: The problem arises when we want to create an object whose size is not
406: known at compile time.
407: In order to do that, we have to add the size of the object to [[$dataptr]],
408: putting the result in a new register.
409: We then store at offset $-4$ from that register to allocate (and possibly
410: cause garbage collection).
411: That register can't be a pointer, because at the time of the gc it doesn't
412: point to anything sensible (in fact, by definition it points out of the
413: garbage-collectible region entirely).
414: If it is a nonpointer, though, it isn't changed by the garbage collection,
415: so when the collection is over, we attempt once again to store in exactly
416: the same place, causing another fault (unless the heap has been resized).
417:
418: The solution is a hack. Since there are only two places this problem
419: can occur, we check [[saved_pc]] against the offending program counters.
420: If we find one, we reduce [[saved_pc]] by 4 (the size of one instruction),
421: causing the addition to be repeated.
422:
423: <<if [[saved_pc]] points to a bad spot, adjust it (destroys arithmetic temps)>>=
424: lw $artemp1,saved_pc
425: <<load bad pc into [[$artemp2]]; branch to [[badpc]] if == [[$artemp1]]>>
426: b 1f
427: badpc:
428: subu $artemp1,4 /* adjust */
429: sw $artemp1,saved_pc /* save */
430: 1:
431:
432:
433: @ [[callc(f,a)]] calls a C-language function [[f]] with argument [[a]].
434: We don't have to save a register unless we'll need its value later.
435:
436: The closure of this routine is irrelevant, since [[callc]] doesn't
437: have any free variables.
438: Therefore the only things that have to be restored after the call to~C
439: are the continuation, the store pointer, the data pointer, and
440: the exception handler.
441: If we wanted [[callc]] to be more efficient, we would
442: rearrange things so that all those registers fell into [[s0]]--[[s8]],
443: where they would automatically be preserved across procedure calls.
444: As it stands, everything except the continuation is preserved,
445: so we're not doing too badly.
446:
447: Miraculously, C routines return integer results in [[$2]], which is
448: exactly the register we need to pass to our continuation (in order to
449: return a value).
450: I decided not to rely on this, and to include a [[move]] instruction
451: anyway. Maybe the assembler will park it in a delay slot since it
452: is a nop.
453: <<calling C routines>>=
454: Closure(callc_v)
455: sw $stdcont,argbuild+regspace($sp) /* save continuation on stack */
456: lw $4,4($stdarg) /* get value a into arg register */
457: lw $10,0($stdarg) /* get address of f into misc reg */
458: jal $10 /* call f ($31 can be trashed) */
459: move $stdarg,$2 /* return val is argument to continuation */
460: lw $stdcont,argbuild+regspace($sp) /* recover continuation */
461: <<put zeroes in all forwardable regs that might hold garbage>>
462: lw $artemp3,cause /* get cause */
463: bne $artemp3,$0,saveregs /* if cause != 0, save ML & return to C */
464: lw $10,0($stdcont) /* grab continuation */
465: j $10 /* return */
466: @ A forwardable register can hold garbage unless it was saved
467: by C (is in [[s0]]--[[s8]]) or is [[$stdarg]] of [[$stdcont]].
468: <<put zeroes in all forwardable regs that might hold garbage>>=
469: move $stdclos,$0
470: move $5,$0
471: move $6,$0
472: move $7,$0
473: move $8,$0
474: move $9,$0
475: move $10,$0
476: move $11,$0
477: move $12,$0
478: move $13,$0
479: move $14,$0
480: move $15,$0
481: /* $16--$23 and $30 are saved by the callee */
482:
483: @ This interface is going to be agony, because the rules for passing
484: arguments are passing strange.
485: The interface is [[syscall_v(callnumber,argvector,argcount)]].
486:
487: The system call interface is the same as the procedure call interface,
488: but instead of a [[jal]] we use a [[syscall]] instruction, and
489: we put the system call number in register [[$2]].
490: It appears that, after the execution of the [[syscall]] handler,
491: the result is in [[$2]], and [[$7]] is zero unless an error occurred.
492: We will put all the arguments on the stack, then load the first four
493: into [[$4]]--[[$7]].
494: <<system calls>>=
495: Closure(syscall_v)
496: sw $stdcont,argbuild+regspace($sp) /* save continuation on stack */
497: lw $artemp1,8($stdarg) /* 2*argc+1 in $artemp1 */
498: sra $artemp1,1 /* argc in $artemp1 */
499: move $16,$sp /* save our $sp */
500: <<extend argbuild area to be big enough for all arguments>>
501: lw $ptrtemp,4($stdarg) /* argv in $ptrtemp */
502: <<put all arguments onto the stack>>
503: <<load first four arguments into [[$4]]--[[$7]]>>
504: 9: lw $2,0($stdarg) /* get syscall # in $2; trash $stdarg */
505: sra $2,1 /* throw out the tag bit */
506: syscall
507: move $sp,$16 /* recover the good stack pointer */
508: lw $stdcont,argbuild+regspace($sp) /* recover continuation */
509: bnez $7,1f /* if error, return ~1 */
510: move $stdarg,$2 /* return val is argument to continuation */
511: add $stdarg,$stdarg /* double return value */
512: addi $stdarg,1 /* and add tag bit */
513: b 2f
514: 1: sw $stdarg,errno
515: li $stdarg,-1
516: 2:
517: <<put zeroes in all forwardable regs that might hold garbage>>
518: lw $10,0($stdcont) /* grab continuation */
519: j $10 /* return */
520:
521: @ At this point we know that the number of arguments is in [[$artemp1]].
522: We have room for four arguments; if there are more
523: we'll have to increase the stack size by the appropriate multiple of 8
524: so that it stays doubleword-aligned.
525: <<extend argbuild area to be big enough for all arguments>>=
526: ble $artemp1,4,1f /* big enough */
527: sub $artemp2,$artemp1,3 /* (temp2 = argc - 4 + 1) > 1 */
528: sra $artemp2,1
529: sll $artemp2,3 /* temp2 = 4 * roundup (argc-4,2) */
530: subu $sp,$artemp2 /* increase stack */
531: 1:
532:
533: @ Now we have a list of arguments pointed to by [[$ptrtemp]].
534: We have the count of the arguments in [[$artemp1]].
535: We have to put them on the stack.
536: We have to remove tag bits where appropriate.
537: <<put all arguments onto the stack>>=
538: move $artemp2,$sp /* destination in $artemp2 */
539: b 1f /* branch forward to test */
540: 2: /* argc > 0 */
541: lw $artemp3,0($ptrtemp) /* get list element */
542: andi $10,$artemp3,1 /* tagged? */
543: beqz $10,3f
544: sra $artemp3,1 /* drop tag bit */
545: 3: sw $artemp3,0($artemp2) /* save the argument */
546: lw $ptrtemp,4($ptrtemp) /* next element */
547: add $artemp2,4 /* next arg build area */
548: sub $artemp1,1 /* --argc */
549: 1: bgtz $artemp1,2b /* if argc>0, store another */
550:
551: @ It doesn't matter if we load arguments that aren't there; the
552: system call will just ignore them.
553: <<load first four arguments into [[$4]]--[[$7]]>>=
554: lw $4,0($sp)
555: lw $5,4($sp)
556: lw $6,8($sp)
557: lw $7,12($sp)
558:
559: @ \subsection{Floating point}
560: We store floating point constants in two words, with the least significant
561: word first.
562: We use the 64 bit IEEE format.
563:
564: We begin with instructions to change the rounding modes.
565: See the MIPS book, pages 6-5--6-7.
566: <<tell the floating point unit to round toward $-\infty$>>=
567: .set noat
568: cfc1 $at,$31 /* grab fpa control register */
569: ori $at,0x03 /* set rounding bits to 11 */
570: ctc1 $at,$31 /* return fpa control register */
571: .set at
572: <<tell the floating point unit to round to nearest>>=
573: .set noat
574: cfc1 $at,$31 /* grab fpa control register */
575: ori $at,0x03 /* set rounding bits to 11 */
576: xori $at,0x03 /* set rounding bits to 00
577: ctc1 $at,$31 /* return fpa control register */
578: .set at
579: @ These floating point functions are used int floating to integer conversion.
580: <<floating point>>=
581: /* Floating exceptions raised (assuming ROP's are never passed to functions):
582: * DIVIDE BY ZERO - (div)
583: * OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate
584: *
585: * floor raises integer overflow if the float is out of 32-bit range,
586: * so the float is tested before conversion, to make sure it is in (31-bit)
587: * range */
588:
589: @ [[floor(x)]] returns the smallest integer less than or equal to [[x]].
590: <<floating point>>=
591: Closure(floor_v)
592: lwc1 $f4,0($stdarg) /* get least significant word */
593: lwc1 $f5,4($stdarg) /* get most significant word */
594: <<tell the floating point unit to round toward $-\infty$>>
595: cvt.w.d $f6,$f4 /* convert to integer */
596: <<tell the floating point unit to round to nearest>>
597: mfc1 $stdarg,$f6 /* get in std argument register */
598: sll $stdarg,1 /* make room for tag bit */
599: add $stdarg,1 /* add the tag bit */
600: lw $10,0($stdcont) /* grab continuation */
601: j $10 /* return */
602:
603:
604: @ [[logb(x)]] returns the exponent part of the floating point [[x]].
605: We grab the 11-bit exponent from the word, then unbias it (according
606: to the IEEE standard) by subtracting 1023.
607: <<floating point>>=
608: Closure(logb_v)
609: lw $stdarg,4($stdarg) /* most significant part */
610: srl $stdarg,20 /* throw out 20 low bits */
611: andi $stdarg,0x07ff /* clear all but 11 low bits */
612: sub $stdarg,1023 /* subtract 1023 */
613: sll $stdarg,1 /* make room for tag bit */
614: add $stdarg,1 /* add the tag bit */
615: lw $10,0($stdcont) /* grab continuation */
616: j $10 /* return */
617:
618: @ [[scalb(x,n)]] adds [[n]] to the exponent of floating
619: point [[x]].
620: Since we don't want the resulting float to be anything
621: special, we insist that the unbiased exponent of the result
622: satisfy $-1022 \le E \le 1023$, i.e.\ that the biased exponent satisfy
623: $1 \le e \le 2046$.
624: <<floating point>>=
625: Closure(scalb_v)
626: lw $artemp1,4($stdarg) /* get tagged n */
627: sra $artemp1,1 /* get real n */
628: beqz $artemp1,9f /* if zero, return the old float */
629: lw $ptrtemp,0($stdarg) /* get pointer to float */
630: lw $artemp2,4($ptrtemp) /* most significant part */
631: srl $artemp2,20 /* throw out 20 low bits */
632: andi $artemp2,0x07ff /* clear all but 11 low bits */
633: add $artemp3,$artemp2,$artemp1 /* new := old + n */
634: blt $artemp3,1,under /* punt if underflow */
635: bgt $artemp3,2046,over /* or overflow */
636: <<allocate and store new floating point constant and set [[$stdarg]]>>
637: lw $10,0($stdcont) /* grab continuation */
638: j $10 /* return */
639:
640: 9: lw $stdarg,0($stdarg) /* get old float */
641: lw $10,0($stdcont) /* grab continuation */
642: j $10 /* return */
643:
644: over: la $stdarg,1f /* exception name in $stdarg */
645: b raise_real
646: String(1,8,"overflow")
647: under: la $stdarg,1f /* exception name in $stdarg */
648: b raise_real
649: String(1,9,"underflow\0\0\0")
650:
651: raise_real:
652: /* build new record to pass to exception handler */
653: /* [descriptor]
654: /* [exception (string)]
655: /* [real_e (more exception info)]
656: */
657: la $10,real_e /* get address of real_e */
658: .set noreorder
659: sw $10,8($dataptr) /* allocate; may cause gc */
660: .set reorder
661: sw $stdarg,4($dataptr)
662: li $10,mak_desc(2,tag_record)
663: sw $10,0($dataptr)
664: add $stdarg,$dataptr,4 /* new record is argument */
665: addi $dataptr,12 /* $dataptr restored */
666: move $stdclos,$exnptr /* make sure closure is right */
667: lw $10,0($exnptr) /* grab handler */
668: j $10 /* raise the exception */
669:
670: @ Here we indulge in a little cleverness to save a couple of instructions.
671: Since the old value is in [[$artemp2]] and the new in [[$artemp3]],
672: we can [[xor]] them, then store the new one with a second [[xor]].
673: <<allocate and store new floating point constant and set [[$stdarg]]>>=
674: xor $artemp3,$artemp2 /* at3 = new xor old */
675: sll $artemp3,20 /* put exponent in right position */
676: lw $artemp2,4($ptrtemp) /* most significant word */
677: xor $artemp2,$artemp3 /* change to new exponent */
678: .set noreorder
679: sw $artemp2,8($dataptr) /* allocate; may cause gc */
680: .set reorder
681: lw $artemp2,0($ptrtemp) /* get least significant word */
682: li $10,mak_desc(8,tag_string) /* make descriptor */
683: sw $artemp2,4($dataptr) /* save lsw */
684: sw $10,0($dataptr) /* save descriptor */
685: add $stdarg,$dataptr,4 /* get pointer to new float */
686: add $dataptr,12 /* point to new free word */
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.