-
-fpemulate(hfsreg,acc_most,acc_least,dbl,op_most,op_least,opcode,pc,psl)
-{
-/*
- * Emulate the F.P. 'opcode'. Update psl flags as necessary.
- * If all OK, set 'opcode' to 0, else to the F.P. exception #.
- * Not all parameter longwords are relevant - depends on opcode.
- *
- * The entry mask is set so ALL registers are saved - courtesy of
- * locore.s. This enables F.P. opcodes to change 'user' registers
- * before return.
- */
-
- /* WARNING!!!! THIS CODE MUST NOT PRODUCE ANY FLOATING POINT EXCEPTIONS. */
-
- /* Next 2 dummy variables MUST BE the first local */
- /* variables; leaving place for registers 0 and 1 */
- /* which are not preserved by the 'cct' */
-
- int dumm1; /* register 1 */
- int dumm0; /* register 0 */
- register dumm3; /* register 12 is the 1'st register variable */
- /* in TAHOE (register 11 in VAX) */
-
- register int *locr0 = ((int *)&psl)-PS; /* R11 */
- int hfs = 0; /* returned data about exceptions */
- float (*f_proc)(); /* fp procedure to be called. */
- double (*d_proc)(); /* fp procedure to be called. */
- int dest_type; /* float or double. */
- union{
- float ff; /* float result. */
- int fi;
- }f_res;
- union{
- double dd; /* double result. */
- int di[2] ;
- }d_res;
- extern float Kcvtlf(), Kaddf(), Ksubf(), Kmulf(), Kdivf();
- extern double Kcvtld(), Kaddd(), Ksubd(), Kmuld(), Kdivd();
- extern float Ksinf(), Kcosf(), Katanf(), Klogf(), Ksqrtf(), Kexpf();
-
-
-
- switch(opcode & 0x0FF){
-
- case CVLF: f_proc = Kcvtlf; dest_type = FLOAT;
- locr0[PS] &= ~PSL_DBL;break; /* clear double bit */
- case CVLD: d_proc = Kcvtld; dest_type = DOUBLE;
- locr0[PS] |= PSL_DBL; break; /* turn on double bit */
- case ADDF: f_proc = Kaddf; dest_type = FLOAT;
- break;
- case ADDD: d_proc = Kaddd; dest_type = DOUBLE;
- break;
- case SUBF: f_proc = Ksubf; dest_type = FLOAT;
- break;
- case SUBD: d_proc = Ksubd; dest_type = DOUBLE;
- break;
- case MULF: f_proc = Kmulf; dest_type = FLOAT;
- break;
- case MULD: d_proc = Kmuld; dest_type = DOUBLE;
- break;
- case DIVF: f_proc = Kdivf; dest_type = FLOAT;
- break;
- case DIVD: d_proc = Kdivd; dest_type = DOUBLE;
- break;
- case SINF: f_proc = Ksinf; dest_type = FLOAT;
- break;
- case COSF: f_proc = Kcosf; dest_type = FLOAT;
- break;
- case ATANF: f_proc = Katanf; dest_type = FLOAT;
- break;
- case LOGF: f_proc = Klogf; dest_type = FLOAT;
- break;
- case SQRTF: f_proc = Ksqrtf; dest_type = FLOAT;
- break;
- case EXPF: f_proc = Kexpf; dest_type = FLOAT;
- break;
- }
-
- switch(dest_type){
-
- case FLOAT:
- f_res.ff = (*f_proc)(acc_most,acc_least,op_most,op_least,&hfs);
-
- if (f_res.fi == 0 ) locr0[PS] |= PSL_Z;
- if (f_res.fi < 0 ) locr0[PS] |= PSL_N;
- break;
- case DOUBLE:
- d_res.dd = (*d_proc)(acc_most,acc_least,op_most,op_least,&hfs);
- if ((d_res.di[0] == 0) && (d_res.di[1] == 0))
- locr0[PS] |= PSL_Z;
- if (d_res.di[0] < 0 ) locr0[PS] |= PSL_N;
- break;
- }
-
- if (hfs & HFS_OVF){
- locr0[PS] |= PSL_V; /* turn on overflow bit */
- /* if (locr0[PS] & PSL_IV) { /* overflow elabled? */
- opcode = OVF_EXC;
- u.u_error = (hfs & HFS_DOM) ? EDOM : ERANGE;
- return;
- /*}*/
- }
- else if (hfs & HFS_UNDF){
- if (locr0[PS] & PSL_FU){ /* underflow elabled? */
- opcode = UNDF_EXC;
- u.u_error = (hfs & HFS_DOM) ? EDOM : ERANGE;
- return;
- }
- }
- else if (hfs & HFS_DIVZ){
- opcode = DIV0_EXC;
- return;
- }
- else if (hfs & HFS_DOM)
- u.u_error = EDOM;
- else if (hfs & HFS_RANGE)
- u.u_error = ERANGE;
-
- switch(dest_type){
- case FLOAT:
- if ((hfs & HFS_OVF) || (hfs & HFS_UNDF)) {
- f_res.ff = 0.0;
- locr0[PS] |= PSL_Z;
- }
- mvtofacc(f_res.ff, &acc_most);
- break;
- case DOUBLE:
- if ((hfs & HFS_OVF) || (hfs & HFS_UNDF)) {
- d_res.dd = 0.0;
- locr0[PS] |= PSL_Z;
- }
- mvtodacc(d_res.di[0], d_res.di[1], &acc_most);
- break;
- }
- opcode=0;
-}
projects / unix-history / commitdiff