gno/bin/gsh/M/invoke.mac

 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 SetInGlobals &a1
&lab ph2 &a1(1)
 ph2 &a1(2)
 Tool $090c
 mend
 MACRO
&lab jeq &loc
&lab bne *+5
 jmp &loc
 mend
 MACRO
&lab tool &a1
&lab ldx #&a1
 jsl $e10000
 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 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 GSStr &string
&lab dc i2'L:&string'
 dc c"&string"
 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 Open &a1
&lab gsos $2010,&a1
 mend
 MACRO
&lab Close &a1
&lab gsos $2014,&a1
 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 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 tcnewpgrp &a1
&lab ph2 &a1
 case on
 jsl tcnewpgrp
 case off
 MEND
 MACRO
&lab settpgrp &a1
&lab ph2 &a1
 case on
 jsl settpgrp
 case off
 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 jne &loc
&lab beq *+5
 jmp &loc
 mend
 MACRO
&lab gsos &a1,&a2
&lab jsl $E100A8
 dc i2'&a1'
 dc i4'&a2'
 mend
 MACRO
&lab PopVariables &a1
&lab p16 $117,&a1
 mend
 MACRO
&lab PushVariables &a1
&lab p16 $118,&a1
 mend
 MACRO
&lab p16 &a1,&a2
&lab jsl $E100A8
 dc i2'&a1'
 dc i4'&a2'
 mend
 MACRO
&lab SetPrefix &a1
&lab gsos $2009,&a1
 mend
 MACRO
&lab GetFileInfo &a1
&lab gsos $2006,&a1
 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 REDIRECT &a1
&lab p16 $110,&a1
 mend
 MACRO
&lab fork &a1
&lab ph4 &a1
 case on
 jsl fork
 case off
 MEND
 macro
&lab SetInputDevice &a1
&lab ph2 &a1(1)
 ph4 &a1(2)
 Tool $0f0c
 mend
 macro
&lab SetOutputDevice &a1
&lab ph2 &a1(1)
 ph4 &a1(2)
 Tool $100c
 mend
 MACRO
&lab tctpgrp &a1
&lab ph2 &a1(2)
 ph2 &a1(1)
 case on
 jsl tctpgrp
 case off
 MEND
 MACRO
&lab dup2 &a1
&lab ph2 &a1(2)
 ph2 &a1(1)
 case on
 jsl dup2
 case off
 MEND
 MACRO
&lab swait &a1
&lab ph2 &a1
 case on
 jsl swait
 case off
 MEND
 MACRO
&lab ssignal &a1
&lab ph2 &a1
 case on
 jsl ssignal
 case off
 MEND
 MACRO
&lab screate &a1
&lab ph2 &a1
 case on
 jsl screate
 case off
 MEND
 MACRO
&lab sdelete &a1
&lab ph2 &a1
 case on
 jsl sdelete
 case off
 MEND
 macro
&lab NewHandle &a1,&a2
&lab pha
 pha
 ph4 &a1(1)
 ph2 &a1(2)
 ph2 &a1(3)
 ph4 &a1(4)
 tool $0902
 pl4 &a2
 mend
 macro
&lab FindHandle &a1,&a2
&lab pha
 pha
 ph4 &a1
 tool $1a02
 pl4 &a2
 mend
 macro
&lab PtrToHand &a1
&lab ph4 &a1(1)
 ph4 &a1(2)
 ph4 &a1(3)
 tool $2802
 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 kill &a1
&lab ph2 &a1(2)
 ph2 &a1(1)
 case on
 jsl kill
 case off
 MEND
 MACRO
&lab getpgrp &a1
&lab ph2 &a1
 case on
 jsl getpgrp
 case off
 MEND
 MACRO
&lab sigpause &a1
&lab ph4 &a1
 case on
 jsl sigpause
 case off
 MEND
 MACRO
&lab signal &a1
&lab ph4 &a1(2)
 ph2 &a1(1)
 case on
 jsl signal
 case off
 MEND