mirror of
https://github.com/byteworksinc/ORCALib.git
synced 2025-02-06 13:30:40 +00:00
5985e7d774
This uses an approximation based on the Stirling series for large enough x (for which it is highly accurate). For smaller x, identities are used to express gamma(x) in terms of gamma(x+1) or gamma(1-x), ultimately letting the Stirling series approximation be used.
706 lines
7.9 KiB
Plaintext
706 lines
7.9 KiB
Plaintext
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
|