gno/bin/gsh/M/builtin.mac

775 lines
9.4 KiB
Plaintext

MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab if2 &var,&rel,&val,&label
&lab ago .skip
ble
bgt
.skip
lclc &char1
lclc &char2
&char1 amid &var,1,1
&char2 amid &var,2,1
aif "&char1"="@",.index
lda &var
.cmp
cmp &val
ago .branch
.index
aif "&char2"="x",.x1
aif "&char2"="X",.x1
aif "&char2"="y",.y1
aif "&char2"="Y",.y1
ago ^cmp
.x1
cpx &val
ago .branch
.y1
cpy &val
.branch
&char1 amid &rel,1,1
aif "&char1"="@",.done
b&rel &label
.done
mend
MACRO
&lab bgt &loc
&lab beq *+4
bcs &loc
mend
MACRO
&lab ble &loc
&lab bcc &loc
beq &loc
mend
MACRO
&lab sub2 &arg1,&arg2,&dest
lclc &char
&lab sec
&char amid &arg1,1,1
aif "&char"="@",.at1
lda &arg1
ago .sub
.at1
&char amid &arg1,2,1
aif "&char"="x",.x1
aif "&char"="X",.x1
aif "&char"="y",.y1
aif "&char"="Y",.y1
ago .sub
.x1
txa
ago .sub
.y1
tya
.sub
sbc &arg2
&char amid &dest,1,1
aif "&char"="@",.at2
sta &dest
ago .b
.at2
&char amid &dest,2,1
aif "&char"="x",.x2
aif "&char"="X",.x2
aif "&char"="y",.y2
aif "&char"="Y",.y2
ago .b
.x2
tax
ago .b
.y2
tay
.b
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab ph4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk1
rep #%00100000
.chk1
aif "&char"<>"{",.chk2
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
ldy #2
lda (&parm),y
pha
lda (&parm)
pha
ago .shorten
.chk2
aif "&char"<>"[",.absolute
ldy #2
lda &parm,y
pha
lda &parm
pha
ago .shorten
.absolute
lda &parm+2
pha
lda &parm
pha
ago .shorten
.at
&char1 amid &parm,2,1
&char2 setc &char1
ph&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
ph&char2
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea +(&parm)|-16
pea &parm
ago .done
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab MV2 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
macro
&lab jcs &loc
&lab bcc *+5
jmp &loc
mend
MACRO
&lab LD2 &val,&adr
&lab lcla &count
lda #&val
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
MACRO
&lab ora2 &arg1,&arg2,&dest
&lab anop
lclc &char
&char amid &arg1,1,1
aif "&char"="@",.at1
lda &arg1
ago .add
.at1
&char amid &arg1,2,1
aif "&char"="x",.x1
aif "&char"="X",.x1
aif "&char"="y",.y1
aif "&char"="Y",.y1
ago .add
.x1
txa
ago .add
.y1
tya
.add
ora &arg2
&char amid &dest,1,1
aif "&char"="@",.at2
sta &dest
ago .b
.at2
&char amid &dest,2,1
aif "&char"="x",.x2
aif "&char"="X",.x2
aif "&char"="y",.y2
aif "&char"="Y",.y2
ago .b
.x2
tax
ago .b
.y2
tay
.b
mend
MACRO
&lab subroutine &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 c:&parms
.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+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &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+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab READ_VARIABLE &a1
&lab p16 $10B,&a1
mend
MACRO
&lab Str &string
&lab dc i1'L:&string'
dc c"&string"
mend
MACRO
&lab add2 &arg1,&arg2,&dest
lclc &char
&lab clc
&char amid &arg1,1,1
aif "&char"="@",.at1
lda &arg1
ago .add
.at1
&char amid &arg1,2,1
aif "&char"="x",.x1
aif "&char"="X",.x1
aif "&char"="y",.y1
aif "&char"="Y",.y1
ago .add
.x1
txa
ago .add
.y1
tya
.add
adc &arg2
&char amid &dest,1,1
aif "&char"="@",.at2
sta &dest
ago .b
.at2
&char amid &dest,2,1
aif "&char"="x",.x2
aif "&char"="X",.x2
aif "&char"="y",.y2
aif "&char"="Y",.y2
ago .b
.x2
tax
ago .b
.y2
tay
.b
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab Dec2Int &a1,&a2
&lab pha
ph4 &a1(1)
ph2 &a1(2)
ph2 &a1(3)
Tool $280b
pl2 &a2
mend
MACRO
&lab p16 &a1,&a2
&lab jsl $E100A8
dc i2'&a1'
dc i4'&a2'
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab pl2 &parm
lclc &char
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"="@",.at
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ago .shorten
.absolute
pla
sta &parm
ago .shorten
.at
&char amid &parm,2,1
pl&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing Closing '}'",16
mend
MACRO
&lab Int2Dec &a1
&lab ph2 &a1(1)
ph4 &a1(2)
ph2 &a1(3)
ph2 &a1(4)
Tool $260b
mend
MACRO
&lab GetPrefix &a1
&lab gsos $200A,&a1
mend
MACRO
&lab ERROR &a1
&lab p16 $105,&a1
mend
MACRO
&lab asl2 &a
&lab asl &a
asl &a
mend
MACRO
&lab LD4 &val,&adr
&lab lcla &count
lda #<&val
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda #+(&val)|-16
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
macro
&lab inc2 &a
&lab inc &a
inc &a
mend
MACRO
&lab gsos &a1,&a2
&lab jsl $E100A8
dc i2'&a1'
dc i4'&a2'
mend
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab SetPrefix &a1
&lab gsos $2009,&a1
mend
MACRO
&lab GetFileInfo &a1
&lab gsos $2006,&a1
mend
MACRO
&lab dey2
&lab dey
dey
mend
macro
&lab GetBootVol &a1
&lab gsos $2028,&a1
mend
macro
&lab Volume &a1
&lab gsos $2008,&a1
mend
macro
&lab DInfo &a1
&lab gsos $202C,&a1
mend
macro
&lab Long2Dec &a1
&lab ph4 &a1(1)
ph4 &a1(2)
ph2 &a1(3)
ph2 &a1(4)
Tool $270b
mend
macro
&lab LongMul &a1,&a2
&lab pha
pha
pha
pha
ph4 &a1(1)
ph4 &a1(2)
Tool $0c0b
pl4 &a2(1)
pl4 &a2(2)
mend
macro
&lab LongDivide &a1,&a2
&lab pha
pha
pha
pha
ph4 &a1(1)
ph4 &a1(2)
Tool $0d0b
pl4 &a2(1)
pl4 &a2(2)
mend
macro
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab setdebug &a1
&lab ph2 &a1
case on
jsl setdebug
case off
MEND
MACRO
&lab kvm_open
&lab case on
jsl kvm_open
case off
MEND
MACRO
&lab kvm_close &a1
&lab ph4 &a1
case on
jsl kvm_close
case off
MEND
MACRO
&lab kvmnextproc &a1
&lab ph4 &a1
case on
jsl kvmnextproc
case off
MEND
macro
&lab Int2Hex &a1
&lab ph2 &a1(1)
ph4 &a1(2)
ph2 &a1(3)
Tool $220b
mend
MACRO
&lab kvmgetproc &a1
&lab ph2 &a1(2)
ph4 &a1(1)
case on
jsl kvmgetproc
case off
MEND
MACRO
&lab unlock &a1
&lab stz &a1
MEND
MACRO
&lab key
&lab dc i2'0'
MEND
MACRO
&lab lock &a1
&lab lda #1
tsb &a1
beq *+6
cop $7F
bra *-7
MEND
MACRO
&lab jcc &loc
&lab bcs *+5
jmp &loc
mend
macro
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab getuid
&lab case on
jsl getuid
case off
MEND
macro
&lab UDivide &a1,&a2
&lab pha
pha
ph2 &a1(1)
ph2 &a1(2)
Tool $0b0b
pl2 &a2(1)
pl2 &a2(2)
mend