370 lines
8.7 KiB
NASM
370 lines
8.7 KiB
NASM
keep obj/fenv
|
|
mcopy fenv.macros
|
|
case on
|
|
|
|
****************************************************************
|
|
*
|
|
* Fenv - Floating-point environment access
|
|
*
|
|
* This code provides routines to query and modify the
|
|
* floating-point environment.
|
|
*
|
|
* Note: This relies on and only works with SANE.
|
|
*
|
|
****************************************************************
|
|
*
|
|
fenv private dummy segment
|
|
end
|
|
|
|
FE_ALL_EXCEPT gequ $001F
|
|
|
|
****************************************************************
|
|
*
|
|
* int feclearexcept(int excepts);
|
|
*
|
|
* Clear floating-point exceptions
|
|
*
|
|
* Inputs:
|
|
* excepts - floating-point exceptions to clear
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
feclearexcept start
|
|
|
|
csubroutine (2:excepts),0
|
|
|
|
FGETENV get current environment
|
|
phx
|
|
|
|
lda excepts
|
|
and #FE_ALL_EXCEPT
|
|
eor #$FFFF mask off excepts to clear
|
|
xba
|
|
and 1,S
|
|
sta 1,S
|
|
FSETENV clear them
|
|
|
|
stz excepts
|
|
creturn 2:excepts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int fegetexceptflag(fexcept_t *flagp, int excepts);
|
|
*
|
|
* Get floating-point exception flags.
|
|
*
|
|
* Inputs:
|
|
* flagp - pointer to location to store exception flags
|
|
* excepts - floating-point exceptions to get
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
fegetexceptflag start
|
|
|
|
csubroutine (4:flagp,2:excepts),0
|
|
|
|
FGETENV get current environment
|
|
tya
|
|
and excepts get desired exceptions
|
|
and #FE_ALL_EXCEPT
|
|
sta [flagp] store them in *flagp
|
|
|
|
stz excepts
|
|
creturn 2:excepts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int feraiseexcept(int excepts);
|
|
*
|
|
* Raise floating-point exceptions
|
|
*
|
|
* Inputs:
|
|
* excepts - floating-point exceptions to raise
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
feraiseexcept start
|
|
|
|
csubroutine (2:excepts),0
|
|
|
|
lda excepts
|
|
and #FE_ALL_EXCEPT
|
|
beq done
|
|
pha
|
|
FSETXCP raise exceptions
|
|
|
|
done stz excepts
|
|
creturn 2:excepts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int fesetexceptflag(fexcept_t *flagp, int excepts);
|
|
*
|
|
* Set (but do not raise) floating-point exception flags
|
|
*
|
|
* Inputs:
|
|
* flagp - pointer to stored exception flags
|
|
* excepts - floating-point exceptions to set
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
|
|
fesetexceptflag start
|
|
|
|
csubroutine (4:flagp,2:excepts),0
|
|
|
|
FGETENV get env with excepts masked off
|
|
phx
|
|
lda excepts
|
|
and #FE_ALL_EXCEPT
|
|
eor #$FFFF
|
|
xba
|
|
and 1,S
|
|
sta 1,S
|
|
|
|
lda [flagp] set new exceptions
|
|
and excepts
|
|
and #FE_ALL_EXCEPT
|
|
xba
|
|
ora 1,S
|
|
sta 1,S
|
|
FSETENV
|
|
|
|
stz excepts
|
|
creturn 2:excepts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int fetestexcept(int excepts);
|
|
*
|
|
* Test if floating-point exception flags are set
|
|
*
|
|
* Inputs:
|
|
* excepts - floating-point exceptions to test for
|
|
*
|
|
* Outputs:
|
|
* Bitwise or of exceptions that are set
|
|
*
|
|
****************************************************************
|
|
*
|
|
fetestexcept start
|
|
|
|
csubroutine (2:excepts),0
|
|
|
|
FGETENV get exception flags
|
|
tya
|
|
and excepts mask to just the ones we want
|
|
and #FE_ALL_EXCEPT
|
|
sta excepts
|
|
|
|
creturn 2:excepts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int fegetround(void);
|
|
*
|
|
* Get the current rounding direction
|
|
*
|
|
* Outputs:
|
|
* The current rounding direction
|
|
*
|
|
****************************************************************
|
|
*
|
|
fegetround start
|
|
FGETENV get high word of environment
|
|
tya
|
|
and #$00C0 just rounding direction
|
|
rtl
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int fesetround(int round);
|
|
*
|
|
* Set the current rounding direction
|
|
*
|
|
* Inputs:
|
|
* round - the rounding direction to set
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
fesetround start
|
|
|
|
csubroutine (2:round),0
|
|
|
|
lda round flip words
|
|
xba
|
|
sta round
|
|
and #$3FFF do nothing if not a valid rounding dir
|
|
bne done
|
|
|
|
FGETENV set the rounding direction
|
|
txa
|
|
and #$3FFF
|
|
ora round
|
|
pha
|
|
FSETENV
|
|
|
|
stz round
|
|
done creturn 2:round
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int fegetenv(fenv_t *envp);
|
|
*
|
|
* Get the current floating-point environment
|
|
*
|
|
* Inputs:
|
|
* envp - pointer to location to store environment
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
fegetenv start
|
|
|
|
csubroutine (4:envp),0
|
|
|
|
FGETENV get the environment
|
|
txa
|
|
sta [envp] store it in *envp
|
|
|
|
stz envp
|
|
creturn 2:envp
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int feholdexcept(fenv_t *envp);
|
|
*
|
|
* Get environment, then clear status flags and disable halts
|
|
*
|
|
* Inputs:
|
|
* envp - pointer to location to store environment
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
feholdexcept start
|
|
|
|
csubroutine (4:envp),0
|
|
|
|
FGETENV get the environment
|
|
txa
|
|
sta [envp] store it in *envp
|
|
|
|
and #$E0E0 clear exception flags and disable halts
|
|
pha
|
|
FSETENV set the new environment
|
|
|
|
stz envp
|
|
creturn 2:envp
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int fesetenv(const fenv_t *envp);
|
|
*
|
|
* Set the floating-point environment
|
|
*
|
|
* Inputs:
|
|
* envp - pointer to environment to set
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
fesetenv start
|
|
|
|
csubroutine (4:envp),0
|
|
|
|
lda [envp] set the environment
|
|
pha
|
|
FSETENV
|
|
|
|
stz envp
|
|
creturn 2:envp
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int feupdateenv(const fenv_t *envp);
|
|
*
|
|
* Save exceptions, set environment, then re-raise exceptions
|
|
*
|
|
* Inputs:
|
|
* envp - pointer to environment to set
|
|
*
|
|
* Outputs:
|
|
* Returns 0 if successful, non-zero otherwise
|
|
*
|
|
****************************************************************
|
|
*
|
|
feupdateenv start
|
|
|
|
csubroutine (4:envp),0
|
|
|
|
lda [envp] set the environment
|
|
pha
|
|
FPROCEXIT
|
|
|
|
stz envp
|
|
creturn 2:envp
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Default floating-point environment
|
|
*
|
|
****************************************************************
|
|
*
|
|
__FE_DFL_ENV start
|
|
dc i2'0'
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* int __get_flt_rounds(void);
|
|
*
|
|
* Get the value of FLT_ROUNDS, accounting for rounding mode
|
|
*
|
|
* Outputs:
|
|
* Current value of FLT_ROUNDS
|
|
*
|
|
****************************************************************
|
|
*
|
|
__get_flt_rounds start
|
|
FGETENV
|
|
tya get rounding direction in low bits of A
|
|
asl a
|
|
asl a
|
|
xba
|
|
inc a convert to values used by FLT_ROUNDS
|
|
and #$0003
|
|
rtl
|
|
end
|