P* * This routine reads in a double argument, e.g. * ARG > ARG or ARG < ARG * * If the & extension is used in the source arg an * error will be generated. * If the & extension is used in the dest arg, * the subsequent arguments are placed in the * queue. * READDOUB JSR READARG LDA ERROR BNE :RTS JSR NEXTCHAR ;Advance to next char BCC :ERR LDA (POINT),Y CMP #'&' ;Is this an extension? BNE :WAHKAR JSR SETQ ;Stick arg into queue INY JSR NEXTCHAR BCC :ERR LDA (POINT),Y CMP #'#' ;Can't be immediate extension! BNE READDOUB :DESTERR LDA #16 ;(Extensions are always dests) STA ERROR :RTS RTS :WAHKAR CMP #'>' ;Is this arg source? BNE :WAHKA LDA QSIZE BNE :SRCERR ;Can't have extensions as SRC JSR SETSRC ;Set SOURCE=ARG :LOOP INY ;Advance past the > or & JSR NEXTCHAR BCC :ERR * GENDEST will catch this, and TEST needs it gone. * LDA (POINT),Y * CMP #'#' ;No immediate dests * BEQ :DESTERR JSR READARG LDA ERROR BNE :DONE JSR NEXTCHAR ;Maybe there's a & LDA (POINT),Y CMP #'&' BNE :CONT JSR SETQ ;If so, then put arg in queue BCC :LOOP ;...and advance! :CONT JMP SETDEST ;(and exit) :SRCERR LDA #22 ;Bad source STA ERROR RTS :WAHKA CMP #'<' BEQ :CONT2 LDA #2 STA ERROR RTS :CONT2 JSR SETDEST INY ;Advance past the < JSR NEXTCHAR BCC :ERR JSR READARG LDA ERROR BNE :DONE JSR NEXTCHAR ;Maybe there's a & LDA (POINT),Y CMP #'&' BEQ :SRCERR ;Oops :CONT3 JMP SETSRC ;(and exit) :ERR LDA #14 STA ERROR :DONE RTS * * BMOVE: Move a byte from one location to another * (SRC) -> (DEST) * BMOVE JSR READDOUB ;Read in the arguments LDA ERROR BNE :DONE JSR GENSRC ;Now generate the proper code! :QLOOP LDA DINST ;Convert dest instr to STA AND #%10011111 STA DINST JSR GENDEST LDA QSIZE ;Handle extra instructions BEQ :DONE ;that may be in the queue JSR GETQ ;Get address out of queue BCS :DONE ;error on C=1 JSR SETDEST ;Set it as destination JMP :QLOOP :DONE RTS * * WMOVE: Move a word (two sequential bytes) from * one location to another. This is basically * equivalent to * BMOVE ARG1 > ARG2 * BMOVE ARG1+1 > ARG2+1 * ITEMP DS 1 ;Just a handy temp storage WMOVE JSR READDOUB ;Read in the arguments LDA ERROR BNE :DONE LDA QSIZE ;Need to be a little trickier STA ITEMP ;so we can reuse addresses. JSR GENSRC ;Now generate the proper code! :QLOOP LDA DINST ;Convert dest instr to STA AND #%10011111 STA DINST JSR GENDEST LDA ITEMP ;Handle extra instructions BEQ :DONE ;that may be in the queue SEC ;Update queue size SBC #6 STA ITEMP JSR DEST2ARG JSR SETQ ;Put current dest into queue JSR GETQ ;Get new address out of queue BCS :DONE ;error on C=1 JSR SETDEST ;Set it as destination JMP :QLOOP :DONE ;Now do the address+1 byte LDA SINST ;Handled differently if LDA # CMP #$A9 BNE :INCADD LDA SHI ;Use the high byte STA SLO JMP :CONT1 :INCADD INC SLO ;Increment the address BNE :CONT1 INC SHI CMP #$A5 ;Zero page mode? BNE :CONT1 ;It is possible that * LDA SINST ;addr equaled $00FF ORA #$08 ;Convert ZP->Absolute STA SINST :CONT1 JSR GENSRC :QLOOP2 ;Instruction is now set up properly INC DLO BNE :CONT2 INC DHI LDA DINST AND #$0F CMP #05 ;ZP? BNE :CONT2 LDA DINST ORA #$08 STA DINST :CONT2 JSR GENDEST LDA QSIZE BEQ :ALLDONE JSR GETQ ;Get address etc. BCS :DONE JSR SETDEST JMP :QLOOP2 :ALLDONE RTS * * The binary operators are all basically identical in * operation. Two variables need to be set up; see * the notes below for WOPER. * * (In particular see why it is DEST oper SRC -> DEST) * MASK DS 1 EXTRAOP DS 1 BOPER JSR READDOUB ;Read in the arguments LDA ERROR BNE :DONE * Because of the way & clauses are handled, the first * address is the first in the queue, and the current * address is the last one read. So we need to fix * that up. JSR DEST2ARG JSR SETQ JSR GETQ JSR SETDEST JSR GENDEST ;Now generate the proper code! LDA SINST ;Convert dest instr to ADC AND #%00011111 ;or whatever. ORA MASK STA SINST LDA EXTRAOP BEQ :SKIP JSR CODEOUT :SKIP JSR GENSRC ;ADC stuff * LDA #00 ;STA immediately, X is already * STA DXINST ;set correctly, so skip it. :QLOOP LDA DINST ;Convert instruction to STA AND #%00011111 ORA #%10000000 STA DINST JSR GENDEST ;And STA it to dest. LDA QSIZE ;Handle extra instructions BEQ :DONE ;that may be in the queue JSR GETQ ;Get address out of queue BCS :DONE ;error on C=1 JSR SETDEST ;Set it as destination JMP :QLOOP :DONE RTS * * Since almost all the word operators have 90% of their * code in common, this is now a subroutine. Two variables * need to be set up, MASK and EXTRAOP. MASK is used to * convert LDA to whatever instruction it is supposed to * be, e.g. * LDA INST * AND #$00011111 * ORA MASK * EXTRAOP is for ADC and SBC, and is an extra opcode to * execute (in particular, CLC/SEC). If zero, it is * not output. * * Because of the way in which WSUB works, the roles * of DEST and SRC need to be interchanged; things are * still stored in DEST, but the operation is * DEST SRC -> DEST as opposed to SRC DEST -> DEST * WOPER JSR READDOUB ;Read in the arguments LDA ERROR BNE :DONE LDA QSIZE ;Need to be a little trickier STA ITEMP ;so we can reuse addresses. JSR DEST2ARG ;Again, make sure first address JSR SETQ ;is first. JSR GETQ JSR SETDEST JSR GENDEST ;Start with DEST JSR GENOPER ;Generate ADC xxx STA xxx etc. :QLOOP LDA ITEMP ;Handle extra instructions BEQ :DONE ;that may be in the queue SEC ;Update queue size SBC #6 STA ITEMP JSR DEST2ARG ;DINST -> INST JSR SETQ ;Put current address into queue BCS :RTS JSR GETQ ;Get new address out of queue BCS :RTS ;error on C=1 JSR SETDEST ;Set it as destination LDA DINST ;Convert dest instr to STA AND #%00011111 ORA #%10000000 STA DINST JSR GENDEST JMP :QLOOP :DONE LDA #00 ;Now do the address+1 byte STA EXTRAOP ;No CLC/SEC second time LDA SINST AND #$0F ;Strip away any mask etc. CMP #$09 ;If immediate mode, then use BNE :INCADR ;the high byte. LDA SHI STA SLO JMP :CONT1 :RTS RTS :INCADR INC SLO ;Increment the address BNE :CONT1 INC SHI CMP #$05 ;Zero page mode? BNE :CONT1 ;It is possible that LDA SINST ;addr equaled $00FF ORA #$08 ;Convert ZP->Absolute STA SINST :CONT1 JSR DEST2ARG ;Get correct address back out. JSR SETQ BCS :ALLDONE JSR GETQ ;This is the first addy in the BCS :ALLDONE ;list now JSR SETDEST INC DLO ;Increment the address BNE :CONT3 INC DHI LDA DINST AND #$0F CMP #$05 ;Zero page mode? BNE :CONT3 ;It is possible that LDA DINST ;addr equaled $00FF ORA #$08 ;Convert ZP->Absolute STA DINST :CONT3 ;Now convert DEST back to LDA LDA DINST AND #$1F ORA #$A0 STA DINST JSR GENDEST JSR GENOPER :QLOOP2 LDA QSIZE BEQ :ALLDONE JSR GETQ ;Instruction is now set up properly BCS :ALLDONE ;i.e. to STA JSR SETDEST INC DLO BNE :CONT2 INC DHI LDA DINST AND #$0F CMP #$05 ;Zero page mode? BNE :CONT2 ;It is possible that LDA DINST ;addr equaled $00FF ORA #$08 ;Convert ZP->Absolute STA DINST :CONT2 JSR GENDEST JMP :QLOOP2 :ALLDONE RTS * * GENOPER generates the ADC xxx STA xxx piece of * code * * It actually does (Operation) SRC STA DEST * GENOPER LDA SINST AND #%00011111 ;Convert to ADC, etc. ORA MASK STA SINST LDA EXTRAOP BEQ :SKIP JSR CODEOUT :SKIP JSR GENSRC LDA DINST ;Convert to STA AND #%00011111 ORA #%10000000 STA DINST JSR GENDEST RTS * * BADD: Add SRC+DEST, result in DEST. * SRC + DEST -> DEST * BADD LDA #%01100000 STA MASK LDA #$18 ;CLC STA EXTRAOP JMP BOPER * * WADD: * SRC + DEST -> DEST * WADD LDA #%01100000 STA MASK LDA #$18 ;CLC STA EXTRAOP JMP WOPER * * BSUB * DEST - SRC -> DEST * BSUB LDA #$E0 STA MASK LDA #$38 ;SEC STA EXTRAOP JMP BOPER * * WSUB * Word subtract * WSUB LDA #$E0 STA MASK LDA #$38 STA EXTRAOP JMP WOPER * * BAND * SRC AND DEST -> DEST * BAND LDA #$20 STA MASK LDA #00 STA EXTRAOP JMP BOPER * * WAND * Word AND * WAND LDA #$20 STA MASK LDA #00 STA EXTRAOP JMP WOPER * * BOR * SRC OR DEST -> DEST * BOR LDA #$00 STA MASK STA EXTRAOP JMP BOPER * * WOR * Word OR * WOR LDA #$00 STA MASK STA EXTRAOP JMP WOPER * * BEOR * SRC EOR DEST -> DEST * BEOR LDA #$40 STA MASK LDA #00 STA EXTRAOP JMP BOPER * * WEOR * Word OR * WEOR LDA #$40 STA MASK LDA #00 STA EXTRAOP JMP WOPER