*-------------------------------------------------------------------------* * 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 ¶ms &count seta 0 ¶ms seta &nbr(&syslist) WHILE (&count<¶ms) 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 ¶ms &count seta 0 ¶ms seta &nbr(&syslist) WHILE (&count<¶ms) 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 ¶m moveword ¶m,a and #$FF00 pha MEND ;--------------------------------------------------------------------------- ; Push a word as a long MACRO &lab PushLongWord ¶m pea 0 pushword ¶m MEND ;--------------------------------------------------------------------------- ; Push a word as a fixedpoint MACRO &lab PushFixWord ¶m pushword ¶m pea 0 MEND ;--------------------------------------------------------------------------- ; Pull a fixedpoint as a word MACRO &lab PullFixWord ¶m pla pullword ¶m MEND ;---------------------------------------------------------------------- ; PushRect MACRO &lab pushrect ¶m &lab ; pushlong ¶m+4 pushlong ¶m MEND ;---------------------------------------------------------------------- ; PullRect MACRO &lab pullrect ¶m &lab IF (&nbr(&syslist)=0) OR (¶m='a') THEN pla pla pla pla ELSE pulllong ¶m pulllong ¶m+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