ORCALib/math2.macros

583 lines
6.7 KiB
Plaintext

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 PH4 &N1
LCLC &C
&LAB ANOP
&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
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
&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
&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