ORCALib/stdlib.macros
Stephen Heumann 84f471474a Use newer, more efficient ph2/ph4 macros throughout ORCALib.
These push DP values with pei, rather than lda+pha as in the old versions of the macros.
2022-06-30 19:01:47 -05:00

737 lines
8.4 KiB
Plaintext

macro
&l ph2 &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
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
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
&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 ph8 &n1
lclc &c
&l anop
&c amid &n1,1,1
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"="#",.d
aif "&c"="[",.b
aif "&c"<>"{",.c
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
&n1 setc (&n1)
.b
ldy #6
~&SYSCNT lda &n1,y
pha
dey
dey
bpl ~&SYSCNT
ago .e
.c
aif "&c"<>"<",.c1
pei &n1+6
pei &n1+4
pei &n1+2
pei &n1
ago .e
.c1
ldx #6
~&SYSCNT lda &n1,x
pha
dex
dex
bpl ~&SYSCNT
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-48
pea +(&n1)|-32
pea +(&n1)|-16
pea &n1
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&LAB MOVE4 &F,&T
&LAB ~SETM
LDA 2+&F
STA 2+&T
LDA &F
STA &T
~RESTM
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
&LAB ~SETM
&LAB 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
&LAB ~RESTM
&LAB 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
&LAB ADD4 &M1,&M2,&M3
LCLB &YISTWO
LCLC &C
&LAB ~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
&LAB MUL4 &N1,&N2,&N3
&LAB ~SETM
PH4 &N1
PH4 &N2
JSL ~MUL4
AIF C:&N3,.A
PL4 &N1
AGO .B
.A
PL4 &N3
.B
~RESTM
MEND
MACRO
&LAB SUB4 &M1,&M2,&M3
LCLB &YISTWO
LCLC &C
&LAB ~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
&LAB ~OP.H &OPC,&OP
&LAB 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
&OP SETC "&OP,Y"
.C
&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
&LAB ~LDA.H &OP
&LAB 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
&OP SETC "&OP,Y"
.C
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
&LAB ~STA.H &OP
&LAB 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
&OP SETC "&OP,Y"
.C
STA &OP
MEXIT
.D
STA 2+&OP
MEND
MACRO
&LAB ~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
&LAB LDA &OP
MEND
MACRO
&LAB ~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
&LAB STA &OP
MEND
MACRO
&LAB ~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
&LAB &OPC &OP
MEND
MACRO
&LAB BGT &BP
&LAB BEQ *+4
BGE &BP
MEND
MACRO
&LAB DEC4 &A
&LAB ~SETM
LDA &A
BNE ~&SYSCNT
DEC 2+&A
~&SYSCNT DEC &A
~RESTM
MEND
MACRO
&LAB INC4 &A
&LAB ~SETM
INC &A
BNE ~&SYSCNT
INC 2+&A
~&SYSCNT ~RESTM
MEND
MACRO
&LAB LONG &A,&B
LCLB &I
LCLB &M
&A AMID &A,1,1
&M SETB ("&A"="M").OR.("&A"="m")
&I SETB ("&A"="I").OR.("&A"="i")
AIF C:&B=0,.A
&B AMID &B,1,1
&M SETB ("&B"="M").OR.("&B"="m").OR.&M
&I SETB ("&B"="I").OR.("&B"="i").OR.&I
.A
&LAB REP #&M*32+&I*16
AIF .NOT.&M,.B
LONGA ON
.B
AIF .NOT.&I,.C
LONGI ON
.C
MEND
MACRO
&LAB PL4 &N1
LCLC &C
&LAB ANOP
AIF S:LONGA=1,.A
REP #%00100000
.A
&C AMID &N1,1,1
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.F
&N1 AMID &N1,2,L:&N1-2
PLA
STA (&N1)
LDY #2
PLA
STA (&N1),Y
AGO .D
.B
AIF "&C"<>"[",.C
PLA
STA &N1
LDY #2
PLA
STA &N1,Y
AGO .D
.C
PLA
STA &N1
PLA
STA &N1+2
.D
AIF S:LONGA=1,.E
SEP #%00100000
.E
MEXIT
.F
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB SHORT &A,&B
LCLB &I
LCLB &M
&A AMID &A,1,1
&M SETB ("&A"="M").OR.("&A"="m")
&I SETB ("&A"="I").OR.("&A"="i")
AIF C:&B=0,.A
&B AMID &B,1,1
&M SETB ("&B"="M").OR.("&B"="m").OR.&M
&I SETB ("&B"="I").OR.("&B"="i").OR.&I
.A
&LAB SEP #&M*32+&I*16
AIF .NOT.&M,.B
LONGA OFF
.B
AIF .NOT.&I,.C
LONGI OFF
.C
MEND
MACRO
&LAB EXECUTE &DCB
&LAB ~SETM
JSL $E100A8
DC I2'$010D'
DC I4'&DCB'
~RESTM
MEND
MACRO
&LAB _LONGMUL
&LAB LDX #$0C0B
JSL $E10000
MEND
MACRO
&LAB LLA &AD1,&AD2
&LAB ANOP
LCLA &L
LCLB &LA
AIF S:LONGA,.A
REP #%00100000
LONGA ON
&LA SETB 1
.A
LDA #&AD2
&L SETA C:&AD1
.B
STA &AD1(&L)
&L SETA &L-1
AIF &L,^B
LDA #^&AD2
&L SETA C:&AD1
.C
STA 2+&AD1(&L)
&L SETA &L-1
AIF &L,^C
AIF &LA=0,.D
SEP #%00100000
LONGA OFF
.D
MEND
MACRO
&LAB SUB2 &N1,&N2,&N3
AIF C:&N3,.A
LCLC &N3
&N3 SETC &N1
.A
&LAB ~SETM
SEC
~LDA &N1
~OP SBC,&N2
~STA &N3
~RESTM
MEND
MACRO
&LAB READ_VARIABLE &DCB
&LAB ~SETM
JSL $E100A8
DC I2'$010B'
DC I4'&DCB'
~RESTM
MEND
macro
&l pl8 &n1
lclc &c
&l anop
aif s:longa=1,.a
rep #%00100000
.a
&c amid &n1,1,1
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.f
&n1 amid &n1,2,l:&n1-2
pla
sta (&n1)
ldy #2
pla
sta (&n1),y
ldy #4
pla
sta (&n1),y
ldy #6
pla
sta (&n1),y
ago .d
.b
aif "&c"<>"[",.c
pla
sta &n1
ldy #2
pla
sta &n1,y
ldy #4
pla
sta &n1,y
ldy #6
pla
sta &n1,y
ago .d
.c
pla
sta &n1
pla
sta &n1+2
pla
sta &n1+4
pla
sta &n1+6
.d
aif s:longa=1,.e
sep #%00100000
.e
mexit
.f
mnote "Missing closing '}'",16
mend
macro
&l jge &bp
&l blt *+5
brl &bp
mend
macro
&l jeq &bp
&l bne *+5
brl &bp
mend