![[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 |
researchv10 Norman
\section{Assembly-language primitives for the run-time system}
This file is derived from the similar file for the VAX.
We include [[<regdef.h>]], which defines names for the registers.
<<*>>=
#include "tags.h"
#include "prof.h"
#include "ml.h"
#include "prim.h"
<<register definitions>>
<<[[String]] and [[Closure]] definitions>>
.data
<<data segment items>>
.text
<<run vector>>
<<array>>
<<string and bytearray>>
<<C linkage>>
<<calling C routines>>
<<system calls>>
<<floating point>>
/* this bogosity is for export.c */
.globl startptr
startptr: .word __start /* just a guess... */
@ We define a couple of macros for creating strings and closures.
When calling [[String]] we should use a literal string whose length
is a multiple of~4.
The closure of a primitive function
is a record of length~1, containing a pointer to the first
instruction in the function.
All closures have length~1 because there aren't any free variables in any
of the primitive functions.
<<[[String]] and [[Closure]] definitions>>=
#define String(handle,len,str) .align 2;\
.set noreorder;\
.word len*power_tags+tag_string;\
handle: .ascii str;\
.set reorder
#define Closure(name) .align 2;\
.set noreorder;\
.word mak_desc(1,tag_record);\
name: .word 9f; /* address of routine */ \
.word 1; /* here for historical reasons */\
.word tag_backptr;\
.set reorder;\
9:
@ \subsection{Allocation and garbage collection}
Put a brief summary here: gc is caused by storing beyond the end of high
memory.
For that reason we store the last word of objects first.
@ \subsection{Register usage}
\input regs
<<register definitions>>=
#define stdarg 2
#define stdcont 3
#define stdclos 4
#define storeptr 22
#define dataptr 23
#define exnptr 30
#define artemp1 24
#define artemp2 25
#define artemp3 20
#define ptrtemp 21
@ The MIPS version of Unix doesn't put underscores in front of global names.
First we define the global [[runvec]].
This is an Ml object that represents the substructure [[A]] in
{\tt boot/assembly.sig}.
All the ML functions will call these primitives by grabbing them
out of this record, which contains pointers to all the primitives.
<<run vector>>=
.globl runvec
.align 2
.word mak_desc(8,tag_record)
runvec:
.word array_v
.word callc_v
.word create_b_v
.word create_s_v
.word floor_v
.word logb_v
.word scalb_v
.word syscall_v
@ \subsection{Creating arrays, strings, and bytearrays}
[[array(m,x)]] creates an array of length $n$, each element initialized
to $x$.
(The corresponding record creation code is not implemented as a primitive;
the ML compiler generates that code in line.)
$n$~is a tagged integer representing the length in words;
$x$ can be any value.
This routine will loop forever (or until something strange happens
in memory) if $n<0$.
We need to be careful in the implementation to make sure all register values
are sensible when garbage collection might occur.
If the order of instructions seems a little strange, it's because we try to
make sensible use of load delay slots.
<<array>>=
Closure(array_v)
lw $artemp1,0($stdarg) /* tagged length in $artemp1 */
lw $10,4($stdarg) /* get initial value in $10 */
sra $artemp1,1 /* drop the tag bit */
sll $artemp2,$artemp1,width_tags /* length for descr into $artemp2 */
ori $artemp2,tag_array /* complete descriptor into $artemp2 */
sll $artemp1,2 /* get length in bytes into $artemp1 */
.set noreorder /* can't reorder because collection might occur */
add $artemp3,$artemp1,$dataptr /* $artemp3 points to last word
of new array*/
badgc1: sw $0,($artemp3) /* clear; causes allocation */
.set reorder /* can rearrange instructions again */
<<load bad pc into [[$artemp2]]; branch to [[badpc]] if == [[$artemp1]]>>=
la $artemp2,badgc1
beq $artemp1,$artemp2,badpc
@ At this point garbage collection may have occurred.
Ordinarily, we couldn't rely
on the value in [[$artemp3]], because it's not forwarded.
However, this is one of the special garbage collection locations,
so we do know that [[$artemp3]] is sensible.
But, since we really want something larger, we recompute it,
using the (possibly changed) value of the data pointer.
Extra cleverness here might enable us to save one instruction.
<<array>>=
sw $artemp2,0($dataptr) /* store the descriptor */
add $dataptr,4 /* points to new object */
add $artemp3,$artemp1,$dataptr /* beyond last word of new array*/
add $stdarg,$dataptr,$0 /* put ptr in return register
(return val = arg of continuation) */
<<store the initial value in every slot, leaving [[$dataptr]] pointing to the first free word>>
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
@ With some clever thinking, the size of this loop could probably be cut
from four instructions to three instructions.
<<store the initial value in every slot, leaving [[$dataptr]] pointing to the first free word>>=
b 2f
1: sw $10,0($dataptr) /* store the value */
addi $dataptr,4 /* on to the next word */
2: bne $dataptr,$artemp3,1b /* if not off the end, repeat */
@ [[create_b(n)]] creates a byte-array of length $n$, and
[[create_s(n)]] creates a string of length $n$.
We use the same code to create byte arrays and strings, since the only
difference is in the tags.
The odd arrangement of closures (odd because each one starts a new record)
causes no problems because this code isn't in the garbage-collectible region.
<<string and bytearray>>=
Closure(create_b_v)
addi $artemp3,$0,tag_bytearray /* tag into $artemp3 */
b 2f
Closure(create_s_v)
addi $artemp3,$0,tag_string /* tag into $artemp3 */
2:
@ The length computation may be a bit confusing.
We are handed a tagged integer $2n+1$, and we need to compute the required
number of words, which is $\lfloor{n+3\over 4}\rfloor$.
This is just $\lfloor{(2n+1)+5\over 8}\rfloor$.
However, we'll save an instruction later if we happen to have one more than
the number of words tucked away in a register,
because $1+\lfloor{n+3\over 4}\rfloor$ is the number of words
we're taking from the data space (we include the descriptor).
So we compute $(2n+1)+13$ and continue accordingly
<<string and bytearray>>=
addi $artemp1,$stdarg,13 /* $2n+14$ */
sra $artemp1,3 /* number of words in string+tag */
sll $artemp1,2 /* # of bytes allocated for str+tag */
.set noreorder /* don't cross gc boundary */
add $artemp2,$artemp1,$dataptr /* beyond last word of string */
badgc2: sw $0,-4($artemp2) /* clear last; causes allocation */
.set reorder
sra $artemp2,$stdarg,1 /* untagged length in bytes */
sll $artemp2,width_tags /* room for descriptor */
or $artemp2,$artemp3 /* descriptor */
sw $artemp2,0($dataptr) /* store descriptor */
addi $stdarg,$dataptr,4 /* pointer to new string */
add $dataptr,$artemp1 /* advance; save 1 instruction */
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
<<load bad pc into [[$artemp2]]; branch to [[badpc]] if == [[$artemp1]]>>=
la $artemp2,badgc2
beq $artemp1,$artemp2,badpc
@ \subsection{Linkage with C code}
C always gains control first, and stuffs something appropriate into
the register save areas before starting ML by calling [[restoreregs]].
It also puts something appropriate in the ML [[saved_pc]].
[[restoreregs]] squirrels away the current state of the C runtime stack,
restores the ML registers, and finally jumps to the saved program counter.
When ML wants to call C, it calls [[saveregs]], which saves the ML state
in the appropriate save areas, then restores the C runtime stack and returns.
Before returning to C, it sets [[cause]] to something appropriate.
All programs must ensure that [[restoreregs]] {\em never} calls itself
recursively, because it is {\em not} reentrant.
The C end of this connection is on display in the [[runML()]] function of
[[~ml/src/runtime/callgc.c]].
<<data segment items>>=
bottom: .word 0 /* C's saved stack pointer */
<<C linkage>>=
.globl saveregs
.globl handle_c
.globl return_c
.globl restoreregs
.ent restoreregs
restoreregs:
<<save caller's stuff using MIPS calling conventions>>
<<enable floating point overflow and zerodivide exceptions>>
sw $sp,bottom /* save C's stack pointer */
<<if [[saved_pc]] points to a bad spot, adjust it (destroys arithmetic temps)>>
<<restore the ML registers>>
.set noat /* This trick will cause a warning, but the code is OK */
lw $at,saved_pc /* grab the saved program counter */
j $at /* and continue executing at that spot */
.set at
@ The next two functions are an exception handler and a continuation for
ML programs called from C.
Although neither appears to return any result (by manipulating [[$stdarg]],
they do return results.
It's just that the C code on the other end gets the result out of
[[saved_ptrs[0],]] where it expects to find [[$stdarg]].
<<C linkage>>=
Closure(handle_c) /* exception handler for ML functions called from C */
li $artemp1,CAUSE_EXN
sw $artemp1,cause
b saveregs
Closure(return_c) /* continuation for ML functions called from C */
li $artemp1,CAUSE_RET
sw $artemp1,cause
saveregs:
<<save the ML registers>>
lw $sp,bottom /* recover C's stack pointer */
<<restore caller's stuff using MIPS calling conventions>>
j $31 /* return to C program */
.end restoreregs
<<enable floating point overflow and zerodivide exceptions>>=
.set noat
cfc1 $at,$31 /* grab fpa control register */
ori $at,$at,0x600 /* set O and Z bits */
ctc1 $at,$31 /* return fpa control register */
.set at
@ The MIPS calling conventions are described in gory detail in Appendix~D
of the MIPS book; pages D-18 and following.
At the moment we don't save any floating point registers.
We save (on the stack) nine general-purpose registers, the global pointer,
and the return address.
We always have to allocate at least 16 bytes for argument build,
because any C function might be varargs, and might begin by
spilling all of its registers into the argument build area (Hanson).
We allocate exactly sixteen bytes, planning to fiddle the stack if
(God forbid) we are ever asked to issue a system call with more than
16 bytes worth of arguments.
<<save caller's stuff using MIPS calling conventions>>=
#define regspace 44
#define localspace 4
#define argbuild 16
#define framesize (regspace+localspace+argbuild) /* must be multiple of 8 */
#define frameoffset (0-localspace)
subu $sp,framesize
<<give .mask and save the C registers>>
<<restore caller's stuff using MIPS calling conventions>>=
<<restore the C registers>>
addu $sp,framesize
@ We don't save floating point regs yet.
<<give .mask and save the C registers>>=
.mask 0xd0ff0000,0-localspace
sw $31,argbuild+40($sp)
sw $30,argbuild+36($sp)
sw $gp,argbuild+32($sp)
sw $23,argbuild+28($sp)
sw $22,argbuild+24($sp)
sw $21,argbuild+20($sp)
sw $20,argbuild+16($sp)
sw $19,argbuild+12($sp)
sw $18,argbuild+8($sp)
sw $17,argbuild+4($sp)
sw $16,argbuild($sp)
<<restore the C registers>>=
lw $31,argbuild+40($sp)
lw $30,argbuild+36($sp)
lw $gp,argbuild+32($sp)
lw $23,argbuild+28($sp)
lw $22,argbuild+24($sp)
lw $21,argbuild+20($sp)
lw $20,argbuild+16($sp)
lw $19,argbuild+12($sp)
lw $18,argbuild+8($sp)
lw $17,argbuild+4($sp)
lw $16,argbuild($sp)
@ There are two save areas; one for pointers and one for non-pointers.
(The pointer area may, of course, include tagged integers.)
The pointer area has special spots for standard argument, continuation,
and closure.
In addition there are special save areas for the special registers.
Register 31 is to be maintained constant relative to the program counter,
so we store the difference with [[saved_pc]].
<<save the ML registers>>=
/* needn't save $1 */
/* the big three: argument, continuation, closure */
sw $stdarg,saved_ptrs
sw $stdcont,saved_ptrs+4
sw $stdclos,saved_ptrs+8
/* All the miscellaneous guys */
sw $5,saved_ptrs+12
sw $6,saved_ptrs+16
sw $7,saved_ptrs+20
sw $8,saved_ptrs+24
sw $9,saved_ptrs+28
sw $10,saved_ptrs+32
sw $11,saved_ptrs+36
sw $12,saved_ptrs+40
sw $13,saved_ptrs+44
sw $14,saved_ptrs+48
sw $15,saved_ptrs+52
sw $16,saved_ptrs+56
sw $17,saved_ptrs+60
sw $18,saved_ptrs+64
sw $19,saved_ptrs+68
sw $21, saved_ptrs+72
sw $artemp1,saved_nonptrs
sw $artemp2,saved_nonptrs+4
sw $artemp3,saved_nonptrs+8
/* don't touch registers $26 and $27 */
sw $storeptr,saved_storeptr
sw $dataptr,saved_dataptr
sw $exnptr,saved_exnptr
<<save $[[$31]]-[[saved_pc]]$ in [[saved_pc_diff]] (destroys [[$artemp1]])>>
<<restore the ML registers>>=
/* the big three: argument, continuation, closure */
lw $stdarg,saved_ptrs
lw $stdcont,saved_ptrs+4
lw $stdclos,saved_ptrs+8
/* All the miscellaneous guys */
lw $5,saved_ptrs+12
lw $6,saved_ptrs+16
lw $7,saved_ptrs+20
lw $8,saved_ptrs+24
lw $9,saved_ptrs+28
lw $10,saved_ptrs+32
lw $11,saved_ptrs+36
lw $12,saved_ptrs+40
lw $13,saved_ptrs+44
lw $14,saved_ptrs+48
lw $15,saved_ptrs+52
lw $16,saved_ptrs+56
lw $17,saved_ptrs+60
lw $18,saved_ptrs+64
lw $19,saved_ptrs+68
lw $21, saved_ptrs+72
<<restore [[$31]] from [[saved_pc]] \& [[saved_pc_diff]] (destroys [[$artemp1]])>>
lw $artemp1,saved_nonptrs
lw $artemp2,saved_nonptrs+4
lw $artemp3,saved_nonptrs+8
/* don't touch registers $26 and $27 */
lw $storeptr,saved_storeptr
lw $dataptr,saved_dataptr
lw $exnptr,saved_exnptr
<<save $[[$31]]-[[saved_pc]]$ in [[saved_pc_diff]] (destroys [[$artemp1]])>>=
lw $artemp1,saved_pc
subu $artemp1,$31,$artemp1 /* mustn't overflow */
sw $artemp1,saved_pc_diff
<<restore [[$31]] from [[saved_pc]] \& [[saved_pc_diff]] (destroys [[$artemp1]])>>=
lw $artemp1,saved_pc
lw $31,saved_pc_diff
addu $31,$artemp1 /* mustn't overflow */
<<data segment items>>=
saved_pc_diff: .word 0
@ Because the Mips has no indexed addressing modes, there are special
circumstances under which we have to adjust the program counter before
a garbage collection.
The problem arises when we want to create an object whose size is not
known at compile time.
In order to do that, we have to add the size of the object to [[$dataptr]],
putting the result in a new register.
We then store at offset $-4$ from that register to allocate (and possibly
cause garbage collection).
That register can't be a pointer, because at the time of the gc it doesn't
point to anything sensible (in fact, by definition it points out of the
garbage-collectible region entirely).
If it is a nonpointer, though, it isn't changed by the garbage collection,
so when the collection is over, we attempt once again to store in exactly
the same place, causing another fault (unless the heap has been resized).
The solution is a hack. Since there are only two places this problem
can occur, we check [[saved_pc]] against the offending program counters.
If we find one, we reduce [[saved_pc]] by 4 (the size of one instruction),
causing the addition to be repeated.
<<if [[saved_pc]] points to a bad spot, adjust it (destroys arithmetic temps)>>=
lw $artemp1,saved_pc
<<load bad pc into [[$artemp2]]; branch to [[badpc]] if == [[$artemp1]]>>
b 1f
badpc:
subu $artemp1,4 /* adjust */
sw $artemp1,saved_pc /* save */
1:
@ [[callc(f,a)]] calls a C-language function [[f]] with argument [[a]].
We don't have to save a register unless we'll need its value later.
The closure of this routine is irrelevant, since [[callc]] doesn't
have any free variables.
Therefore the only things that have to be restored after the call to~C
are the continuation, the store pointer, the data pointer, and
the exception handler.
If we wanted [[callc]] to be more efficient, we would
rearrange things so that all those registers fell into [[s0]]--[[s8]],
where they would automatically be preserved across procedure calls.
As it stands, everything except the continuation is preserved,
so we're not doing too badly.
Miraculously, C routines return integer results in [[$2]], which is
exactly the register we need to pass to our continuation (in order to
return a value).
I decided not to rely on this, and to include a [[move]] instruction
anyway. Maybe the assembler will park it in a delay slot since it
is a nop.
<<calling C routines>>=
Closure(callc_v)
sw $stdcont,argbuild+regspace($sp) /* save continuation on stack */
lw $4,4($stdarg) /* get value a into arg register */
lw $10,0($stdarg) /* get address of f into misc reg */
jal $10 /* call f ($31 can be trashed) */
move $stdarg,$2 /* return val is argument to continuation */
lw $stdcont,argbuild+regspace($sp) /* recover continuation */
<<put zeroes in all forwardable regs that might hold garbage>>
lw $artemp3,cause /* get cause */
bne $artemp3,$0,saveregs /* if cause != 0, save ML & return to C */
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
@ A forwardable register can hold garbage unless it was saved
by C (is in [[s0]]--[[s8]]) or is [[$stdarg]] of [[$stdcont]].
<<put zeroes in all forwardable regs that might hold garbage>>=
move $stdclos,$0
move $5,$0
move $6,$0
move $7,$0
move $8,$0
move $9,$0
move $10,$0
move $11,$0
move $12,$0
move $13,$0
move $14,$0
move $15,$0
/* $16--$23 and $30 are saved by the callee */
@ This interface is going to be agony, because the rules for passing
arguments are passing strange.
The interface is [[syscall_v(callnumber,argvector,argcount)]].
The system call interface is the same as the procedure call interface,
but instead of a [[jal]] we use a [[syscall]] instruction, and
we put the system call number in register [[$2]].
It appears that, after the execution of the [[syscall]] handler,
the result is in [[$2]], and [[$7]] is zero unless an error occurred.
We will put all the arguments on the stack, then load the first four
into [[$4]]--[[$7]].
<<system calls>>=
Closure(syscall_v)
sw $stdcont,argbuild+regspace($sp) /* save continuation on stack */
lw $artemp1,8($stdarg) /* 2*argc+1 in $artemp1 */
sra $artemp1,1 /* argc in $artemp1 */
move $16,$sp /* save our $sp */
<<extend argbuild area to be big enough for all arguments>>
lw $ptrtemp,4($stdarg) /* argv in $ptrtemp */
<<put all arguments onto the stack>>
<<load first four arguments into [[$4]]--[[$7]]>>
9: lw $2,0($stdarg) /* get syscall # in $2; trash $stdarg */
sra $2,1 /* throw out the tag bit */
syscall
move $sp,$16 /* recover the good stack pointer */
lw $stdcont,argbuild+regspace($sp) /* recover continuation */
bnez $7,1f /* if error, return ~1 */
move $stdarg,$2 /* return val is argument to continuation */
add $stdarg,$stdarg /* double return value */
addi $stdarg,1 /* and add tag bit */
b 2f
1: sw $stdarg,errno
li $stdarg,-1
2:
<<put zeroes in all forwardable regs that might hold garbage>>
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
@ At this point we know that the number of arguments is in [[$artemp1]].
We have room for four arguments; if there are more
we'll have to increase the stack size by the appropriate multiple of 8
so that it stays doubleword-aligned.
<<extend argbuild area to be big enough for all arguments>>=
ble $artemp1,4,1f /* big enough */
sub $artemp2,$artemp1,3 /* (temp2 = argc - 4 + 1) > 1 */
sra $artemp2,1
sll $artemp2,3 /* temp2 = 4 * roundup (argc-4,2) */
subu $sp,$artemp2 /* increase stack */
1:
@ Now we have a list of arguments pointed to by [[$ptrtemp]].
We have the count of the arguments in [[$artemp1]].
We have to put them on the stack.
We have to remove tag bits where appropriate.
<<put all arguments onto the stack>>=
move $artemp2,$sp /* destination in $artemp2 */
b 1f /* branch forward to test */
2: /* argc > 0 */
lw $artemp3,0($ptrtemp) /* get list element */
andi $10,$artemp3,1 /* tagged? */
beqz $10,3f
sra $artemp3,1 /* drop tag bit */
3: sw $artemp3,0($artemp2) /* save the argument */
lw $ptrtemp,4($ptrtemp) /* next element */
add $artemp2,4 /* next arg build area */
sub $artemp1,1 /* --argc */
1: bgtz $artemp1,2b /* if argc>0, store another */
@ It doesn't matter if we load arguments that aren't there; the
system call will just ignore them.
<<load first four arguments into [[$4]]--[[$7]]>>=
lw $4,0($sp)
lw $5,4($sp)
lw $6,8($sp)
lw $7,12($sp)
@ \subsection{Floating point}
We store floating point constants in two words, with the least significant
word first.
We use the 64 bit IEEE format.
We begin with instructions to change the rounding modes.
See the MIPS book, pages 6-5--6-7.
<<tell the floating point unit to round toward $-\infty$>>=
.set noat
cfc1 $at,$31 /* grab fpa control register */
ori $at,0x03 /* set rounding bits to 11 */
ctc1 $at,$31 /* return fpa control register */
.set at
<<tell the floating point unit to round to nearest>>=
.set noat
cfc1 $at,$31 /* grab fpa control register */
ori $at,0x03 /* set rounding bits to 11 */
xori $at,0x03 /* set rounding bits to 00
ctc1 $at,$31 /* return fpa control register */
.set at
@ These floating point functions are used int floating to integer conversion.
<<floating point>>=
/* Floating exceptions raised (assuming ROP's are never passed to functions):
* DIVIDE BY ZERO - (div)
* OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate
*
* floor raises integer overflow if the float is out of 32-bit range,
* so the float is tested before conversion, to make sure it is in (31-bit)
* range */
@ [[floor(x)]] returns the smallest integer less than or equal to [[x]].
<<floating point>>=
Closure(floor_v)
lwc1 $f4,0($stdarg) /* get least significant word */
lwc1 $f5,4($stdarg) /* get most significant word */
<<tell the floating point unit to round toward $-\infty$>>
cvt.w.d $f6,$f4 /* convert to integer */
<<tell the floating point unit to round to nearest>>
mfc1 $stdarg,$f6 /* get in std argument register */
sll $stdarg,1 /* make room for tag bit */
add $stdarg,1 /* add the tag bit */
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
@ [[logb(x)]] returns the exponent part of the floating point [[x]].
We grab the 11-bit exponent from the word, then unbias it (according
to the IEEE standard) by subtracting 1023.
<<floating point>>=
Closure(logb_v)
lw $stdarg,4($stdarg) /* most significant part */
srl $stdarg,20 /* throw out 20 low bits */
andi $stdarg,0x07ff /* clear all but 11 low bits */
sub $stdarg,1023 /* subtract 1023 */
sll $stdarg,1 /* make room for tag bit */
add $stdarg,1 /* add the tag bit */
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
@ [[scalb(x,n)]] adds [[n]] to the exponent of floating
point [[x]].
Since we don't want the resulting float to be anything
special, we insist that the unbiased exponent of the result
satisfy $-1022 \le E \le 1023$, i.e.\ that the biased exponent satisfy
$1 \le e \le 2046$.
<<floating point>>=
Closure(scalb_v)
lw $artemp1,4($stdarg) /* get tagged n */
sra $artemp1,1 /* get real n */
beqz $artemp1,9f /* if zero, return the old float */
lw $ptrtemp,0($stdarg) /* get pointer to float */
lw $artemp2,4($ptrtemp) /* most significant part */
srl $artemp2,20 /* throw out 20 low bits */
andi $artemp2,0x07ff /* clear all but 11 low bits */
add $artemp3,$artemp2,$artemp1 /* new := old + n */
blt $artemp3,1,under /* punt if underflow */
bgt $artemp3,2046,over /* or overflow */
<<allocate and store new floating point constant and set [[$stdarg]]>>
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
9: lw $stdarg,0($stdarg) /* get old float */
lw $10,0($stdcont) /* grab continuation */
j $10 /* return */
over: la $stdarg,1f /* exception name in $stdarg */
b raise_real
String(1,8,"overflow")
under: la $stdarg,1f /* exception name in $stdarg */
b raise_real
String(1,9,"underflow\0\0\0")
raise_real:
/* build new record to pass to exception handler */
/* [descriptor]
/* [exception (string)]
/* [real_e (more exception info)]
*/
la $10,real_e /* get address of real_e */
.set noreorder
sw $10,8($dataptr) /* allocate; may cause gc */
.set reorder
sw $stdarg,4($dataptr)
li $10,mak_desc(2,tag_record)
sw $10,0($dataptr)
add $stdarg,$dataptr,4 /* new record is argument */
addi $dataptr,12 /* $dataptr restored */
move $stdclos,$exnptr /* make sure closure is right */
lw $10,0($exnptr) /* grab handler */
j $10 /* raise the exception */
@ Here we indulge in a little cleverness to save a couple of instructions.
Since the old value is in [[$artemp2]] and the new in [[$artemp3]],
we can [[xor]] them, then store the new one with a second [[xor]].
<<allocate and store new floating point constant and set [[$stdarg]]>>=
xor $artemp3,$artemp2 /* at3 = new xor old */
sll $artemp3,20 /* put exponent in right position */
lw $artemp2,4($ptrtemp) /* most significant word */
xor $artemp2,$artemp3 /* change to new exponent */
.set noreorder
sw $artemp2,8($dataptr) /* allocate; may cause gc */
.set reorder
lw $artemp2,0($ptrtemp) /* get least significant word */
li $10,mak_desc(8,tag_string) /* make descriptor */
sw $artemp2,4($dataptr) /* save lsw */
sw $10,0($dataptr) /* save descriptor */
add $stdarg,$dataptr,4 /* get pointer to new float */
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.