Apple-2-SW/antoine-source
1
0
Fork 0
mirror of https://github.com/antoinevignau/source.git synced 2025-01-01 15:30:02 +00:00
Code Issues Projects Releases Wiki Activity
14d02c2ab0
antoine-source/appleworksgs/Macros/m16.stack
Antoine Vignau 5fef614692 First release
2023-03-04 03:45:20 +01:00

1 line
48 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

*-------------------------------------------------------------------------*
* Xtool
*
* Xtool functions like the macro tool but its input/output/err parameters
* are defined before the macro call with the macros in, out, and err.
*-------------------------------------------------------------------------*
MACRO
xtool &toolname,&err
lcla &outnum
lcla &innum
lclc &size
lclc &parm
lcla &count
gbla &xincnt
gblc &xin[20]
gbla &xoutcnt
gblc &xout[20]
gbla &xerrflag
gblc &xerr
&count seta &xoutcnt+1
WHILE (&count>1) DO
&count seta &count-1
&size setc &substr(&xout[&count],&len(&xout[&count])-1,2)
IF (&size=':r') or (&size=':R') GOTO .rect
IF (&size=':l') or (&size=':L') GOTO .long
IF (&size=':a') or (&size=':A') GOTO .addr
IF (&size=':w') or (&size=':W') GOTO .word
IF (&size=':b') or (&size=':B') GOTO .byte
macerr 'XTool macro: Output parameter size improperly specified: Ò',&xout[&count],'Ó'
MEXIT
.addr
pha
.byte
phb
CYCLE
.rect pha
pha
.long
pha
.word
pha
ENDWHILE
&count seta 0
WHILE (&count<&xincnt) DO
&count seta &count+1
&size setc &substr(&xin[&count],&len(&xin[&count])-1,2)
&parm setc &substr(&xin[&count],1,&len(&xin[&count])-2)
IF (&size=':r') or (&size=':R') GOTO .rect
IF (&size=':l') or (&size=':L') GOTO .long
IF (&size=':a') or (&size=':A') GOTO .addr
IF (&size=':w') or (&size=':W') GOTO .word
IF (&size=':b') or (&size=':B') GOTO .byte
macerr 'XTool macro: Input parameter size improperly specified: Ò',&xin[&count],'Ó'
MEXIT
.rect
pushrect &parm
CYCLE
.long
PushLong &parm
CYCLE
.addr
PushAdr &parm
CYCLE
.word
PushWord &parm
CYCLE
.byte
PushByte &parm
ENDWHILE
&toolname
IF &len(&err)=0 GOTO .noname
moveword a,&err
GOTO .noerr
.noname
IF &xerrflag=0 GOTO .noerr
sta &xerr
.noerr
&count seta &xoutcnt+1
WHILE (&count>1) DO
&count seta &count-1
IF &len(&xout[&count])<3 THEN ; leave it on the stack.
CYCLE
ENDIF
&size setc &substr(&xout[&count],&len(&xout[&count])-1,2)
&parm setc &substr(&xout[&count],1,&len(&xout[&count])-2)
IF (&size=':r') or (&size=':R') GOTO .rect
IF (&size=':l') or (&size=':L') GOTO .long
IF (&size=':a') or (&size=':A') GOTO .addr
IF (&size=':w') or (&size=':W') GOTO .word
IF (&size=':b') or (&size=':B') GOTO .byte
macerr 'XTool macro: Output parameter size improperly specified: Ò',&xout[&count],'Ó'
MEXIT
.rect
pullrect &parm
CYCLE
.long
PullLong &parm
CYCLE
.addr
PullAdr &parm
CYCLE
.word
PullWord &parm
CYCLE
.byte
PullByte &parm
ENDWHILE
.quit
&xerrflag seta 0
&xoutcnt seta 0
&xincnt seta 0
&xerr setc ''
MEND
*-------------------------------------------------------------------------*
* XCall
*
* XCall functions like the macro Call but its input/output/err parameters
* are defined before the macro call with the macros in, out, and err.
*-------------------------------------------------------------------------*
MACRO
xcall &name,&err
lcla &outnum
lcla &innum
lclc &size
lclc &parm
lcla &count
gbla &xincnt
gblc &xin[20]
gbla &xoutcnt
gblc &xout[20]
gbla &xerrflag
gblc &xerr
&count seta &xoutcnt+1
WHILE (&count>1) DO
&count seta &count-1
&size setc &substr(&xout[&count],&len(&xout[&count])-1,2)
IF (&size=':r') or (&size=':R') GOTO .rect
IF (&size=':l') or (&size=':L') GOTO .long
IF (&size=':a') or (&size=':A') GOTO .addr
IF (&size=':w') or (&size=':W') GOTO .word
IF (&size=':b') or (&size=':B') GOTO .byte
macerr 'XCall macro: Output parameter size improperly specified: Ò',&xout[&count],'Ó'
MEXIT
.addr
pha
.byte
phb
CYCLE
.rect
pha
pha
.long
pha
.word
pha
ENDWHILE
&count seta 0
WHILE (&count<&xincnt) DO
&count seta &count+1
&size setc &substr(&xin[&count],&len(&xin[&count])-1,2)
&parm setc &substr(&xin[&count],1,&len(&xin[&count])-2)
IF (&size=':r') or (&size=':R') GOTO .rect
IF (&size=':l') or (&size=':L') GOTO .long
IF (&size=':a') or (&size=':A') GOTO .addr
IF (&size=':w') or (&size=':W') GOTO .word
IF (&size=':b') or (&size=':B') GOTO .byte
macerr 'XCall macro: Input parameter size improperly specified: Ò',&xin[&count],'Ó'
MEXIT
.rect
pushrect &parm
CYCLE
.long
PushLong &parm
CYCLE
.addr
PushAdr &parm
CYCLE
.word
PushWord &parm
CYCLE
.byte
PushByte &parm
ENDWHILE
jsl &name
IF &len(&err)=0 GOTO .noname
moveword a,&err
GOTO .noerr
.noname
IF &xerrflag=0 GOTO .noerr
sta &xerr
.noerr
&count seta &xoutcnt+1
WHILE (&count>1) DO
&count seta &count-1
IF &len(&xout[&count])<3 THEN ; leave it on the stack.
CYCLE
ENDIF
&size setc &substr(&xout[&count],&len(&xout[&count])-1,2)
&parm setc &substr(&xout[&count],1,&len(&xout[&count])-2)
IF (&size=':r') or (&size=':R') GOTO .rect
IF (&size=':l') or (&size=':L') GOTO .long
IF (&size=':a') or (&size=':A') GOTO .addr
IF (&size=':w') or (&size=':W') GOTO .word
IF (&size=':b') or (&size=':B') GOTO .byte
macerr 'XCall macro: Output parameter size improperly specified: Ò',&xin[&count],'Ó'
MEXIT
.rect
pullrect &parm
CYCLE
.long
PullLong &parm
CYCLE
.addr
PullAdr &parm
CYCLE
.word
PullWord &parm
CYCLE
.byte
PullByte &parm
ENDWHILE
.quit
&xerrflag seta 0
&xoutcnt seta 0
&xincnt seta 0
&xerr setc ''
MEND
*-------------------------------------------------------------------------*
MACRO
in
gblc &xin[20]
gbla &xincnt
lcla &count
lcla &params
&count seta 0
&params seta &nbr(&syslist)
WHILE (&count<&params) DO
&count seta &count+1
&xincnt seta &xincnt+1
IF (&xincnt>20) THEN
macerr 'Too many input parameters for XCall or XTool.'
ENDIF
&xin[&xincnt] setc &syslist[&count]
ENDWHILE
MEND
*-------------------------------------------------------------------------*
MACRO
out
gblc &xout[20]
gbla &xoutcnt
lcla &count
lcla &params
&count seta 0
&params seta &nbr(&syslist)
WHILE (&count<&params) DO
&count seta &count+1
&xoutcnt seta &xoutcnt+1
IF (&xoutcnt>20) THEN
macerr 'Too many output parameters for XCall or XTool.'
ENDIF
&xout[&xoutcnt] setc &syslist[&count]
ENDWHILE
MEND
*-------------------------------------------------------------------------*
MACRO
xerr &errlabel
gbla &xerrflag
gblc &xerr
&xerrflag seta 1
&xerr setc &errlabel
MEND
;...........................................................................;
;
; generic call subroutine macro
;
; call RoutineName,in=(Parm1:L,Parm2:W),out=(Out1:L,Out2:W),err
;
; This macro will push enough space on the stack for the specified output
; parameters, then push the input parameters in the order given onto stack
; and call the named routine. All parameters must have a size specification
; for this macro to work. The size may be either :w (word) or :l (long).
;
; If an error label is given then the value of the accumulator after the
; call is saved in the given label position.
;...........................................................................;
MACRO
&lab call &name,&in,&out,&err
&lab ;
lcla &outnum
lcla &innum
lcla &count
lclc &insize
lclc &inparm
lclc &outsize
lclc &outparm
lclc &newout[20]
lclc &newin[20]
IF (&nbr(&out)=0) THEN
IF (&out = '') THEN
&outnum seta 0
ELSE
&outnum seta 1
&newout[1] setc &out
ENDIF
ELSE
&outnum seta &nbr(&out)
WHILE (&outnum ­ 0) DO
&newout[&outnum] setc &out[&outnum]
&outnum seta &outnum-1
ENDWHILE
&outnum seta &nbr(&out)
ENDIF
IF (&nbr(&in)=0) THEN
IF (&in = '') THEN
&innum seta 0
ELSE
&innum seta 1
&newin[1] setc &in
ENDIF
ELSE
&innum seta &nbr(&in)
WHILE (&innum ­ 0) DO
&newin[&innum] setc &in[&innum]
&innum seta &innum-1
ENDWHILE
&innum seta &nbr(&in)
ENDIF
&count seta &outnum
IF &outnum=0 GOTO .nooutput
.outloop
&outsize setc &substr(&newout[&count],&len(&newout[&count])-1,2)
IF (&outsize=':l') or (&outsize=':L') GOTO .long
IF (&outsize=':w') or (&outsize=':W') GOTO .word
IF (&outsize=':a') or (&outsize=':A') GOTO .addr
IF (&outsize=':b') or (&outsize=':B') GOTO .byte
IF (&outsize=':r') or (&outsize=':R') GOTO .rect
macerr 'Call macro: Parameter size not specified.'
mexit
.addr
pha
.byte
PushByte a
GOTO .xx
.rect
pha
pha
.long
pha
.word
pha
.xx
&count seta &count-1
IF &count GOTO .outloop
.nooutput
&count seta 1
IF &innum=0 GOTO .noinput
.inloop
IF &len(&newin[&count])<3 GOTO .nextin
&insize setc &substr(&newin[&count],&len(&newin[&count])-1,2)
&inparm setc &substr(&newin[&count],1,&len(&newin[&count])-2)
IF (&insize=':l') or (&insize=':L') GOTO .long
IF (&insize=':w') or (&insize=':W') GOTO .word
IF (&insize=':a') or (&insize=':A') GOTO .addr
IF (&insize=':b') or (&insize=':B') GOTO .byte
IF (&insize=':r') or (&insize=':R') GOTO .rect
macerr 'Call macro: Parameter size not specified.'
mexit
.rect
pushrect &inparm
GOTO .nextin
.addr
PushAdr &inparm
GOTO .nextin
.byte
PushByte &inparm
GOTO .nextin
.long
PushLong &inparm
GOTO .nextin
.word
PushWord &inparm
.nextin
&count seta &count+1
IF &count>&innum GOTO .noinput
GOTO .inloop
.noinput
jsl &name
IF &type('&err')='UNDEFINED' GOTO .dopull
IF &nbr(&err)=0 THEN
IF (&err='') GOTO .dopull
moveword a,&err
ELSE
moveword a,&err[1]
ENDIF
.dopull
&count seta &outnum
IF &count>0 GOTO .getout
mexit
.getout
IF &len(&newout[&count])<3 GOTO .nextout
&outsize setc &substr(&newout[&count],&len(&newout[&count])-1,2)
&outparm setc &substr(&newout[&count],1,&len(&newout[&count])-2)
IF (&outsize=':l') or (&outsize=':L') GOTO .long
IF (&outsize=':w') or (&outsize=':W') GOTO .word
IF (&outsize=':a') or (&outsize=':A') GOTO .addr
IF (&outsize=':b') or (&outsize=':B') GOTO .byte
IF (&outsize=':r') or (&outsize=':R') GOTO .rect
macerr 'Call macro: Parameter size not specified.'
mexit
.rect
pullrect &outparm
GOTO .nextout
.addr
PullAdr &outparm
GOTO .nextout
.byte
PullByte &outparm
GOTO .nextout
.word
PullWord &outparm
GOTO .nextout
.long
PullLong &outparm
.nextout
&count seta &count-1
IF &count GOTO .getout
.quit
mexit
MEND
;...........................................................................;
;
; generic tool call subroutine macro
;
; tool RoutineName,in=(Parm1:L,Parm2:W),out=(Out1:L,Out2:W),err
;
; This macro will push enough space on the stack for the specified output
; parameters, then push the input parameters in the order given onto stack
; and call the named routine. All parameters must have a size specification
; for this macro to work. The size may be either :w (word) or :l (long).
;
; If an error label is given then the value of the accumulator after the
; call is saved in the given label position.
;...........................................................................;
MACRO
&lab tool &name,&in,&out,&err
&lab ;
lcla &outnum
lcla &innum
lcla &count
lclc &insize
lclc &inparm
lclc &outsize
lclc &outparm
lclc &newout[20]
lclc &newin[20]
IF (&nbr(&out)=0) THEN
IF (&out = '') THEN
&outnum seta 0
ELSE
&outnum seta 1
&newout[1] setc &out
ENDIF
ELSE
&outnum seta &nbr(&out)
WHILE (&outnum ­ 0) DO
&newout[&outnum] setc &out[&outnum]
&outnum seta &outnum-1
ENDWHILE
&outnum seta &nbr(&out)
ENDIF
IF (&nbr(&in)=0) THEN
IF (&in = '') THEN
&innum seta 0
ELSE
&innum seta 1
&newin[1] setc &in
ENDIF
ELSE
&innum seta &nbr(&in)
WHILE (&innum ­ 0) DO
&newin[&innum] setc &in[&innum]
&innum seta &innum-1
ENDWHILE
&innum seta &nbr(&in)
ENDIF
&count seta &outnum
IF &outnum=0 GOTO .nooutput
.outloop
&outsize setc &substr(&newout[&count],&len(&newout[&count])-1,2)
IF (&outsize=':l') or (&outsize=':L') GOTO .long
IF (&outsize=':w') or (&outsize=':W') GOTO .word
IF (&outsize=':a') or (&outsize=':A') GOTO .addr
IF (&outsize=':b') or (&outsize=':B') GOTO .byte
macerr 'Tool macro: Parameter size not specified.'
mexit
.addr
pha
.byte
PushByte a
GOTO .xx
.long
pha
.word
pha
.xx
&count seta &count-1
IF &count GOTO .outloop
.nooutput
&count seta 1
IF &innum=0 GOTO .noinput
.inloop
IF &len(&newin[&count])<3 GOTO .nextin
&insize setc &substr(&newin[&count],&len(&newin[&count])-1,2)
&inparm setc &substr(&newin[&count],1,&len(&newin[&count])-2)
IF (&insize=':l') or (&insize=':L') GOTO .long
IF (&insize=':w') or (&insize=':W') GOTO .word
IF (&insize=':a') or (&insize=':A') GOTO .addr
IF (&insize=':b') or (&insize=':B') GOTO .byte
macerr 'Tool macro: Input parameter size not specified.'
mexit
.addr
PushAdr &inparm
GOTO .nextin
.byte
PushByte &inparm
GOTO .nextin
.long
PushLong &inparm
GOTO .nextin
.word
PushWord &inparm
.nextin
&count seta &count+1
IF &count>&innum GOTO .noinput
GOTO .inloop
.noinput
&name
IF &type('&err')='UNDEFINED' GOTO .dopull
IF &nbr(&err)=0 THEN
IF (&err='') GOTO .dopull
moveword a,&err
ELSE
moveword a,&err[1]
ENDIF
.dopull
&count seta &outnum
IF &count>0 GOTO .getout
mexit
.getout
IF &len(&newout[&count])<3 GOTO .nextout
&outsize setc &substr(&newout[&count],&len(&newout[&count])-1,2)
&outparm setc &substr(&newout[&count],1,&len(&newout[&count])-2)
IF (&outsize=':l') or (&outsize=':L') GOTO .long
IF (&outsize=':w') or (&outsize=':W') GOTO .word
IF (&outsize=':a') or (&outsize=':A') GOTO .addr
IF (&outsize=':b') or (&outsize=':B') GOTO .byte
macerr 'Tool macro: Parameter size not specified.'
mexit
.addr
PullAdr &outparm
GOTO .nextout
.byte
PullByte &outparm
GOTO .nextout
.word
PullWord &outparm
GOTO .nextout
.long
PullLong &outparm
.nextout
&count seta &count-1
IF &count GOTO .getout
.quit
mexit
MEND
*===========================================================================*
;-------------------------------------------------------------------------------
MACRO
input
GBLC &ginput[20]
GBLA &gincnt
LCLA &count
LCLA &limit
&count SETA 0
&limit SETA &nbr(&syslist)
WHILE (&count<&limit) DO
&gincnt SETA &gincnt+1
&count SETA &count+1
&ginput[&gincnt] SETC &syslist[&count]
ENDWHILE
MEND
;-------------------------------------------------------------------------------
MACRO
output
GBLC &goutput[20]
GBLA &goutcnt
LCLA &count
LCLA &limit
&count SETA 0
&limit SETA &nbr(&syslist)
WHILE (&count<&limit) DO
&goutcnt SETA &goutcnt+1
&count SETA &count+1
&goutput[&goutcnt] SETC &syslist[&count]
ENDWHILE
MEND
;-------------------------------------------------------------------------------
MACRO
local
GBLC &glocal[40]
GBLA &gloccnt
LCLA &count
LCLA &limit
&count SETA 0
&limit SETA &nbr(&syslist)
WHILE (&count<&limit) DO
&gloccnt SETA &gloccnt+1
&count SETA &count+1
&glocal[&gloccnt] SETC &syslist[&count]
ENDWHILE
MEND
;-------------------------------------------------------------------------------
MACRO
error &op1
GBLC &glocal[40]
GBLA &gloccnt
GBLC &gerror
GBLA &reterr
&reterr SETA 1
IF &nbr(&syslist)=0 THEN
&gerror SETC 'a'
MEXIT
ENDIF
&gerror SETC &op1
IF &op1­'a' THEN
&gloccnt SETA &gloccnt+1
&glocal[&gloccnt] SETC &concat(&op1,':w')
ENDIF
MEND
;-------------------------------------------------------------------------;
MACRO
begin &op1
LCLC &Pname
LCLC &length
LCLA &loccnt
LCLA &locsize
LCLA &incnt
LCLA &inpsize
LCLA &outcnt
LCLA &outsize
GBLA &inbegin
IF (&inbegin = 1) THEN
macerr 'ÔBeginÕ without a ÔReturnÕ'
ENDIF
&inbegin seta 1
GBLC &ginput[20]
GBLA &gincnt
GBLC &goutput[20]
GBLA &goutcnt
GBLC &glocal[40]
GBLA &gloccnt
GBLC &gerror
GBLA &reterr
GBLA &glink
GBLA &gbank
IF (&gincnt+&goutcnt+&gloccnt=0) GOTO .done
;--------------------Locals
IF (&gloccnt=0) GOTO .skip4
&loccnt SETA &gloccnt+1
WHILE (&loccnt>1) DO
&loccnt SETA &loccnt-1
&Pname SETC &substr(&glocal[&loccnt],1,&len(&glocal[&loccnt])-2)
&length SETC &substr(&glocal[&loccnt],&len(&glocal[&loccnt])-1,2)
IF (&substr(&Pname,1,1)­'!') THEN
IF (&ENTERSYM(&SYSLOCAL,&UPCASE(&PNAME),1+&locsize,0)=0) THEN
macerr 'Begin macro: Could not enter label into symbol table.'
ENDIF
ELSE
&Pname SETC &substr(&Pname,2,&len(&Pname)-1)
IF (&ENTERSYM(&SYSGLOBAL,&UPCASE(&PNAME),1+&locsize,0)=0) THEN
macerr 'Begin macro: Could not enter label into symbol table'
ENDIF
ENDIF
IF (&length=':b') THEN
&locsize SETA &locsize+1
CYCLE
ELSEIF (&length=':w') THEN
&locsize SETA &locsize+2
CYCLE
ELSEIF (&length=':a') THEN
&locsize SETA &locsize+3
CYCLE
ELSEIF (&length=':l') THEN
&locsize SETA &locsize+4
CYCLE
ELSEIF (&length=':r') THEN
&locsize SETA &locsize+8
CYCLE
ELSEIF (&length=':x') THEN
&locsize SETA &locsize+10
CYCLE
ELSE
macerr 'Begin macro: Bad local specification "',&PName,'"'
MEXIT
ENDIF
ENDWHILE
.skip4
;--------------------Inputs
IF (&gincnt=0) GOTO .skip5
&incnt SETA &gincnt+1
WHILE (&incnt>1) DO
&incnt SETA &incnt-1
&Pname SETC &substr(&ginput[&incnt],1,&len(&ginput[&incnt])-2)
&length SETC &substr(&ginput[&incnt],&len(&ginput[&incnt])-1,2)
IF (&substr(&Pname,1,1)­'!') THEN
IF (&ENTERSYM(&SYSLOCAL,&UPCASE(&PNAME),6+&locsize+&inpsize,0)=0) THEN
macerr 'Begin macro: Could not enter label Ò',&UPCASE(&PNAME),'Ó into symbol table'
ENDIF
ELSE
&Pname SETC &substr(&Pname,2,&len(&Pname)-1)
IF (&ENTERSYM(&SYSGLOBAL,&UPCASE(&PNAME),6+&locsize+&inpsize,0)=0) THEN
macerr 'Begin macro: Could not enter label Ò',&UPCASE(&PNAME),'Ó into symbol table'
ENDIF
ENDIF
IF (&length=':b') THEN
&inpsize SETA &inpsize+1
CYCLE
ELSEIF (&length=':w') THEN
&inpsize SETA &inpsize+2
CYCLE
ELSEIF (&length=':a') THEN
&inpsize SETA &inpsize+3
CYCLE
ELSEIF (&length=':l') THEN
&inpsize SETA &inpsize+4
CYCLE
ELSEIF (&length=':r') THEN
&inpsize SETA &inpsize+8
CYCLE
ELSEIF (&length=':x') THEN
&inpsize SETA &inpsize+10
CYCLE
ELSE
macerr 'Begin macro: Bad input specification "',&PName,'"'
MEXIT
ENDIF
ENDWHILE
.skip5
&glink SETA 1
; Change equates to ENTERSYMs to allow multiple begin-returns in a single code segment
IF (&ENTERSYM(&SYSLOCAL,'LOCALS',1,0)=0) THEN
macerr 'Begin macro: Could not enter LOCALS into symbol table'
MEXIT
ENDIF
IF (&ENTERSYM(&SYSLOCAL,'INPUT',&locsize+5+1,0)=0) THEN
macerr 'Begin macro: Could not enter INPUT into symbol table'
MEXIT
ENDIF
IF (&ENTERSYM(&SYSLOCAL,'OUTPUT',&locsize+5+1+&inpsize,0)=0) THEN
macerr 'Begin macro: Could not enter OUTPUT into symbol table'
MEXIT
ENDIF
.* locals equ 1
.* input equ &locsize+5+locals
.* output equ input+&inpsize
phd ; push current DP
tsc
IF &locsize­0 THEN ; make stack space
sec ; for local variables
sbc #&locsize
tcs
ENDIF
tcd ; set new DP
;--------------------Outputs
IF (&goutcnt=0) GOTO .done
&outcnt SETA &goutcnt+1
WHILE (&outcnt>1) DO
&outcnt SETA &outcnt-1
&Pname SETC &substr(&goutput[&outcnt],1,&len(&goutput[&outcnt])-2)
&length SETC &substr(&goutput[&outcnt],&len(&goutput[&outcnt])-1,2)
IF (&substr(&Pname,1,1)­'!') THEN
IF (&ENTERSYM(&SYSLOCAL,&UPCASE(&PNAME),6+&locsize+&inpsize+&outsize,0)=0) THEN
macerr 'Begin macro: Could not enter label Ò',&UPCASE(&PNAME),'Ó into symbol table'
ENDIF
ELSE
&Pname SETC &substr(&Pname,2,&len(&Pname)-1)
IF (&ENTERSYM(&SYSGLOBAL,&UPCASE(&PNAME),6+&locsize+&inpsize+&outsize,0)=0) THEN
macerr 'Begin macro: Could not enter label Ò',&UPCASE(&PNAME),'Ó into symbol table'
ENDIF
ENDIF
IF (&length=':b') THEN
&outsize SETA &outsize+1
CYCLE
ELSEIF (&length=':w') THEN
&outsize SETA &outsize+2
CYCLE
ELSEIF (&length=':a') THEN
&outsize SETA &outsize+3
CYCLE
ELSEIF (&length=':l') THEN
&outsize SETA &outsize+4
CYCLE
ELSEIF (&length=':r') THEN
&outsize SETA &outsize+8
CYCLE
ELSEIF (&length=':x') THEN
&outsize SETA &outsize+10
CYCLE
ELSE
macerr 'Begin macro: Bad output specification "',&PName,'"'
MEXIT
ENDIF
ENDWHILE
.done
IF &nbr(&syslist)=0 GOTO .skip6
IF (&op1­'+b') AND (&op1­'+B') GOTO .skip6
&gbank seta 1
phb
phk
plb
.skip6
MEND
;--------------------------------------------------------------------------
MACRO
&lab return &op1
&lab
GBLC &gerror
GBLA &reterr
GBLA &gbank
GBLA &glink
GBLA &gloccnt
GBLA &gincnt
GBLA &goutcnt
GBLA &inbegin
IF (&inbegin=0) THEN
macerr 'ÔReturnÕ without a ÔBeginÕ'
MEXIT
ENDIF
&inbegin SETA 0
IF &nbr(&syslist) THEN
&reterr SETA 1
&gerror SETC &op1
ENDIF
IF &gbank THEN
plb
ENDIF
IF &glink THEN
IF &reterr THEN
IF &gerror­'a' THEN
ldy &gerror
ELSE
tay
ENDIF
ENDIF
IF input­output THEN
lda input-2 ;move return address
sta output-2
lda input-3
sta output-3
lda input-5 ; reset old DP
tcd
tsc ; reset stack pointer
clc
adc #output-4
tcs
ELSE
IF input­6 THEN
tsc ; reset stack pointer
clc
adc #output-6
tcs
ENDIF
pld ; reset old DP
ENDIF
IF &reterr THEN
tya
cmp #1
ENDIF
ELSEIF &reterr THEN ; nolink
IF &gerror­'a' THEN
lda &gerror
ENDIF
cmp #1
ENDIF
rtl
&gbank SETA 0
&glink SETA 0
&reterr SETA 0
&gloccnt SETA 0
&gincnt SETA 0
&goutcnt SETA 0
&gerror SETC ''
MEND
;---------------------------------------------------------------------------
;
; Allocate the Local Space on the stack,
; Use Stack Space as the new Zero Page,
; Create labels to the input and output parameters
; if SizeLocals is not specified, does'nt make local space.
;
; link SizeInput [,SizeLocals] or links SizeInput [,SizeLocals]
;
;
;
; (stack before macro)
;
; | output space |
; | _ _ _ _ _ _ _ _ _ _ _ _ _ _ |
; | |
; | input space |
; |_____________________________|
; |_ _|
; |_ RTA _|
; |_____________________________|
; <= SP
;
;
; (stack after macro)
;
; | output space |
; | _ _ _ _ _ _ _ _ _ _ _ _ _ _ | <= output
; | |
; | input space |
; |_____________________________| <= input
; |_ _|
; |_ RTA _|
; |_____________________________|
; |_ old DP _|
; |_____________________________|
; | |
; | local variables |
; | _ _ _ _ _ _ _ _ _ _ _ _ _ _ |
; <= SP <= DP
;...........................................................................;
MACRO
&lab link &SizeInput,&SizeLocals
&lab
IF (&nbr(&syslist)=2) GOTO .a
LCLC &SizeLocals
&SizeLocals SETC 0
.a
IF (&type('locals')='EQU') THEN
macerr 'Multiple ÔbeginÕ statements.'
MEXIT
ENDIF
locals equ 1
input equ &SizeLocals+5+locals
output equ input+&SizeInput
phd ; push current DP
tsc
IF &SizeLocals=0 GOTO .b ; make stack space
sec ; for local variables
sbc #&SizeLocals
tcs
.b
tcd
MEND
;.............................................................................
;
; Unlink the Local Space, restore the previous Zero Page,
; Pull the input parameters off the stack, push the RTL address
; Adjust Carry according to Error Status (in accumulator)
;
; unlink_err, unlink
;..............................................................................
MACRO
&lab unlink_err &err
&lab ;
IF &nbr(&syslist) GOTO .here
tay ; save 'a' register
GOTO .there
.here
ldy &err
.there
IF input=output GOTO .a
lda input-2 ; move return address
sta output-2
lda input-3
sta output-3
lda input-5 ; reset old DP
tcd
tsc ; reset stack pointer
clc
adc #output-4
tcs
GOTO .b
.a
IF input=6 GOTO .f
tsc ; reset stack pointer
clc
adc #output-6
tcs
.f
pld ; reset old DP
.b
tya ; reset 'a' and status
cmp #1 ; register
MEND
;------------------------------------------------------------------------------
MACRO
&lab unlink
&lab ;
IF input=output GOTO .a
lda input-2 ;move return address
sta output-2
lda input-3
sta output-3
lda input-5 ; reset old DP
tcd
tsc ; reset stack pointer
clc
adc #output-4
tcs
MEXIT
.a
IF input=6 GOTO .f
tsc ; reset stack pointer
clc
adc #output-6
tcs
.f
pld ; reset old DP
MEND
;............................................................................;
;
; Space long (4 bytes) onto stack
;
; spacelong - push 4 bytes on stack
;
;............................................................................;
MACRO
&lab spacelong
&lab ;
pha
pha
MEND
;............................................................................;
;
; Space word (2 bytes) onto stack
;
; spaceword - push 2 bytes on stack
;
;............................................................................;
MACRO
&lab spaceword
&lab ;
pha
MEND
;---------------------------------------------------------------------------
; Push a byte as a word
MACRO
&lab PushWordByte &param
moveword &param,a
and #$FF00
pha
MEND
;---------------------------------------------------------------------------
; Push a word as a long
MACRO
&lab PushLongWord &param
pea 0
pushword &param
MEND
;---------------------------------------------------------------------------
; Push a word as a fixedpoint
MACRO
&lab PushFixWord &param
pushword &param
pea 0
MEND
;---------------------------------------------------------------------------
; Pull a fixedpoint as a word
MACRO
&lab PullFixWord &param
pla
pullword &param
MEND
;----------------------------------------------------------------------
; PushRect
MACRO
&lab pushrect &param
&lab ;
pushlong &param+4
pushlong &param
MEND
;----------------------------------------------------------------------
; PullRect
MACRO
&lab pullrect &param
&lab
IF (&nbr(&syslist)=0) OR (&param='a') THEN
pla
pla
pla
pla
ELSE
pulllong &param
pulllong &param+4
ENDIF
MEND
;---------------------------------------------------------------------------
;............................................................................;
;
; Push aliases
;
;............................................................................;
MACRO
&lab pushb &loc
&lab ;
pushbyte &loc
MEND
MACRO
&lab pushw &loc
&lab ;
pushword &loc
MEND
MACRO
&lab pusha &loc
&lab ;
pushadr &loc
MEND
MACRO
&lab pushl &loc
&lab ;
pushlong &loc
MEND
;............................................................................;
;
; Pull aliases
;
;............................................................................;
MACRO
&lab pullb &loc
&lab ;
pullbyte &loc
MEND
MACRO
&lab pullw &loc
&lab ;
pullword &loc
MEND
MACRO
&lab pulla &loc
&lab ;
pulladr &loc
MEND
MACRO
&lab pulll &loc
&lab ;
pulllong &loc
MEND
;............................................................................;
;
; Push 1 byte word on stack macro
; modified 6/8/88, Scott Lindsey
; to fix pushbyte #const
; and pushbyte dp.addr
; problems.
; PushByte addr PushByte addr:#off
; PushByte a PushByte addr:x PushByte [zp]
; PushByte x PushByte addr:y PushByte [zp]:y
; PushByte y PushByte addr:s PushByte [zp]:off
; PushByte #const PushByte addr:off PushByte [zp]:#off
;
;............................................................................;
MACRO
&lab PushByte &loc
&lab ;
lclc &char
lclc &newloc
lcla &ppos
&newloc setc &loc
IF (&newloc='x') or (&newloc='y') or (&newloc='a') GOTO .doreg
sep #%00100000
longa off
moveword &newloc,a
pha
rep #%00100000
longa on
MEXIT
.doreg
sep #%00110000
longa off
longi off
ph&newloc
rep #%00110000
longa on
longi on
MEND
;............................................................................;
;
; Push 2 byte word on stack macro
;
; Modified 5/88, Scott Lindsey
; to use pei for dp variables.
;
;
; PushWord addr PushWord addr:#off
; PushWord a PushWord addr:x PushWord [zp]
; PushWord x PushWord addr:y PushWord [zp]:y
; PushWord y PushWord addr:s PushWord [zp]:off
; PushWord #const PushWord addr:off PushWord [zp]:#off
;
; Caveat: Since
; Pushword DP
;
; is translated into a 'pei' instruction,
;
; Pushword addr
;
; where addr is an equated address does not work correctly.
; e.g.
;
; Border equ $00C034
;
; pushword Border
;
; would **not** successfully push the contents of 00/C034
;
; also note that the accumulator is not affected by pei,
; so the value of what was pushed does not remain in
; A as it used to... this is for DP variables ONLY.
;............................................................................;
MACRO
&lab PushWord &loc
&lab ;
lclc &newloc
lclc &newloc2
lclc &char
lclc &rest
lclc &disp
lcla &offset
lcla &ppos
&newloc setc &loc
&ppos seta &pos('.',&loc)
IF &ppos=0 GOTO .noeval
eval &newloc
&newloc setc 'a'
.noeval IF &newloc <> '?' GOTO .notfromdc
&newloc setc 'a'
.notfromdc
IF &nbr(&syslist)=0 GOTO .dopush
IF (&newloc='x') or (&newloc='y') or (&newloc='a') GOTO .doreg
&offset seta &pos(':',&newloc)
&char setc &substr(&newloc,1,1)
IF &offset GOTO .dopushoff
IF (&char='#') GOTO .doimm
IF (&char='[') or (&char='>') or (&char='$') GOTO .normal
&offset seta &pos('+',&newloc)
&newloc2 setc &newloc
IF &offset GOTO .rmplus
GOTO .dopei
.rmplus
&newloc2 setc &substr(&newloc,1,&offset-1)
.dopei
.; IF &pos('IMPORT',&type(&newloc2)) GOTO .normal
IF &type(&newloc2) = 'EQU' OR &isint(&newloc2) THEN
IF &eval(&newloc) < 256 THEN
pei &newloc
mexit
ENDIF
ENDIF
.; IF &type(&newloc)­'EQU' GOTO .normal
.; IF not(&findsym(&syslocal,&uc(&newloc))) GOTO .normal
.normal
&offset seta &pos(':',&newloc)
IF &offset GOTO .dopushoff
lda &newloc
pha
mexit
.dopushoff
&rest setc &substr(&newloc,1,&offset-1)
&disp setc &substr(&newloc,&offset+1,&len(&newloc)-&offset)
IF (&disp='x') or (&disp='y') or (&disp='s') GOTO .dopushoffi
IF (&char='[') GOTO .dopushoffzp
ldx &disp
lda &rest,x
pha
mexit
.dopushoffi
lda &rest,&disp
pha
mexit
.dopushoffzp
ldy &disp
lda &rest,y
pha
mexit
.dopush
pha
mexit
.doimm
&char setc &substr(&newloc,2,1)
IF (&char='(') GOTO .doimm2
pea &substr(&newloc,2,&len(&newloc)-1)
mexit
.doimm2
pea &substr(&newloc,3,&len(&newloc)-3)
mexit
.doreg
ph&newloc
MEND
;............................................................................;
;
; Push 3 byte address on stack macro
;
; PushAdr a PushAdr addr:y PushAdr [zp]
; PushAdr #const PushAdr addr:s PushAdr [zp]:y
; PushAdr addr PushAdr addr:off PushAdr [zp]:off
; PushAdr addr:x PushAdr addr:#off PushAdr [zp]:#off
;
;............................................................................;
MACRO
&lab PushAdr &loc
&lab ;
lclc &char
lclc &rest
lclc &disp
lcla &offset
IF (&nbr(&syslist)=0) or (&loc='a') GOTO .dopush
&char setc &substr(&loc,1,1)
IF (&char='#') GOTO .doimm
&offset seta &pos(':',&loc)
IF &offset GOTO .dopushoff
IF (&char='[') GOTO .dopushzp
lda &loc+1
pha
GOTO .dosimple
.dopushzp
ldy #1
lda &loc,y
pha
GOTO .dosimple
.doimm
&rest setc &substr(&loc,2,&len(&loc)-1)
lda #(&rest>>8)
pha
GOTO .dosimple
.dosimple
phb
lda &loc
sta 1,s
mexit
.dopush
pha
phb
mexit
.dopushoff
&rest setc &substr(&loc,1,&offset-1)
&disp setc &substr(&loc,&offset+1,&len(&loc)-&offset)
IF (&char='[') GOTO .dopushoffzp
IF (&disp='s') GOTO .dopushoffs
IF (&disp='x') or (&disp='y') GOTO .dopushoffi
ldx &disp
&disp setc 'x'
.dopushoffi
lda &rest+1,&disp
pha
phb
lda &rest,&disp
sta 1,s
mexit
.dopushoffs
lda &rest,s
tax
lda &rest+1,s
pha
phb
txa
sta 1,s
mexit
.dopushoffzp
IF (&disp='y') GOTO .dopushoffzpy
&char setc &substr(&disp,1,1)
IF (&char='#') GOTO .dopushoffzpimm
ldy &disp
.dopushoffzpy
iny
GOTO .dopushoffzp2
.dopushoffzpimm
ldy &disp+1
.dopushoffzp2
lda &rest,y
pha
phb
dey
lda &rest,y
sta 1,s
MEND
;............................................................................;
;
; Push 4 byte long word on stack macro
;
; Modified 5/88, Scott Lindsey
; to use pei for dp variables.
;
; PushLong a PushLong addr PushLong addr:#off
; PushLong ax PushLong addr:x PushLong [zp]
; PushLong ay PushLong addr:y PushLong [zp]:y
; PushLong xy PushLong addr:s PushLong [zp]:off
; PushLong #const PushLong addr:off PushLong [zp]:#off
;
; Note: If you wish to push the address of a direct page label then use
; the following format: PushLong !label.
;
; Caveat: Since
; Pushlong DP
;
; is translated into two 'pei' instructions,
;
; Pushlong addr
;
; where addr is an equated address does not work correctly.
; e.g.
;
; Border equ $00C034
;
; pushlong Border
;
; would **not** successfully push the contents of 00/C034
;
; also note that the accumulator is not affected by pei,
; so the lower word of what was pushed does not remain in
; A as it used to... this is for DP variables ONLY.
;
;
;............................................................................;
MACRO
&lab PushLong &loc
&lab ;
lclc &newloc
lclc &newloc2
lclc &char
lcla &offset
lclc &rest
lclc &disp
&newloc setc &loc
IF &newloc<>'?' GOTO .notfromdc
&newloc setc 'ax'
.notfromdc
IF &nbr(&syslist)=0 GOTO .dopush
IF (&newloc='a') GOTO .dopush
IF (&newloc='ax') GOTO .dopushax
IF (&newloc='ay') GOTO .dopushay
IF (&newloc='xy') GOTO .dopushxy
&char setc &substr(&newloc,1,1)
IF (&char='#') GOTO .doimm
IF (&char='!') GOTO .dopushlocal
&offset seta &pos(':',&newloc)
IF &offset GOTO .dopushoff
IF (&char='[') GOTO .dopushzp
IF (&char='>') or (&char='$') GOTO .normal
&offset seta &pos('+',&newloc)
&newloc2 setc &newloc
IF &offset GOTO .rmplus
GOTO .dopei
.rmplus
&newloc2 setc &substr(&newloc,1,&offset-1)
.dopei
.; IF &pos('IMPORT',&type(&newloc2)) GOTO .normal
IF &type(&newloc2) = 'EQU' OR &isint(&newloc2) THEN
IF &eval(&newloc) < 256-2 THEN
pei &newloc+2
pei &newloc
mexit
ENDIF
ENDIF
.; IF &type(&newloc2)­'EQU' GOTO .normal
.; IF not(&findsym(&syslocal,&uc(&newloc2))) GOTO .normal
.normal
lda &newloc+2
pha
lda &newloc
pha
mexit
.dopush
pha
pha
mexit
.doimm
&char setc &substr(&loc,2,1)
IF (&char='(') GOTO .doimm2
lclc &immloc
&immloc setc &substr(&newloc,2,&len(&newloc)-1)
pea &immloc>>16
pea |&immloc
mexit
.doimm2
lclc &immloc
&immloc setc &substr(&newloc,3,&len(&newloc)-3)
pea &immloc>>16
pea |&immloc
mexit
.dopushax
phx
pha
mexit
.dopushay
phy
pha
mexit
.dopushxy
phy
phx
mexit
.dopushzp
ldy #2
lda &newloc,y
pha
lda &newloc
pha
mexit
.dopushoff
&rest setc &substr(&newloc,1,&offset-1)
&disp setc &substr(&newloc,&offset+1,&len(&newloc)-&offset)
IF &char='[' GOTO .dopushoffzp
IF (&disp='s') GOTO .dopushoffs
IF (&disp='x') or (&disp='y') GOTO .dopushoffi
ldx &disp
&disp setc 'x'
.dopushoffi
lda &rest+2,&disp
pha
lda &rest,&disp
pha
mexit
.dopushoffs
lda &rest+2,s
pha
lda &rest+2,s
pha
mexit
.dopushoffzp
IF (&disp='y') GOTO .dopushoffzpy
&char setc &substr(&disp,1,1)
IF (&char='#') GOTO .dopushoffzpi
ldy &disp
iny
iny
lda &rest,y
pha
ldy &disp
lda &rest,y
pha
mexit
.dopushoffzpi
ldy &disp+2
lda &rest,y
pha
ldy &disp
lda &rest,y
pha
mexit
.dopushoffzpy
iny
iny
lda &rest,y
pha
dey
dey
lda &rest,y
pha
mexit
.dopushlocal
&newloc setc &substr(&newloc,2,&len(&newloc)-1)
pea $0000
tdc
clc
adc #&newloc
pha
MEND
;............................................................................;
;
; Pull 1 byte word off stack macro
;
; PullByte a PullByte addr:x PullByte [zp]
; PullByte x PullByte addr:y PullByte [zp]:y
; PullByte y PullByte addr:off PullByte [zp]:off
; PullByte addr PullByte addr:#off PullByte [zp]:#off
;
;............................................................................;
MACRO
&lab PullByte &loc
&lab ;
IF (&loc='x') or (&loc='y') GOTO .doreg
sep #%00100000
longa off
PullWord &loc
rep #%00100000
longa on
mexit
.doreg
sep #%00110000
longa off
longi off
PullWord &loc
rep #%00110000
longa on
longi on
MEND
;............................................................................;
;
; Pull 2 byte word off stack macro
;
; PullWord addr
; PullWord PullWord addr:x PullWord [zp]
; PullWord a PullWord addr:y PullWord [zp]:y
; PullWord x PullWord addr:off PullWord [zp]:off
; PullWord y PullWord addr:#off PullWord [zp]:#off
;
;............................................................................;
MACRO
&lab PullWord &loc
&lab ;
lclc &char
lclc &rest
lclc &disp
lcla &offset
lclc &newloc
&newloc setc &loc
IF &newloc<>'?' GOTO .notfromdc
&newloc setc 'a'
.notfromdc
IF &nbr(&syslist)=0 GOTO .dopull
IF (&newloc='x') or (&newloc='y') or (&newloc='a') GOTO .doreg
pla
&char setc &substr(&newloc,1,1)
&offset seta &pos(':',&newloc)
IF &offset GOTO .dopulloff
sta &newloc
mexit
.dopulloff
&rest setc &substr(&newloc,1,&offset-1)
&disp setc &substr(&newloc,&offset+1,&len(&newloc)-&offset)
IF (&disp='x') or (&disp='y') or (&disp='s') GOTO .dopulloffi
IF (&char='[') GOTO .dopulloffzp
ldx &disp
&disp setc 'x'
.dopulloffi
sta &rest,&disp
mexit
.dopulloffzp
ldy &disp
sta &rest,y
mexit
.dopull
pla
mexit
.doreg
pl&newloc
MEND
;............................................................................;
;
; Pull 3 byte address off stack macro
;
; PullAdr a PullAdr [zp]
; PullAdr addr PullAdr addr:off PullAdr [zp]:y
; PullAdr addr:x PullAdr addr:#off PullAdr [zp]:off
; PullAdr addr:y PullAdr [zp]:#off
;
;............................................................................;
MACRO
&lab PullAdr &loc
&lab ;
lclc &char
lclc &rest
lclc &disp
lcla &offset
IF (&nbr(&syslist)=0) or (&loc='a') GOTO .dopull
&char setc &substr(&loc,1,1)
&offset seta &pos(':',&loc)
IF &offset GOTO .dopulloff
phb
pla
xba
sta &loc
IF &char='[' GOTO .dopullzp
pla
sta &loc+1
mexit
.dopullzp
ldy #1
pla
sta &loc,y
mexit
.dopull
phb
pla
pla
mexit
.dopulloff
&rest setc &substr(&loc,1,&offset-1)
&disp setc &substr(&loc,&offset+1,&len(&loc)-&offset)
IF (&char='[') GOTO .dopulloffzp
IF (&disp='x') or (&disp='y') GOTO .dopulloffi
ldx &disp
&disp setc 'x'
GOTO .dopulloffi
.dopulloffzp
IF &disp='y' GOTO .dopulloffzpy
ldy &disp
.dopulloffzpy
phb
pla
xba
sta &rest,y
iny
pla
sta &rest,y
mexit
.dopulloffi
phb
pla
xba
sta &rest,&disp
pla
sta &rest+1,&disp
MEND
;............................................................................;
;
; Pull 4 byte long word off stack macro
;
; PullLong addr
; PullLong a PullLong addr:x PullLong [zp]
; PullLong ax PullLong addr:y PullLong [zp]:y
; PullLong ay PullLong addr:off PullLong [zp]:off
; PullLong xy PullLong addr:#off PullLong [zp]:#off
;
;............................................................................;
MACRO
&lab PullLong &loc
&lab ;
lclc &newloc
lclc &char
lcla &offset
lclc &rest
lclc &disp
&newloc setc &loc
IF &newloc <> '?' GOTO .notfromdc
&newloc setc 'ax'
.notfromdc
IF (&nbr(&syslist)=0) or (&newloc='a') GOTO .dopull
IF (&newloc='ax') GOTO .dopullax
IF (&newloc='ay') GOTO .dopullay
IF (&newloc='xy') GOTO .dopullxy
&char setc &substr(&newloc,1,1)
&offset seta &pos(':',&newloc)
IF &offset GOTO .dopulloff
IF (&char='[') GOTO .dopullzp
pla
sta &newloc
pla
sta &newloc+2
mexit
.dopull
pla
pla
mexit
.dopullax
pla
plx
mexit
.dopullay
pla
ply
mexit
.dopullxy
plx
ply
mexit
.dopullzp
pla
sta &newloc
pla
ldy #2
sta &newloc,y
mexit
.dopulloff
&rest setc &substr(&newloc,1,&offset-1)
&disp setc &substr(&newloc,&offset+1,&len(&newloc)-&offset)
IF &char='[' GOTO .dopulloffzp
IF (&disp='x') or (&disp='y') GOTO .dopulloffi
ldx &disp
&disp setc 'x'
.dopulloffi
pla
sta &rest,&disp
pla
sta &rest+2,&disp
mexit
.dopulloffzp
IF (&disp='y') GOTO .dopulloffzpy
&char setc &substr(&disp,1,1)
IF (&char='#') GOTO .dopulloffzpi
pla
ldy &disp
sta &rest,y
pla
ldy &disp
iny
iny
sta &rest,y
mexit
.dopulloffzpi
pla
ldy &disp
sta &rest,y
pla
ldy &disp+2
sta &rest,y
mexit
.dopulloffzpy
pla
sta &rest,y
pla
iny
iny
sta &rest,y
MEND
Reference in New Issue View Git Blame Copy Permalink