/* ALPHA32.prim.asm
*
* ALPHA32 runtime code for ML.
*
* ML register usage follows:
*
* register C callee ML use
* save?
* -------- --------- -------
* $0 no standard arg
* $1 no standard continuation
* $2 no standard closure
* $3 no standard link register
* $4 no base address register
* $5-$8 no miscellaneous registers
* $9 yes heap limit pointer
* $10 yes var pointer
* $11 yes heap-limit comparison flag, and arith temporary
* $12 yes store list pointer
* $13 yes allocation pointer
* $14 yes exception continuation
* $15 yes miscellaneous register
* $16-$25 no miscellaneous registers
* $26 no ml-pc
* $27 no miscellaneous register
* $28 no assembler temporary
* $29 - reserved for C (global pointer)
* $30 - reserved for C (stack pointer)
* $31 - constant zero
*/
#include <regdef.h>
#include "ml-base.h"
#include "asm-base.h"
#include "ml-values.h"
#include "tags.h"
#include "ml-request.h"
#include "ml-limits.h"
#include "mlstate-offsets.h" /** this file is generated **/
#define STDARG $0 /* standard arg (ml_arg) */
#define STDCONT $1 /* standard continuation (ml_cont) */
#define STDCLOS $2 /* standard closure (ml_closure) */
#define STDLINK $3 /* ptr to just-entered std function (ml_link) */
#define MISCREG0 $5
#define MISCREG1 $6
#define MISCREG2 $7
#define LIMITPTR $9 /* end of heap - 4096 (ml_limitptr) */
#define VARPTR $10 /* per-thread var pointer (ml_varptr) */
#define NEEDGC $11 /* arith temp; also, heap-limit comparison flag */
#define STOREPTR $12 /* store pointer (ml_storeptr) */
#define ALLOCPTR $13 /* freespace pointer (ml_allocptr) */
#define EXNCONT $14 /* exception handler (ml_exncont) */
#define PC $26 /* address to return/goto in ML */
/* assembler-temp $28 */
/* globalptr $29 reserved for C and assembler */
/* stackptr $30 stack pointer */
/* zero $31 zero */
#define CRESULT $0
#define CARG0 $16
#define ATMP1 $20
#define ATMP2 $21
#define ATMP3 $22
#define ATMP4 $23
#define PTRTMP $24
/* The ML stack frame has the following layout (set up by restoreregs):
* +-------------------+
* sp+124 | ml_divlu |
* +-------------------+
* sp+120 | ml_divlv |
* +-------------------+
* sp+116 | pseudo reg 2 |
* +-------------------+
* sp+112 | pseudo reg 1 |
* +-------------------+
* sp+104: | temporary storage | temporary use by floating
* +-------------------+ point code.
* sp+96: | temporary storage |
* +-------------------+
* sp+88: | saved $30 |
* +-------------------+
* sp+80: | saved $29 |
* +-------------------+
* sp+72: | saved $26 |
* +-------------------+
* sp+64: | saved $15 |
* +-------------------+
* sp+56: | saved $14 |
* +-------------------+
* sp+48: | saved $13 |
* +-------------------+
* sp+40: | saved $12 |
* +-------------------+
* sp+32: | saved $11 |
* +-------------------+
* sp+24: | saved $10 |
* +-------------------+
* sp+16: | saved $9 |
* +-------------------+
* sp+8: | addr of saveregs |
* +-------------------+
* sp: | ptr to MLState |
* +-------------------+
*/
#define ML_FRAMESIZE 4096
#define MLSTATE_OFFSET 0
#define STARTGC_OFFSET 8
#define REGSAVE_OFFSET 16
#define PSEUDOREG_OFFSET 112
#define ML_DIVLV_OFFSET 120
#define ML_DIVLU_OFFSET 124
#ifdef ALLIGN_ALLOCATION
# define ALLOCALIGN \
addl ALLOCPTR,4,ALLOCPTR; \
bic ALLOCPTR,4,ALLOCPTR;
#else
# define ALLOCALIGN
#endif
#define CONTINUE \
ALLOCALIGN \
cmplt LIMITPTR,ALLOCPTR,NEEDGC; \
jmp (STDCONT);
#define CHECKLIMIT \
mov STDLINK, PC; \
beq NEEDGC,3f; \
br saveregs; \
3:
DATA
.align 3
one_half: .t_floating 0.5
fsr_bits: .quad 0x8a70000000000000
TEXT
/* sigh_return_a:
* The return continuation for the ML signal handler.
*/
ML_CODE_HDR(sigh_return_a)
mov REQ_SIG_RETURN,ATMP1
mov ML_unit, STDLINK
mov ML_unit, STDCLOS
mov ML_unit, PC
br set_request
/* sigh_resume:
* Resume execution at the point at which a handler trap occurred. This is a
* standard two-argument function, thus the closure is in ml_cont (%stdcont).
*/
ENTRY(sigh_resume)
mov REQ_SIG_RESUME,ATMP1
br set_request
/* pollh_return_a
* The return continuation for the ML poll handler.
*/
ML_CODE_HDR(pollh_return_a)
mov REQ_POLL_RESUME,ATMP1
mov ML_unit, STDLINK
mov ML_unit, STDCLOS
mov ML_unit, PC
br set_request
/* pollh_resume:
* Resume execution at the point at which a poll event occurred.
*/
ENTRY(pollh_resume)
mov REQ_POLL_RETURN,ATMP1
br set_request
ML_CODE_HDR(handle_a)
mov REQ_EXN,ATMP1
mov STDLINK, PC
br set_request
ML_CODE_HDR(return_a)
mov REQ_RETURN,ATMP1
mov ML_unit, STDLINK
mov ML_unit, STDCLOS
mov ML_unit, PC
br set_request
ENTRY(request_fault)
mov REQ_FAULT,ATMP1
mov STDLINK, PC
br set_request
/* bind_cfun : (string * string) -> c_function
*/
ML_CODE_HDR(bind_cfun_a)
CHECKLIMIT
mov REQ_BIND_CFUN,ATMP1
br set_request
ML_CODE_HDR(build_literals_a)
CHECKLIMIT
mov REQ_BUILD_LITERALS,ATMP1
br set_request
ML_CODE_HDR(callc_a)
CHECKLIMIT
mov REQ_CALLC,ATMP1
br set_request
BEGIN_PROC(saveregs)
ENTRY(saveregs)
mov REQ_GC,ATMP1
/* fall through */
set_request:
ldq PTRTMP,MLSTATE_OFFSET(sp) /* get the ML state ptr */
ldq NEEDGC,VProcOffMSP(PTRTMP) /* use NEEDGC for VProcPtr */
stl zero,InMLOffVSP(NEEDGC) /* note that we have left ML */
stl ALLOCPTR,AllocPtrOffMSP(PTRTMP)
stl LIMITPTR,LimitPtrOffMSP(PTRTMP)
stl STOREPTR,StorePtrOffMSP(PTRTMP)
stl STDLINK,LinkRegOffMSP(PTRTMP)
stl PC,PCOffMSP(PTRTMP)
stl STDARG,StdArgOffMSP(PTRTMP)
stl STDCLOS,StdClosOffMSP(PTRTMP)
stl STDCONT,StdContOffMSP(PTRTMP)
stl VARPTR,VarPtrOffMSP(PTRTMP)
stl EXNCONT,ExnPtrOffMSP(PTRTMP)
mov ATMP1,CRESULT /* return request */
stl MISCREG0,Misc0OffMSP(PTRTMP)
stl MISCREG1,Misc1OffMSP(PTRTMP)
stl MISCREG2,Misc2OffMSP(PTRTMP)
/* fall through */
.end saveregs
/* restore callee-save C registers */
restore_c_regs:
ldq $30,REGSAVE_OFFSET+72(sp)
ldq $29,REGSAVE_OFFSET+64(sp)
ldq $26,REGSAVE_OFFSET+56(sp)
ldq $15,REGSAVE_OFFSET+48(sp)
ldq $14,REGSAVE_OFFSET+40(sp)
ldq $13,REGSAVE_OFFSET+32(sp)
ldq $12,REGSAVE_OFFSET+24(sp)
ldq $11,REGSAVE_OFFSET+16(sp)
ldq $10,REGSAVE_OFFSET+8(sp)
ldq $9 ,REGSAVE_OFFSET(sp)
addq sp,ML_FRAMESIZE /* discard the stack frame */
jmp ($26) /* return to run_ml() */
BEGIN_PROC(restoreregs)
ENTRY(restoreregs)
subq sp,ML_FRAMESIZE /* allocate a stack frame */
.frame sp,ML_FRAMESIZE,zero
.mask 0xe000fe00,0
/* save the C registers */
lda $3,saveregs
stq CARG0,MLSTATE_OFFSET(sp) /* save MLState ptr for return to C */
stq $3,STARTGC_OFFSET(sp) /* so ML can find saveregs! */
lda $3,ml_divlv /* address of ml_divlv */
stl $3,ML_DIVLV_OFFSET(sp)
lda $3,ml_divlu /* address of ml_divlu */
stl $3,ML_DIVLU_OFFSET(sp)
stq $30,REGSAVE_OFFSET+72(sp)
stq $29,REGSAVE_OFFSET+64(sp)
stq $26,REGSAVE_OFFSET+56(sp)
stq $15,REGSAVE_OFFSET+48(sp)
stq $14,REGSAVE_OFFSET+40(sp)
stq $13,REGSAVE_OFFSET+32(sp)
stq $12,REGSAVE_OFFSET+24(sp)
stq $11,REGSAVE_OFFSET+16(sp)
stq $10,REGSAVE_OFFSET+8(sp)
stq $9,REGSAVE_OFFSET(sp)
mov CARG0,PTRTMP /* put MLState ptr in ptrtmp */
ldl ALLOCPTR,AllocPtrOffMSP(PTRTMP)
ldl LIMITPTR,LimitPtrOffMSP(PTRTMP)
ldl STOREPTR,StorePtrOffMSP(PTRTMP)
ldl NEEDGC,VProcOffMSP(PTRTMP) /* use NEEDGC for VProc Ptr */
mov 1,ATMP1
.set noreorder /* the order here is important */
stl ATMP1,InMLOffVSP(NEEDGC) /* note that we are entering ML code */
ldl STDARG,StdArgOffMSP(PTRTMP)
ldl STDCONT,StdContOffMSP(PTRTMP)
ldl STDCLOS,StdClosOffMSP(PTRTMP)
ldl EXNCONT,ExnPtrOffMSP(PTRTMP)
ldl MISCREG0,Misc0OffMSP(PTRTMP)
ldl MISCREG1,Misc1OffMSP(PTRTMP)
ldl MISCREG2,Misc2OffMSP(PTRTMP)
ldl STDLINK,LinkRegOffMSP(PTRTMP)
ldl PC,PCOffMSP(PTRTMP)
ldl VARPTR,VarPtrOffMSP(PTRTMP)
/* check for pending signals */
ldl PTRTMP,NPendingSysOffVSP(NEEDGC)
.set noat
ldl $28,SigsRecvOffVSP(NEEDGC)
ldl PTRTMP,SigsHandledOffVSP(NEEDGC)
cmpeq $28,PTRTMP,PTRTMP
.set at
bne PTRTMP,pending_sigs
.end restoreregs
.ent ml_go
ENTRY(ml_go)
ALLOCALIGN
cmplt LIMITPTR,ALLOCPTR,NEEDGC
jmp (PC) /* jump/return to ML code */
.end ml_go
pending_sigs: /* there are pending signals */
/* check if we are currently handling a signal */
ldl PTRTMP,InSigHandlerOffVSP(NEEDGC)
bne PTRTMP,ml_go
/* note that a handler trap is pending */
mov 1,PTRTMP
stl PTRTMP,HandlerPendingOffVSP(NEEDGC)
mov ALLOCPTR,LIMITPTR
br ml_go
.set reorder
/* SaveFPRegs:
*
* void SaveFPRegs (Word_t *p)
*
* Save the C callee-save FP registers starting at the given address.
*/
TEXT
BEGIN_PROC(SaveFPRegs)
ENTRY(SaveFPRegs)
stt $f2,0(a0)
stt $f3,8(a0)
stt $f4,16(a0)
stt $f5,24(a0)
stt $f6,32(a0)
stt $f7,40(a0)
stt $f8,48(a0)
stt $f9,56(a0)
jmp (ra) /* return */
END_PROC(SaveFPRegs)
/* RestoreFPRegs:
*
* void RestoreFPRegs (Word_t *p)
*
* Restore the C callee-save FP registers from the given address.
*/
BEGIN_PROC(RestoreFPRegs)
ENTRY(RestoreFPRegs) /* floats address passed as parm */
ldt $f2,0(a0) /* retrieve float registers */
ldt $f3,8(a0)
ldt $f4,16(a0)
ldt $f5,24(a0)
ldt $f6,32(a0)
ldt $f7,40(a0)
ldt $f8,48(a0)
ldt $f9,56(a0)
jmp (ra)
END_PROC(RestoreFPRegs)
/** Primitive object allocation routines **/
/* array : (int * 'a) -> 'a array
* Allocate and initialize a new array. This can cause GC.
*/
ML_CODE_HDR(array_a)
CHECKLIMIT
ldl ATMP1,0(STDARG) /* tmp1 := length in words */
sra ATMP1,1,ATMP2 /* tmp2 := length (untagged) */
subl ATMP2,SMALL_OBJ_SZW,ATMP3 /* is this a small object? */
bgt ATMP3,2f /* branch if large object */
ldl STDARG,4(STDARG) /* initial value */
sll ATMP2,TAG_SHIFTW,ATMP3 /* build descriptor in tmp3 */
or ATMP3,MAKE_TAG(DTAG_arr_data),ATMP3
stl ATMP3,0(ALLOCPTR) /* store descriptor */
addq ALLOCPTR,4 /* allocptr++ */
mov ALLOCPTR,ATMP3 /* array data ptr in tmp3 */
1:
stl STDARG,0(ALLOCPTR) /* initialize array */
subl ATMP2, 1, ATMP2
addq ALLOCPTR,4
bne ATMP2,1b
/* allocate array header */
mov DESC_polyarr,ATMP2 /* descriptor in tmp2 */
stl ATMP2,0(ALLOCPTR) /* store descriptor */
addq ALLOCPTR, 4 /* allocptr++ */
mov ALLOCPTR,STDARG /* result = header addr */
stl ATMP3, 0(ALLOCPTR) /* store pointer to data */
stl ATMP1, 4(ALLOCPTR)
addq ALLOCPTR,8
CONTINUE
2: /* off-line allocation of big arrays */
mov REQ_ALLOC_ARRAY,ATMP1
mov STDLINK, PC
br set_request
/* create_r : int -> realarray
* Create a new realarray.
*/
ML_CODE_HDR(create_r_a)
CHECKLIMIT
sra STDARG,1,ATMP2 /* atmp2 = length (untagged int) */
sll ATMP2,1,ATMP2 /* atmp2 = length in words */
subl ATMP2,SMALL_OBJ_SZW,ATMP3
bgt ATMP3,1f /* is this a small object? */
/* allocate the data object */
sll ATMP2,TAG_SHIFTW,ATMP1 /* build data descriptor in tmp1 */
or ATMP1, MAKE_TAG(DTAG_raw64),ATMP1
#ifdef ALIGN_REALDS
or ALLOCPTR,4,ALLOCPTR /* tag is unaligned, so that the */
/* first element is 8-byte aligned */
#endif
stl ATMP1,0(ALLOCPTR) /* store the descriptor */
addq ALLOCPTR,4 /* allocptr++ */
mov ALLOCPTR,ATMP3 /* tmp3 = data object */
sll ATMP2, 2, ATMP2 /* tmp2 = length in bytes */
addq ALLOCPTR, ATMP2,ALLOCPTR /* allocptr += length */
/* allocate the header object */
mov DESC_real64arr,ATMP1
stl ATMP1,0(ALLOCPTR) /* header descriptor */
addq ALLOCPTR,4 /* allocptr++ */
stl ATMP3,0(ALLOCPTR) /* header data field */
stl STDARG,4(ALLOCPTR) /* header length field */
mov ALLOCPTR,STDARG /* stdarg = header object */
addq ALLOCPTR,8
CONTINUE
1: /* off-line allocation of big realarrays */
mov REQ_ALLOC_REALDARRAY,ATMP1
mov STDLINK, PC
br set_request
/* create_b : int -> bytearray
* Create a bytearray of the given length.
*/
ML_CODE_HDR(create_b_a)
CHECKLIMIT
sra STDARG,1,ATMP2 /* atmp2 = length (untagged int) */
addq ATMP2,3,ATMP2 /* atmp2 = length in words */
sra ATMP2,2
subq ATMP2,SMALL_OBJ_SZW,ATMP3 /* is this a small object? */
bgt ATMP3,1f
/* allocate the data object */
sll ATMP2,TAG_SHIFTW,ATMP1 /* build descriptor in atmp1 */
or ATMP1,MAKE_TAG(DTAG_raw32),ATMP1
stl ATMP1,0(ALLOCPTR) /* store the data descriptor */
addq ALLOCPTR,4 /* allocptr++ */
mov ALLOCPTR,ATMP3 /* tmp3 = data object */
sll ATMP2,2 /* tmp2 = length in bytes */
addq ALLOCPTR,ATMP2,ALLOCPTR /* allocptr += total length */
/* allocate the header object */
mov DESC_word8arr,ATMP1 /* header descriptor */
stl ATMP1,0(ALLOCPTR)
addq ALLOCPTR,4 /* allocptr++ */
stl ATMP3,0(ALLOCPTR) /* header data field */
stl STDARG,4(ALLOCPTR) /* header length field */
mov ALLOCPTR,STDARG /* stdarg = header object */
addq ALLOCPTR,8 /* allocptr += 2 */
CONTINUE
1: /* off-line allocation of big bytearrays */
mov REQ_ALLOC_BYTEARRAY,ATMP1
mov STDLINK, PC
br set_request
/* create_s : int -> string
* Create a string of the given length (assume length >0).
*/
ML_CODE_HDR(create_s_a)
CHECKLIMIT
sra STDARG,1,ATMP2 /* tmp2 = length (untagged int) */
addq ATMP2,4,ATMP2 /* atmp2 = length in words */
sra ATMP2,2
subq ATMP2,SMALL_OBJ_SZW,ATMP3
bgt ATMP3,1f /* is this a small object? */
sll ATMP2,TAG_SHIFTW,ATMP1 /* build descriptor in atmp3 */
or ATMP1,MAKE_TAG(DTAG_raw32),ATMP1
stl ATMP1,0(ALLOCPTR) /* store the data descriptor */
addq ALLOCPTR,4 /* allocptr++ */
mov ALLOCPTR,ATMP3 /* tmp3 = data object */
sll ATMP2,2 /* tmp2 = length in bytes */
addq ALLOCPTR,ATMP2,ALLOCPTR /* allocptr += total length */
stl zero,-4(ALLOCPTR) /* store zero in last word */
/* Allocate the header object */
mov DESC_string, ATMP1 /* header descriptor */
stl ATMP1,0(ALLOCPTR)
addq ALLOCPTR,4 /* allocptr++ */
stl ATMP3,0(ALLOCPTR) /* header data field */
stl STDARG,4(ALLOCPTR) /* heder length field */
mov ALLOCPTR,STDARG /* stdarg = header object */
addq ALLOCPTR,8
CONTINUE
1: /* off-line allocation of big strings */
mov REQ_ALLOC_STRING,ATMP1
mov STDLINK, PC
br set_request
/* create_v_a : (int * 'a list) -> 'a vector
* Create a vector with elements taken from a list.
* NOTE: the front-end ensures that list cannot be nil.
*/
ML_CODE_HDR(create_v_a)
CHECKLIMIT
ldl ATMP1,0(STDARG) /* tmp1 := length (tagged int) */
sra ATMP1,1,ATMP2 /* tmp2 := length (untagged) */
subq ATMP2,SMALL_OBJ_SZW,ATMP3
bgt ATMP3,1f /* is this a small object? */
sll ATMP2,TAG_SHIFTW,ATMP2 /* build descriptor in tmp2 */
or ATMP2,MAKE_TAG(DTAG_vec_data),ATMP2
stl ATMP2,0(ALLOCPTR) /* store descriptor */
addq ALLOCPTR,4 /* allocptr++ */
ldl ATMP2,4(STDARG) /* atmp2 := list */
mov ALLOCPTR,STDARG /* stdarg := vector */
2: /* loop: */
ldl ATMP3,0(ATMP2) /* tmp3 := hd(tmp2) */
ldl ATMP2,4(ATMP2) /* tmp2 := tl(tmp2) */
stl ATMP3,0(ALLOCPTR) /* store word in vector */
addq ALLOCPTR,4 /* allocptr++ */
cmpeq ATMP2,ML_nil,ATMP3 /* tmp3 := 1 if tmp2=ML_nil */
beq ATMP3, 2b
/* allocate header object */
mov DESC_polyvec,ATMP3 /* descriptor in tmp3 */
stl ATMP3,0(ALLOCPTR) /* store descriptor */
addq ALLOCPTR,4 /* allocptr++ */
stl STDARG,0(ALLOCPTR) /* header data field */
stl ATMP1,4(ALLOCPTR) /* header length */
mov ALLOCPTR, STDARG /* result = header object */
addq ALLOCPTR, 8 /* allocptr += 2 */
CONTINUE
1: /* off-line allocation for large vectors */
mov REQ_ALLOC_VECTOR,ATMP1
mov STDLINK, PC
br set_request
/* 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,
* Does not check for out-of-range ; it's up to the ML code to do that first. */
#ifdef NEW_FLOOR
DATA
.align 3
floor_MAXFLOAT: .quad 0x4330080000000000
.text
ML_CODE_HDR(floor_a)
/* check for overflow */
ldgp gp, 0(STDLINK)
ldt $f0, 0(STDARG)
subq $30, 16, $30 /* allocate stack space */
/* Do floor; neat thing is that this works
** for both +ve and -ve floating point numbers!
*/
ldt $f1, floor_MAXFLOAT
addtm $f0, $f1, $f1
stt $f1, 0($30)
ldl ATMP1, 0($30)
addl ATMP1, ATMP1, ATMP1
addl ATMP1, 1, STDARG
addq $30, 16, $30
CONTINUE
#else /* !NEW_FLOOR */
DATA
.align 3
floor_HALF: .t_floating 0.5
.text
ML_CODE_HDR(floor_a)
ldgp gp, 0(STDLINK)
ldt $f0, 0(STDARG) /* get argument */
subq $30, 16, $30 /* allocate stack space */
fblt $f0, floor_negative_arg
floor_positive_arg:
cvttqc $f0, $f1
stt $f1, 0($30)
ldl ATMP1, 0($30)
addl ATMP1, ATMP1, ATMP1
addl ATMP1, 1, STDARG
addq $30, 16, $30
CONTINUE
floor_negative_arg:
/* cvttqm (x) = cvttq (2*x - 0.5) / 2 */
/* cvttq (x-0.5) loses for odd integers which IEEE round to evens */
ldt $f1, floor_HALF
addt $f0, $f0, $f0
subt $f0, $f1, $f0
cvttq $f0, $f0
stt $f0, 0($30)
ldl STDARG, 0($30)
/* STDARG now holds either 2*floor(x) or 2*floor(x)+1. */
/* convert to ml int by setting least bit! */
bis STDARG, 1, STDARG
addq $30, 16, $30
CONTINUE
#endif
ML_CODE_HDR(logb_a)
ldq STDARG,(STDARG) /* get argument */
srl STDARG,52 /* throw out 52 low bits */
and STDARG,0x07ff /* clear all but 11 low bits */
subq STDARG,1023 /* subtract 1023 */
sll STDARG,1 /* make room for tag bit */
addq STDARG,1 /* add the tag bit */
CONTINUE
ML_CODE_HDR(scalb_a)
CHECKLIMIT
ldl PTRTMP,0(STDARG) /* address of float */
ldq ATMP2,0(PTRTMP) /* get float */
ldl ATMP1,4(STDARG) /* get tagged n */
sra ATMP1,1,ATMP1 /* real n */
beq ATMP1,9f /* branch if n=0 */
sra ATMP2,52,ATMP3 /* shift out fraction of float */
and ATMP3,0xfff,ATMP3 /* just exponent of float */
addq ATMP3,ATMP1,ATMP3 /* n + exponent */
ble ATMP3,6f /* branch if underflow */
sll ATMP1,52,ATMP1 /* n in exponent position */
addqv ATMP2,ATMP1,ATMP1 /* add n to exponent, with overflow */
3: /* return float in atmp1 */
or ALLOCPTR,4,ALLOCPTR /* unalign allocptr to align float */
mov DESC_reald,ATMP2 /* get desc */
stl ATMP2,0(ALLOCPTR) /* store desc */
stq ATMP1,4(ALLOCPTR) /* store float */
addq ALLOCPTR,4,STDARG /* return boxed float */
addq ALLOCPTR,12,ALLOCPTR /* set allocptr */
CONTINUE
6: /* underflow -- return zero */
mov 0,ATMP1
br 3b
9: /* n=0 -- return original float */
mov PTRTMP,STDARG
CONTINUE
/* ml_divlv
* Incoming parameters in $16 and $17, result in $0
*/
ENTRY(ml_divlv) /* divide longword */
beq $17, divZero /* check for div-by-zero */
ornot $31, $17, $0 /* is divisor -1 */
bne $0, do_ml_divl /* NO */
sublv $31, $16, $0 /* is dividend largest negative int */
trapb /* YES */
do_ml_divl:
divl $16, $17, $0 /* do divl */
ret $31, ($26), 1
/* ml_divlu
* Incoming parameters in $16 and $17, result in $0
*/
ENTRY(ml_divlu) /* divide longwork unsigned */
beq $17, divZero /* check for div-by-zero */
divlu $16, $17, $0 /* do divlu */
ret $31, ($26), 1
divZero:
lda $16, -2($31) /* generate div-by-zero */
call_pal 0xaa /* gentrap */
/* try_lock : spin_lock -> bool
* low-level test-and-set style primitive for mutual-exclusion among
* processors.
*/
ML_CODE_HDR(try_lock_a)
#if (MAX_PROCS > 1)
???
#else (MAX_PROCS == 1)
ldl ATMP1,0(STDARG)
mov ML_false,ATMP2
stl ATMP2,0(STDARG)
mov ATMP1,STDARG
CONTINUE
#endif
/* unlock : releases a spin lock
*/
ML_CODE_HDR(unlock_a)
#if (MAX_PROCS > 1)
???
#else (MAX_PROCS == 1)
mov ML_true,ATMP1
stl ATMP1,0(STDARG)
mov ML_unit,STDARG
CONTINUE
#endif
/* SetFSR:
* Turn on floating-point overflow, underflow and zero-divide exceptions.
*/
BEGIN_PROC(SetFSR)
ENTRY(SetFSR)
trapb /* trap barrier just in case */
ldt $f1,fsr_bits /* normal rounding,iov,ovf,dze,inv */
mt_fpcr $f1 /* set floating point control reg */
jmp ($26)
END_PROC(SetFSR)
/* FlushICache:
* C callable instruction cache flush function
*/
BEGIN_PROC(FlushICache)
ENTRY(FlushICache)
.frame $30,0,$26,0
.prologue 0
call_pal 0x86 /* imb */
ret $31,($26),1
END_PROC(FlushICache)
syntax highlighted by Code2HTML, v. 0.9.1