Remove floating-point code from ORCALib.
It is being moved to SysFloat.
This commit is contained in:
parent
a81a9964c2
commit
3f70daed7d
361
fenv.asm
361
fenv.asm
|
@ -1,361 +0,0 @@
|
|||
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
|
||||
|
||||
creturn 2:#0
|
||||
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
|
||||
|
||||
creturn 2:#0
|
||||
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 creturn 2:#0
|
||||
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
|
||||
|
||||
creturn 2:#0
|
||||
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
|
||||
|
||||
creturn 2:#0
|
||||
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
|
||||
|
||||
creturn 2:#0
|
||||
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
|
||||
|
||||
creturn 2:#0
|
||||
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
|
||||
|
||||
creturn 2:#0
|
||||
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
|
117
fenv.macros
117
fenv.macros
|
@ -1,117 +0,0 @@
|
|||
MACRO
|
||||
&lab csubroutine &parms,&work
|
||||
&lab anop
|
||||
aif c:&work,.a
|
||||
lclc &work
|
||||
&work setc 0
|
||||
.a
|
||||
gbla &totallen
|
||||
gbla &worklen
|
||||
&worklen seta &work
|
||||
&totallen seta 0
|
||||
aif c:&parms=0,.e
|
||||
lclc &len
|
||||
lclc &p
|
||||
lcla &i
|
||||
&i seta 1
|
||||
.b
|
||||
&p setc &parms(&i)
|
||||
&len amid &p,2,1
|
||||
aif "&len"=":",.c
|
||||
&len amid &p,1,2
|
||||
&p amid &p,4,l:&p-3
|
||||
ago .d
|
||||
.c
|
||||
&len amid &p,1,1
|
||||
&p amid &p,3,l:&p-2
|
||||
.d
|
||||
&p equ &totallen+4+&work
|
||||
&totallen seta &totallen+&len
|
||||
&i seta &i+1
|
||||
aif &i<=c:&parms,^b
|
||||
.e
|
||||
tsc
|
||||
aif &work=0,.f
|
||||
sec
|
||||
sbc #&work
|
||||
tcs
|
||||
.f
|
||||
phd
|
||||
tcd
|
||||
mend
|
||||
MACRO
|
||||
&lab creturn &r
|
||||
&lab anop
|
||||
lclc &len
|
||||
aif c:&r,.a
|
||||
lclc &r
|
||||
&r setc 0
|
||||
&len setc 0
|
||||
ago .h
|
||||
.a
|
||||
&len amid &r,2,1
|
||||
aif "&len"=":",.b
|
||||
&len amid &r,1,2
|
||||
&r amid &r,4,l:&r-3
|
||||
ago .c
|
||||
.b
|
||||
&len amid &r,1,1
|
||||
&r amid &r,3,l:&r-2
|
||||
.c
|
||||
aif &len<>2,.d
|
||||
ldy &r
|
||||
ago .h
|
||||
.d
|
||||
aif &len<>4,.e
|
||||
ldx &r+2
|
||||
ldy &r
|
||||
ago .h
|
||||
.e
|
||||
aif &len<>10,.g
|
||||
ldy #&r
|
||||
ldx #^&r
|
||||
ago .h
|
||||
.g
|
||||
mnote 'Not a valid return length',16
|
||||
mexit
|
||||
.h
|
||||
aif &totallen=0,.i
|
||||
lda &worklen+2
|
||||
sta &worklen+&totallen+2
|
||||
lda &worklen+1
|
||||
sta &worklen+&totallen+1
|
||||
.i
|
||||
pld
|
||||
tsc
|
||||
clc
|
||||
adc #&worklen+&totallen
|
||||
tcs
|
||||
aif &len=0,.j
|
||||
tya
|
||||
.j
|
||||
rtl
|
||||
mend
|
||||
MACRO
|
||||
&LAB FGETENV
|
||||
&LAB PEA $03
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSETENV
|
||||
&LAB PEA $01
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSETXCP
|
||||
&LAB PEA $15
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FPROCEXIT
|
||||
&LAB PEA $19
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
116
fpextra.asm
116
fpextra.asm
|
@ -1,116 +0,0 @@
|
|||
keep obj/fpextra
|
||||
mcopy fpextra.macros
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* FPextra - extra floating-point routines
|
||||
*
|
||||
* This code provides routines dealing with floating-point
|
||||
* numbers that are used only by ORCA/C, supplementing the
|
||||
* ones in SysFloat.
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
fpextra private dummy segment
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~SinglePrecision - limit fp value to single precision & range
|
||||
*
|
||||
* Inputs:
|
||||
* extended-format real on stack
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~SinglePrecision start
|
||||
tsc
|
||||
clc
|
||||
adc #4
|
||||
ldy #0
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
FX2S
|
||||
FS2X
|
||||
rtl
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~DoublePrecision - limit fp value to double precision & range
|
||||
*
|
||||
* Inputs:
|
||||
* extended-format real on stack
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~DoublePrecision start
|
||||
tsc
|
||||
clc
|
||||
adc #4
|
||||
ldy #0
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
FX2D
|
||||
FD2X
|
||||
rtl
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~CompPrecision - limit fp value to comp precision & range
|
||||
*
|
||||
* Inputs:
|
||||
* extended-format real on stack
|
||||
*
|
||||
* Note: This avoids calling FX2C on negative numbers,
|
||||
* because it is buggy for certain values.
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~CompPrecision start
|
||||
tsc round to integer
|
||||
clc
|
||||
adc #4
|
||||
pea 0
|
||||
pha
|
||||
FRINTX
|
||||
lda 4+8,s
|
||||
pha save original sign
|
||||
asl a force sign to positive
|
||||
lsr a
|
||||
sta 6+8,s
|
||||
tsc limit precision
|
||||
clc
|
||||
adc #6
|
||||
ldy #0
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
phy
|
||||
pha
|
||||
FX2C
|
||||
FC2X
|
||||
pla restore original sign
|
||||
bpl ret
|
||||
lda 4+8,s
|
||||
ora #$8000
|
||||
sta 4+8,s
|
||||
ret rtl
|
||||
end
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
MACRO
|
||||
&LAB FX2S
|
||||
&LAB PEA $0210
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2D
|
||||
&LAB PEA $0110
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2C
|
||||
&LAB PEA $0510
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FC2X
|
||||
&LAB PEA $050E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FD2X
|
||||
&LAB PEA $010E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FS2X
|
||||
&LAB PEA $020E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FRINTX
|
||||
&LAB PEA $0014
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
270
int64.asm
270
int64.asm
|
@ -515,273 +515,3 @@ loop1 asl num1 do the remaining shift
|
|||
rt0 pld
|
||||
rtl rtl
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~CnvULongLongReal - convert an unsigned long long integer
|
||||
* into an extended SANE real
|
||||
*
|
||||
* Inputs:
|
||||
* unsigned long long int on stack
|
||||
*
|
||||
* Outputs:
|
||||
* extended real on stack
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~CnvULongLongReal start
|
||||
mantissa equ 4 mantissa (integer and fraction)
|
||||
exponent equ mantissa+8 biased exponent and sign bit
|
||||
|
||||
lda 1,S move return value
|
||||
pha
|
||||
lda 4,S
|
||||
sta 2,S
|
||||
tsc set up DP
|
||||
phd
|
||||
tcd
|
||||
|
||||
lda mantissa+2 move 64-bit value to mantissa
|
||||
sta mantissa
|
||||
lda mantissa+4
|
||||
sta mantissa+2
|
||||
lda mantissa+6
|
||||
sta mantissa+4
|
||||
lda mantissa+8
|
||||
sta mantissa+6
|
||||
|
||||
ora mantissa if value is 0 then
|
||||
ora mantissa+2
|
||||
ora mantissa+4
|
||||
beq ret return
|
||||
|
||||
lda #63+16383 set initial exponent (2^63) and sign
|
||||
sta exponent
|
||||
|
||||
lda mantissa+6 if number is normalized (i=1) then
|
||||
bmi ret return
|
||||
|
||||
lp1 dec exponent normalize number
|
||||
asl mantissa
|
||||
rol mantissa+2
|
||||
rol mantissa+4
|
||||
rol mantissa+6
|
||||
bpl lp1
|
||||
|
||||
ret pld
|
||||
rtl
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~CnvLongLongReal - convert a long long integer into
|
||||
* an extended SANE real
|
||||
*
|
||||
* Inputs:
|
||||
* signed long long int on stack
|
||||
*
|
||||
* Outputs:
|
||||
* extended real on stack
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~CnvLongLongReal start
|
||||
mantissa equ 4 mantissa (integer and fraction)
|
||||
exponent equ mantissa+8 biased exponent and sign bit
|
||||
|
||||
lda 1,S move return value
|
||||
pha
|
||||
lda 4,S
|
||||
sta 2,S
|
||||
tsc set up DP
|
||||
phd
|
||||
tcd
|
||||
|
||||
lda mantissa+2 move 64-bit value to mantissa
|
||||
sta mantissa
|
||||
lda mantissa+4
|
||||
sta mantissa+2
|
||||
lda mantissa+6
|
||||
sta mantissa+4
|
||||
lda mantissa+8
|
||||
sta mantissa+6
|
||||
|
||||
ora mantissa if value is 0 then
|
||||
ora mantissa+2
|
||||
ora mantissa+4
|
||||
beq ret return
|
||||
|
||||
ldy #0 default sign bit is 0 (positive)
|
||||
lda mantissa+6 if mantissa is negative then
|
||||
bpl lb0
|
||||
negate8 mantissa negate it
|
||||
ldy #$8000 sign bit is 1 (negative)
|
||||
|
||||
lb0 tya set sign
|
||||
ora #63+16383 set initial exponent (2^63)
|
||||
sta exponent
|
||||
|
||||
lda mantissa+6 if number is normalized (i=1) then
|
||||
bmi ret return
|
||||
|
||||
lp1 dec exponent normalize number
|
||||
asl mantissa
|
||||
rol mantissa+2
|
||||
rol mantissa+4
|
||||
rol mantissa+6
|
||||
bpl lp1
|
||||
|
||||
ret pld
|
||||
rtl
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~CnvRealLongLong - convert an extended SANE real into
|
||||
* a long long integer
|
||||
*
|
||||
* Inputs:
|
||||
* extended real on stack
|
||||
*
|
||||
* Outputs:
|
||||
* signed long long int on stack
|
||||
*
|
||||
* Note: This avoids calling FX2C on negative numbers,
|
||||
* because it is buggy for certain values.
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~CnvRealLongLong start
|
||||
tsc
|
||||
clc
|
||||
adc #4
|
||||
pea 0 push src address for fcpxx
|
||||
pha
|
||||
pea llmin|-16 push dst address for fcpxx
|
||||
pea llmin
|
||||
pea 0 push operand address for ftintx
|
||||
pha
|
||||
ftintx round
|
||||
fcpxx compare with LLONG_MIN
|
||||
bne convert
|
||||
|
||||
lda #$8000 if it is LONG_MIN, use that value
|
||||
sta 12,s
|
||||
asl a
|
||||
sta 10,s
|
||||
sta 8,s
|
||||
sta 6,s
|
||||
bra done otherwise
|
||||
|
||||
convert lda 4+8,s
|
||||
pha save original sign
|
||||
asl a force sign to positive
|
||||
lsr a
|
||||
sta 6+8,s
|
||||
tsc
|
||||
clc
|
||||
adc #6
|
||||
pea 0 push src address for fx2c
|
||||
pha
|
||||
pea 0 push dst address for fx2c
|
||||
inc a
|
||||
inc a
|
||||
pha
|
||||
fx2c convert
|
||||
pla if original value was negative
|
||||
bpl done
|
||||
sec
|
||||
ldx #0 negate result
|
||||
txa
|
||||
sbc 6,s
|
||||
sta 6,s
|
||||
txa
|
||||
sbc 6+2,s
|
||||
sta 6+2,s
|
||||
txa
|
||||
sbc 6+4,s
|
||||
sta 6+4,s
|
||||
txa
|
||||
sbc 6+6,s
|
||||
sta 6+6,s
|
||||
|
||||
done phb move return address
|
||||
pla
|
||||
plx
|
||||
ply
|
||||
phx
|
||||
pha
|
||||
plb
|
||||
rtl
|
||||
|
||||
llmin dc e'-9223372036854775808'
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~CnvRealULongLong - convert an extended SANE real into
|
||||
* an unsigned long long integer
|
||||
*
|
||||
* Inputs:
|
||||
* extended real on stack
|
||||
*
|
||||
* Outputs:
|
||||
* unsigned long long int on stack
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~CnvRealULongLong start
|
||||
pea 0 initially assume val <= LLONG_MAX
|
||||
|
||||
tsc
|
||||
clc
|
||||
adc #6
|
||||
pea 0 push src address for fcpxx
|
||||
pha
|
||||
pea llbig|-16 push dst address for fcpxx
|
||||
pea llbig
|
||||
pea 0 push operand address for ftintx
|
||||
pha
|
||||
ftintx round
|
||||
fcpxx compare with LLONG_MAX+1
|
||||
bmi convert
|
||||
|
||||
lda #1 if val > LLONG_MAX:
|
||||
sta 1,S save flag to indicate this
|
||||
tsc
|
||||
clc
|
||||
adc #6
|
||||
pea llbig|-16 push src address for fsubx
|
||||
pea llbig
|
||||
pea 0 push dst address for fsubx
|
||||
pha
|
||||
fsubx val -= LLONG_MAX+1
|
||||
|
||||
convert tsc
|
||||
clc
|
||||
adc #6
|
||||
pea 0 push src address for fx2c
|
||||
pha
|
||||
pea 0 push dst address for fx2c
|
||||
inc a
|
||||
inc a
|
||||
pha
|
||||
fx2c convert val as comp
|
||||
|
||||
pla if orig val was > LLONG_MAX:
|
||||
beq done
|
||||
lda 12,s
|
||||
eor #$8000
|
||||
sta 12,s result += LLONG_MAX+1
|
||||
|
||||
done phb move return address
|
||||
pla
|
||||
plx
|
||||
ply
|
||||
phx
|
||||
pha
|
||||
plb
|
||||
rtl
|
||||
|
||||
llbig dc e'9223372036854775808'
|
||||
end
|
||||
|
|
43
int64.macros
43
int64.macros
|
@ -1,23 +1,4 @@
|
|||
macro
|
||||
&l negate8 &n1
|
||||
&l ~setm
|
||||
sec
|
||||
ldy #0
|
||||
tya
|
||||
sbc &n1
|
||||
sta &n1
|
||||
tya
|
||||
sbc &n1+2
|
||||
sta &n1+2
|
||||
tya
|
||||
sbc &n1+4
|
||||
sta &n1+4
|
||||
tya
|
||||
sbc &n1+6
|
||||
sta &n1+6
|
||||
~restm
|
||||
mend
|
||||
macro
|
||||
&l move4 &m1,&m2
|
||||
lclb &yistwo
|
||||
&l ~setm
|
||||
|
@ -140,27 +121,3 @@
|
|||
.d
|
||||
sta 2+&op
|
||||
mend
|
||||
MACRO
|
||||
&LAB FTINTX
|
||||
&LAB PEA $0016
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2C
|
||||
&LAB PEA $0510
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCPXX
|
||||
&LAB PEA $0A
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSUBX
|
||||
&LAB PEA 2
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
|
|
4
make
4
make
|
@ -19,7 +19,7 @@ if {#} == 0
|
|||
unset exit
|
||||
end
|
||||
|
||||
for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 fenv fpextra math2 locale uchar
|
||||
for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 locale uchar
|
||||
Newer obj/{i}.a {i}.asm
|
||||
if {Status} != 0
|
||||
set exit on
|
||||
|
@ -40,7 +40,7 @@ delete orcalib
|
|||
|
||||
set list vars.a assert.a cc.a setjmp.a ctype.a string.a stdlib.a
|
||||
set list {list} time.a signal.a toolglue.a orca.a fcntl.a stdio.a int64.a
|
||||
set list {list} fenv.a fpextra.a math2.a locale.a uchar.a
|
||||
set list {list} locale.a uchar.a
|
||||
for i in {list}
|
||||
echo makelib orcalib +obj/{i}
|
||||
makelib orcalib +obj/{i}
|
||||
|
|
755
math2.macros
755
math2.macros
|
@ -1,755 +0,0 @@
|
|||
macro
|
||||
&l ph4 &n1
|
||||
&l anop
|
||||
aif "&n1"="*",.f
|
||||
lclc &c
|
||||
&c amid &n1,1,1
|
||||
aif "&c"="#",.d
|
||||
aif s:longa=1,.a
|
||||
rep #%00100000
|
||||
.a
|
||||
aif "&c"<>"{",.b
|
||||
&c amid &n1,l:&n1,1
|
||||
aif "&c"<>"}",.g
|
||||
&n1 amid &n1,2,l:&n1-2
|
||||
ldy #2
|
||||
lda (&n1),y
|
||||
pha
|
||||
lda (&n1)
|
||||
pha
|
||||
ago .e
|
||||
.b
|
||||
aif "&c"<>"[",.c
|
||||
ldy #2
|
||||
lda &n1,y
|
||||
pha
|
||||
lda &n1
|
||||
pha
|
||||
ago .e
|
||||
.c
|
||||
aif "&c"<>"<",.c1
|
||||
&n1 amid &n1,2,l:&n1-1
|
||||
pei &n1+2
|
||||
pei &n1
|
||||
ago .e
|
||||
.c1
|
||||
lda &n1+2
|
||||
pha
|
||||
lda &n1
|
||||
pha
|
||||
ago .e
|
||||
.d
|
||||
&n1 amid &n1,2,l:&n1-1
|
||||
pea +(&n1)|-16
|
||||
pea &n1
|
||||
ago .f
|
||||
.e
|
||||
aif s:longa=1,.f
|
||||
sep #%00100000
|
||||
.f
|
||||
mexit
|
||||
.g
|
||||
mnote "Missing closing '}'",16
|
||||
mend
|
||||
MACRO
|
||||
&lab csubroutine &parms,&work
|
||||
&lab anop
|
||||
aif c:&work,.a
|
||||
lclc &work
|
||||
&work setc 0
|
||||
.a
|
||||
gbla &totallen
|
||||
gbla &worklen
|
||||
&worklen seta &work
|
||||
&totallen seta 0
|
||||
aif c:&parms=0,.e
|
||||
lclc &len
|
||||
lclc &p
|
||||
lcla &i
|
||||
&i seta 1
|
||||
.b
|
||||
&p setc &parms(&i)
|
||||
&len amid &p,2,1
|
||||
aif "&len"=":",.c
|
||||
&len amid &p,1,2
|
||||
&p amid &p,4,l:&p-3
|
||||
ago .d
|
||||
.c
|
||||
&len amid &p,1,1
|
||||
&p amid &p,3,l:&p-2
|
||||
.d
|
||||
&p equ &totallen+4+&work
|
||||
&totallen seta &totallen+&len
|
||||
&i seta &i+1
|
||||
aif &i<=c:&parms,^b
|
||||
.e
|
||||
tsc
|
||||
aif &work=0,.f
|
||||
sec
|
||||
sbc #&work
|
||||
tcs
|
||||
.f
|
||||
phd
|
||||
tcd
|
||||
mend
|
||||
MACRO
|
||||
&lab creturn &r
|
||||
&lab anop
|
||||
lclc &len
|
||||
aif c:&r,.a
|
||||
lclc &r
|
||||
&r setc 0
|
||||
&len setc 0
|
||||
ago .h
|
||||
.a
|
||||
&len amid &r,2,1
|
||||
aif "&len"=":",.b
|
||||
&len amid &r,1,2
|
||||
&r amid &r,4,l:&r-3
|
||||
ago .c
|
||||
.b
|
||||
&len amid &r,1,1
|
||||
&r amid &r,3,l:&r-2
|
||||
.c
|
||||
aif &len<>2,.d
|
||||
ldy &r
|
||||
ago .h
|
||||
.d
|
||||
aif &len<>4,.e
|
||||
ldx &r+2
|
||||
ldy &r
|
||||
ago .h
|
||||
.e
|
||||
aif &len<>10,.g
|
||||
ldy #&r
|
||||
ldx #^&r
|
||||
ago .h
|
||||
.g
|
||||
mnote 'Not a valid return length',16
|
||||
mexit
|
||||
.h
|
||||
aif &totallen=0,.i
|
||||
lda &worklen+2
|
||||
sta &worklen+&totallen+2
|
||||
lda &worklen+1
|
||||
sta &worklen+&totallen+1
|
||||
.i
|
||||
pld
|
||||
tsc
|
||||
clc
|
||||
adc #&worklen+&totallen
|
||||
tcs
|
||||
aif &len=0,.j
|
||||
tya
|
||||
.j
|
||||
rtl
|
||||
mend
|
||||
macro
|
||||
&l cmp4 &n1,&n2
|
||||
lclb &yistwo
|
||||
&l ~setm
|
||||
~lda.h &n1
|
||||
~op.h eor,&n2
|
||||
bpl ~a&SYSCNT
|
||||
~lda.h &n2
|
||||
~op.h cmp,&n1
|
||||
bra ~b&SYSCNT
|
||||
~a&SYSCNT ~lda.h &n1
|
||||
~op.h cmp,&n2
|
||||
bne ~b&SYSCNT
|
||||
~lda &n1
|
||||
~op cmp,&n2
|
||||
~b&SYSCNT anop
|
||||
~restm
|
||||
mend
|
||||
macro
|
||||
&l ~lda &op
|
||||
lclc &c
|
||||
&c amid "&op",1,1
|
||||
aif "&c"<>"{",.b
|
||||
&c amid "&op",l:&op,1
|
||||
aif "&c"="}",.a
|
||||
mnote "Missing closing '}'",2
|
||||
&op setc &op}
|
||||
.a
|
||||
&op amid "&op",2,l:&op-2
|
||||
&op setc (&op)
|
||||
.b
|
||||
&l lda &op
|
||||
mend
|
||||
macro
|
||||
&l ~lda.h &op
|
||||
&l anop
|
||||
lclc &c
|
||||
&c amid "&op",1,1
|
||||
aif "&c"="[",.b
|
||||
aif "&c"<>"{",.d
|
||||
&c amid "&op",l:&op,1
|
||||
aif "&c"="}",.a
|
||||
mnote "Missing closing '}'",2
|
||||
&op setc &op}
|
||||
.a
|
||||
&op amid "&op",2,l:&op-2
|
||||
&op setc (&op)
|
||||
.b
|
||||
aif &yistwo,.c
|
||||
&yistwo setb 1
|
||||
ldy #2
|
||||
.c
|
||||
&op setc "&op,y"
|
||||
lda &op
|
||||
mexit
|
||||
.d
|
||||
aif "&c"<>"#",.e
|
||||
&op amid "&op",2,l:&op-1
|
||||
&op setc "#^&op"
|
||||
lda &op
|
||||
mexit
|
||||
.e
|
||||
lda 2+&op
|
||||
mend
|
||||
macro
|
||||
&l ~op &opc,&op
|
||||
lclc &c
|
||||
&c amid "&op",1,1
|
||||
aif "&c"<>"{",.b
|
||||
&c amid "&op",l:&op,1
|
||||
aif "&c"="}",.a
|
||||
mnote "Missing closing '}'",2
|
||||
&op setc &op}
|
||||
.a
|
||||
&op amid "&op",2,l:&op-2
|
||||
&op setc (&op)
|
||||
.b
|
||||
&l &opc &op
|
||||
mend
|
||||
macro
|
||||
&l ~op.h &opc,&op
|
||||
&l anop
|
||||
lclc &c
|
||||
&c amid "&op",1,1
|
||||
aif "&c"="[",.b
|
||||
aif "&c"<>"{",.d
|
||||
&c amid "&op",l:&op,1
|
||||
aif "&c"="}",.a
|
||||
mnote "Missing closing '}'",2
|
||||
&op setc &op}
|
||||
.a
|
||||
&op amid "&op",2,l:&op-2
|
||||
&op setc (&op)
|
||||
.b
|
||||
aif &yistwo,.c
|
||||
&yistwo setb 1
|
||||
ldy #2
|
||||
.c
|
||||
&op setc "&op,y"
|
||||
&opc &op
|
||||
mexit
|
||||
.d
|
||||
aif "&c"<>"#",.e
|
||||
&op amid "&op",2,l:&op-1
|
||||
&op setc "#^&op"
|
||||
&opc &op
|
||||
mexit
|
||||
.e
|
||||
&opc 2+&op
|
||||
mend
|
||||
macro
|
||||
&l ~restm
|
||||
&l anop
|
||||
aif (&~la+&~li)=2,.i
|
||||
sep #32*(.not.&~la)+16*(.not.&~li)
|
||||
aif &~la,.h
|
||||
longa off
|
||||
.h
|
||||
aif &~li,.i
|
||||
longi off
|
||||
.i
|
||||
mend
|
||||
macro
|
||||
&l ~setm
|
||||
&l anop
|
||||
aif c:&~la,.b
|
||||
gblb &~la
|
||||
gblb &~li
|
||||
.b
|
||||
&~la setb s:longa
|
||||
&~li setb s:longi
|
||||
aif s:longa.and.s:longi,.a
|
||||
rep #32*(.not.&~la)+16*(.not.&~li)
|
||||
longa on
|
||||
longi on
|
||||
.a
|
||||
mend
|
||||
macro
|
||||
&l inc4 &a
|
||||
&l ~setm
|
||||
inc &a
|
||||
bne ~&SYSCNT
|
||||
inc 2+&a
|
||||
~&SYSCNT ~restm
|
||||
mend
|
||||
macro
|
||||
&l sub4 &m1,&m2,&m3
|
||||
lclb &yistwo
|
||||
lclc &c
|
||||
&l ~setm
|
||||
aif c:&m3,.a
|
||||
&c amid "&m2",1,1
|
||||
aif "&c"<>"#",.a
|
||||
&c amid "&m1",1,1
|
||||
aif "&c"="{",.a
|
||||
aif "&c"="[",.a
|
||||
&c amid "&m2",2,l:&m2-1
|
||||
aif &c>=65536,.a
|
||||
sec
|
||||
~lda &m1
|
||||
~op sbc,&m2
|
||||
~sta &m1
|
||||
bcs ~&SYSCNT
|
||||
~op.h dec,&m1
|
||||
~&SYSCNT anop
|
||||
ago .c
|
||||
.a
|
||||
aif c:&m3,.b
|
||||
lclc &m3
|
||||
&m3 setc &m1
|
||||
.b
|
||||
sec
|
||||
~lda &m1
|
||||
~op sbc,&m2
|
||||
~sta &m3
|
||||
~lda.h &m1
|
||||
~op.h sbc,&m2
|
||||
~sta.h &m3
|
||||
.c
|
||||
~restm
|
||||
mend
|
||||
macro
|
||||
&l ~sta &op
|
||||
lclc &c
|
||||
&c amid "&op",1,1
|
||||
aif "&c"<>"{",.b
|
||||
&c amid "&op",l:&op,1
|
||||
aif "&c"="}",.a
|
||||
mnote "Missing closing '}'",2
|
||||
&op setc &op}
|
||||
.a
|
||||
&op amid "&op",2,l:&op-2
|
||||
&op setc (&op)
|
||||
.b
|
||||
&l sta &op
|
||||
mend
|
||||
macro
|
||||
&l ~sta.h &op
|
||||
&l anop
|
||||
lclc &c
|
||||
&c amid "&op",1,1
|
||||
aif "&c"="[",.b
|
||||
aif "&c"<>"{",.d
|
||||
&c amid "&op",l:&op,1
|
||||
aif "&c"="}",.a
|
||||
mnote "Missing closing '}'",2
|
||||
&op setc &op}
|
||||
.a
|
||||
&op amid "&op",2,l:&op-2
|
||||
&op setc (&op)
|
||||
.b
|
||||
aif &yistwo,.c
|
||||
&yistwo setb 1
|
||||
ldy #2
|
||||
.c
|
||||
&op setc "&op,y"
|
||||
sta &op
|
||||
mexit
|
||||
.d
|
||||
sta 2+&op
|
||||
mend
|
||||
macro
|
||||
&l cmpl &n1,&n2
|
||||
lclb &yistwo
|
||||
&l ~setm
|
||||
~lda.h &n1
|
||||
~op.h cmp,&n2
|
||||
bne ~a&SYSCNT
|
||||
~lda &n1
|
||||
~op cmp,&n2
|
||||
~a&SYSCNT anop
|
||||
~restm
|
||||
mend
|
||||
macro
|
||||
&l jmi &bp
|
||||
&l bpl *+5
|
||||
brl &bp
|
||||
mend
|
||||
macro
|
||||
&l jpl &bp
|
||||
&l bmi *+5
|
||||
brl &bp
|
||||
mend
|
||||
macro
|
||||
&l jeq &bp
|
||||
&l bne *+5
|
||||
brl &bp
|
||||
mend
|
||||
MACRO
|
||||
&LAB FCLASSS
|
||||
&LAB PEA $021C
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCLASSD
|
||||
&LAB PEA $011C
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCLASSX
|
||||
&LAB PEA $001C
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2S
|
||||
&LAB PEA $0210
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2D
|
||||
&LAB PEA $0110
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCMPX
|
||||
&LAB PEA $0008
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FEXP2X
|
||||
&LAB PEA $000A
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FEXP1X
|
||||
&LAB PEA $000C
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FLN1X
|
||||
&LAB PEA $0004
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FLOG2X
|
||||
&LAB PEA $0002
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FLOGBX
|
||||
&LAB PEA $001A
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2I
|
||||
&LAB PEA $0410
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FTINTX
|
||||
&LAB PEA $0016
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FRINTX
|
||||
&LAB PEA $0014
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FXPWRY
|
||||
&LAB PEA $0012
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FREMX
|
||||
&LAB PEA $000C
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSCALBX
|
||||
&LAB PEA $0018
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSUBX
|
||||
&LAB PEA $0002
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FGETENV
|
||||
&LAB PEA $03
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSETENV
|
||||
&LAB PEA $01
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2C
|
||||
&LAB PEA $0510
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCPXX
|
||||
&LAB PEA $0A
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FNEXTX
|
||||
&LAB PEA $001E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FX2X
|
||||
&LAB PEA $0010
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCPXD
|
||||
&LAB PEA $010A
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FNEXTD
|
||||
&LAB PEA $011E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FD2X
|
||||
&LAB PEA $010E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FS2X
|
||||
&LAB PEA $020E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FNEXTS
|
||||
&LAB PEA $021E
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCPXS
|
||||
&LAB PEA $020A
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FPROCENTRY
|
||||
&LAB PEA $0017
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FPROCEXIT
|
||||
&LAB PEA $0019
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FTESTXCP
|
||||
&LAB PEA $001B
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FADDS
|
||||
&LAB PEA $0200
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSETXCP
|
||||
&LAB PEA $0015
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FADDX
|
||||
&LAB PEA $0000
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FADDI
|
||||
&LAB PEA $0400
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSUBI
|
||||
&LAB PEA $0402
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FMULX
|
||||
&LAB PEA $0004
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSQRTX
|
||||
&LAB PEA $0012
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FLNX
|
||||
&LAB PEA $0000
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&lab _SDivide
|
||||
&lab ldx #$0A0B
|
||||
jsl $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FMULI
|
||||
&LAB PEA $0404
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FDIVI
|
||||
&LAB PEA $0406
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FDIVX
|
||||
&LAB PEA $0006
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FXPWRI
|
||||
&LAB PEA $0010
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCMPS
|
||||
&LAB PEA $0208
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FEXPX
|
||||
&LAB PEA $0008
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FCMPI
|
||||
&LAB PEA $0408
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSUBS
|
||||
&LAB PEA $0202
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FSINX
|
||||
&LAB PEA $001A
|
||||
LDX #$0B0A
|
||||
JSL $E10000
|
||||
MEND
|
||||
MACRO
|
||||
&LAB FREMI
|
||||
&LAB PEA $040C
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
macro
|
||||
&l dec4 &a
|
||||
&l ~setm
|
||||
lda &a
|
||||
bne ~&SYSCNT
|
||||
dec 2+&a
|
||||
~&SYSCNT dec &a
|
||||
~restm
|
||||
mend
|
||||
macro
|
||||
&l add4 &m1,&m2,&m3
|
||||
lclb &yistwo
|
||||
lclc &c
|
||||
&l ~setm
|
||||
aif c:&m3,.a
|
||||
&c amid "&m2",1,1
|
||||
aif "&c"<>"#",.a
|
||||
&c amid "&m1",1,1
|
||||
aif "&c"="{",.a
|
||||
aif "&c"="[",.a
|
||||
&c amid "&m2",2,l:&m2-1
|
||||
aif &c>=65536,.a
|
||||
clc
|
||||
~lda &m1
|
||||
~op adc,&m2
|
||||
~sta &m1
|
||||
bcc ~&SYSCNT
|
||||
~op.h inc,&m1
|
||||
~&SYSCNT anop
|
||||
ago .c
|
||||
.a
|
||||
aif c:&m3,.b
|
||||
lclc &m3
|
||||
&m3 setc &m1
|
||||
.b
|
||||
clc
|
||||
~lda &m1
|
||||
~op adc,&m2
|
||||
~sta &m3
|
||||
~lda.h &m1
|
||||
~op.h adc,&m2
|
||||
~sta.h &m3
|
||||
.c
|
||||
~restm
|
||||
mend
|
||||
macro
|
||||
&l jvc &bp
|
||||
&l bvs *+5
|
||||
brl &bp
|
||||
mend
|
283
stdio.asm
283
stdio.asm
|
@ -3828,289 +3828,6 @@ ug1 rtl
|
|||
string ds 4
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~Format_a - format a floating-point number in hex format
|
||||
* (lowercase output)
|
||||
* ~Format_A - format a floating-point number in hex format
|
||||
* (uppercase output)
|
||||
*
|
||||
* Inputs:
|
||||
* ~altForm - always include decimal point?
|
||||
* ~fieldWidth - output field width
|
||||
* ~paddChar - padd character
|
||||
* ~leftJustify - left justify the output?
|
||||
* ~precision - precision of output
|
||||
* ~precisionSpecified - was the precision specified?
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
~Format_a private
|
||||
using ~printfCommon
|
||||
argp equ 7 argument pointer
|
||||
;
|
||||
; Set the "or" value; this is used to set the case of character results
|
||||
;
|
||||
lda #$20
|
||||
sta ~orVal
|
||||
bra in1
|
||||
|
||||
~Format_A entry
|
||||
stz ~orVal
|
||||
;
|
||||
; Check for infinities or nans
|
||||
;
|
||||
in1 ldy #8 load exponent/sign word
|
||||
lda [argp],Y
|
||||
asl a
|
||||
tax
|
||||
eor #32767*2
|
||||
bne sn1 if number is an infinity or NaN
|
||||
lda #' ' do not use '0' padding
|
||||
sta ~paddChar
|
||||
lda ~orVal if doing %A format
|
||||
bne in2
|
||||
brl ~Format_E format like %E
|
||||
in2 brl ~Format_e else format like %e
|
||||
;
|
||||
; Determine sign
|
||||
;
|
||||
sn1 stz ~sgn assume sign is positive
|
||||
bcc ex1 if sign of number is negative
|
||||
lda #'-' set sign character to '-'
|
||||
sta ~sign
|
||||
dec ~sgn flag that sign is negative
|
||||
;
|
||||
; Get exponent
|
||||
;
|
||||
ex1 txa get exponent field
|
||||
lsr a (clears carry)
|
||||
sbc #16383-1 compute unbiased exponent
|
||||
sta ~exp save it
|
||||
;
|
||||
; Get significand
|
||||
;
|
||||
sg1 ldy #6 store the significand in ~sig
|
||||
sg2 lda [argp],Y
|
||||
sta ~sig,Y
|
||||
dey
|
||||
dey
|
||||
bpl sg2
|
||||
ora ~sig+2 if significand is zero then
|
||||
ora ~sig+4
|
||||
ora ~sig+6
|
||||
bne pc1
|
||||
lda #3 set exponent so it will print as 0
|
||||
sta ~exp
|
||||
;
|
||||
; Determine precision
|
||||
;
|
||||
pc1 lda ~precisionSpecified if the precision was not specified then
|
||||
bne rd0
|
||||
lda #15 use a precision of 15
|
||||
sta ~precision
|
||||
;
|
||||
; Do rounding
|
||||
;
|
||||
rd0 lda ~precision if precision < 15
|
||||
cmp #15
|
||||
jge pd1
|
||||
|
||||
stz ~sig+8 make sure bit above significand is zero
|
||||
inc a shift significand (precision+1)*4 bits left
|
||||
asl a
|
||||
asl a
|
||||
pha
|
||||
tay
|
||||
rd1 ldx #0
|
||||
clc
|
||||
rd1a rol ~sig,X
|
||||
inx
|
||||
inx
|
||||
txa
|
||||
eor #16
|
||||
bne rd1a
|
||||
dey
|
||||
bne rd1
|
||||
|
||||
lda ~sig consolidate extra bits
|
||||
ora ~sig+2
|
||||
ora ~sig+4
|
||||
beq rd2
|
||||
lda #1
|
||||
tsb ~sig+6
|
||||
|
||||
rd2 lda ~sig+6 if there are extra non-zero bits then
|
||||
beq rdW
|
||||
FGETENV get rounding direction
|
||||
txa
|
||||
asl a
|
||||
bcs roundDn0
|
||||
bmi roundUp if rounding to nearest then
|
||||
roundNr lda ~sig+6 if first extra bit is 0
|
||||
bpl rdW do not round
|
||||
asl a else if remaining extra bits are non-zero
|
||||
bne do_round
|
||||
lda ~sig+8 or low-order bit of result is 1 then
|
||||
lsr a
|
||||
bcc rdW
|
||||
bra do_round apply rounding
|
||||
|
||||
roundUp lda ~sgn if rounding upward then
|
||||
bmi rdW if positive then
|
||||
bra do_round apply rounding
|
||||
|
||||
roundDn0 bmi rdW if rounding downward then
|
||||
roundDn lda ~sgn if negative then
|
||||
bpl rdW apply rounding
|
||||
|
||||
do_round ldx #8 (perform the rounding, if needed)
|
||||
rdV inc ~sig,X
|
||||
bne rdW
|
||||
inx
|
||||
inx
|
||||
cpx #14+1
|
||||
blt rdV
|
||||
|
||||
rdW ply shift significand (precision+1)*4 bits right
|
||||
rdX ldx #14
|
||||
clc
|
||||
rdXa ror ~sig,X
|
||||
dex
|
||||
dex
|
||||
bpl rdXa
|
||||
dey
|
||||
bne rdX
|
||||
|
||||
lsr ~sig+8 handle carry out from rounding
|
||||
bcc pd1
|
||||
ldx #6
|
||||
rdYa ror ~sig,X
|
||||
dex
|
||||
dex
|
||||
bpl rdYa
|
||||
inc ~exp
|
||||
;
|
||||
; Compute amount of padding
|
||||
;
|
||||
pd1 lda ~fieldWidth subtract off precision from field width
|
||||
sec
|
||||
sbc ~precision
|
||||
sec subtract off minimal extra chars
|
||||
sbc #6
|
||||
sta ~fieldWidth
|
||||
lda ~sign if there is a sign character then
|
||||
beq pd2
|
||||
dec ~fieldWidth decrement field width
|
||||
pd2 lda ~precision if precision != 0 or # flag used then
|
||||
ora ~altForm
|
||||
beq pd2a
|
||||
sta ~altForm flag this
|
||||
dec ~fieldWidth decrement field width
|
||||
pd2a lda ~exp get exponent
|
||||
bpl pd3 compute absolute value of exponent
|
||||
eor #$FFFF
|
||||
inc a
|
||||
pd3 cmp #10 if |exponent| >= 10 then
|
||||
blt pd4
|
||||
dec ~fieldWidth decrement field width
|
||||
cmp #100 if |exponent| >= 100 then
|
||||
blt pd4
|
||||
dec ~fieldWidth decrement field width
|
||||
cmp #1000 if |exponent| >= 1000 then
|
||||
blt pd4
|
||||
dec ~fieldWidth decrement field width
|
||||
cmp #10000 if |exponent| >= 10000 then
|
||||
blt pd4
|
||||
dec ~fieldWidth decrement field width
|
||||
pd4 lda ~paddChar if we are not padding with zeros then
|
||||
cmp #'0'
|
||||
beq pn1
|
||||
jsr ~RightJustify handle right justification
|
||||
;
|
||||
; Print the number
|
||||
;
|
||||
pn1 lda ~sign if there is a sign character then
|
||||
beq pn2
|
||||
pha print it
|
||||
jsl ~putchar
|
||||
pn2 pea '0' print hex prefix
|
||||
jsl ~putchar
|
||||
lda #'X'
|
||||
ora ~orVal
|
||||
pha
|
||||
jsl ~putchar
|
||||
jsr ~ZeroPad pad with '0's if needed
|
||||
|
||||
pn5 lda #0 print the digits
|
||||
ldy #4
|
||||
pn6 asl ~sig
|
||||
rol ~sig+2
|
||||
rol ~sig+4
|
||||
rol ~sig+6
|
||||
rol a
|
||||
dey
|
||||
bne pn6
|
||||
; clc (already clear)
|
||||
adc #'0'
|
||||
cmp #'9'+1
|
||||
blt pn7
|
||||
adc #6
|
||||
ora ~orVal
|
||||
pn7 pha
|
||||
jsl ~putchar
|
||||
lda ~altForm print '.' after first digit if needed
|
||||
beq pn8
|
||||
ph2 #'.'
|
||||
jsl ~putchar
|
||||
stz ~altForm
|
||||
pn8 dec ~precision
|
||||
bpl pn5
|
||||
;
|
||||
; Print exponent
|
||||
;
|
||||
lda #'P' print 'P' or 'p' exponent prefix
|
||||
ora ~orVal
|
||||
pha
|
||||
jsl ~putchar
|
||||
|
||||
lda ~exp adjust exponent to reflect 4 bits
|
||||
dec a in integer part (before '.')
|
||||
dec a
|
||||
dec a
|
||||
pha push exponent
|
||||
bmi pe1 print '+' if exponent is positive
|
||||
ph2 #'+'
|
||||
jsl ~putchar
|
||||
pe1 ph4 #~str push the string addr
|
||||
ph2 #6 push the string buffer length
|
||||
ph2 #1 do a signed conversion
|
||||
_Int2Dec convert exponent to string
|
||||
ldx #0 print the exponent
|
||||
pe2 lda ~str,x
|
||||
and #$00FF
|
||||
cmp #' '+1
|
||||
blt pe3
|
||||
phx
|
||||
pha
|
||||
jsl ~putchar
|
||||
plx
|
||||
pe3 inx
|
||||
cpx #6
|
||||
blt pe2
|
||||
;
|
||||
; Remove the number from the argument list
|
||||
;
|
||||
lda argp remove the parameter
|
||||
adc #10-1 (carry is set)
|
||||
sta argp
|
||||
;
|
||||
; Handle left justification
|
||||
;
|
||||
brl ~LeftJustify handle left justification
|
||||
end
|
||||
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* ~Format_c - format a '%' character
|
||||
|
|
11
stdio.macros
11
stdio.macros
|
@ -974,14 +974,3 @@
|
|||
phd
|
||||
tcd
|
||||
mend
|
||||
MACRO
|
||||
&LAB FGETENV
|
||||
&LAB PEA $03
|
||||
LDX #$090A
|
||||
JSL $E10000
|
||||
MEND
|
||||
macro
|
||||
&l jge &bp
|
||||
&l blt *+5
|
||||
brl &bp
|
||||
mend
|
||||
|
|
Loading…
Reference in New Issue