CNVZ80B1


{   (C) Copyright 1982 by Motorola Inc.   }    
{**********convert Z80 to MC68000 source utility **********}
ÿ{ subroutines }
 
subprogram convert (input,output,infile,outfile);
 
 
 
const    imagelen = 100; {input line length}
         labellen = 7;   { label length (+:) }
         charlen  = 80;  { general character length }
 
 
type     labels = string[labellen];
         chars = string[charlen];
         oprtype = (Dreg,Areg,         { registers }
                    Dindirect,Aindirect,{ indirect reference }
                    Aindpointer,       { pointer on stack }
                    IXdisp,IYdisp,     { pointer in Dreg with 
displacement }
                    imaddr,            { immediate address }
                    immed,none);       { immediate data, not set }
         size = (unknown,byte,word);
 
var      image: string[imagelen];      { input image }
         copyimage: string[imagelen];  { print image string }
         lbl: labels;                  { label field }
         opc: chars;                   { opcode field }
         opr1,opr2: chars;             { operands }
         comment: string[imagelen];    { comment }
         opr1type,opr2type: oprtype;   { operand types }
         datalen: size;                { byte or word operation }
         lines: integer;               { input lines read }
         msgs: integer;                { diagnostic count }
         linesout: integer;            { assembler lines into output 
file }
         linesunmatched: integer;      { unconverted lines copied over }
         infile,outfile: text;         { in and out files }
         passthis: boolean;          { pass this record thru unaltered }
         passmode: boolean;            { pass flag for pass mode }
         errormsg: chars;              { error message }
         newEA: chars;                 { replacement EA for data loads }
         ccop: string[2];              { CC operation }
         baseaddr: chars;              { loaddata primary address }
         freshccr: boolean;            { CCR is fresh }
         MC68010: boolean;             { MC68010 target machine }
 
procedure convert;
 
type     errortype = (warning,error);
 
var      spaces: chars;                { blank fill for output control }
 
 
    { diagnostic message procedure }
    procedure diagnostic(severity:errortype; message:chars);
 
    begin
 
      if severity=warning then writeln(outfile,'******** WARNING *** 
',message)
                         else writeln(outfile,'         FAIL 0 **** 
',message);
      writeln('input line',lines:5,' output line',linesout:5,' 
',message);
      linesout := linesout + 1;
      msgs := msgs + 1;
      if severity=error then freshccr := false
      end;
 
    { output 68000 assembly language statement }
    procedure emit(opcode,opr1,opr2: chars);
 
    var  spclbl,spcopc,spccmnt: integer; { format spacing }
 
    { return indication of ccr transparancy }
    function ccrclobbered: boolean;
 
        var rawopcode: string[10];
            destisAn: boolean;
            work: integer;
 
        begin
           ccrclobbered := true;
           work := pos(opcode,'.');
           { strip length specification }
           if work > 0 then rawopcode := copy(opcode,1,work-1)
                   else rawopcode := opcode;
           destisAn := false;
           if length(opr2)=2 then if (opr2[1]='A') and (opr2[2] in 
['0'..'7'])
                                       then destisAn := true;
           if pos('EXG LEA LINK MOVEM MOVEP PEA UNLK NOP ',
                 concat(rawopcode,' ')) > 0 then ccrclobbered := false;
           if ((rawopcode='ADD') or (rawopcode='SUB') or 
(rawopcode='MOVE'))
                   and destisAn then ccrclobbered := false;
           if (rawopcode='MOVE') and (opr1='SR') then ccrclobbered := 
false;
           if length(rawopcode)=3 then if rawopcode[1]='B' then
                                       ccrclobbered := false
           end;
 
 
    begin
 
         comment := '';       { do not print duplicate comment field }
 
         if length(opr2) > 0 then opr2 := concat(',',opr2);
         spclbl := 10 - length(lbl);
         if spclbl < 1 then spclbl := 1;
         spcopc := 10 - length(opcode);
         if spcopc < 1 then spcopc := 1;
         spccmnt := 19 - length(opr1) - length(opr2) -1;
         if spccmnt < 1 then spccmnt := 1;
         writeln(outfile,lbl,copy(spaces,1,spclbl),  { label field }
                 opcode,copy(spaces,1,spcopc),       { opcode field }
                 opr1,opr2,copy(spaces,1,spccmnt),   { comment field }
                 ' ',comment);
         if ccrclobbered then freshccr := false;
         linesout := linesout + 1;
         comment := '';
         lbl := ''
         end;
 
   { procedure to emit with size specification added }
    procedure emitsz(opcode,opr1,opr2: chars);
         begin  if datalen=byte then emit(concat(opcode,'B'),opr1,opr2)
                                else emit(concat(opcode,'W'),opr1,opr2)
                end;
 
   { procedure to set psuedo carry to x bit of CCR }
   procedure refreshccr;
         begin
              if not freshccr then emit('MOVE.W','D1','CCR')
              end;
 
   { procedure to update psuedo Z80 condition code }
   procedure saveccr;
         begin
            if MC68010 then emit('MOVE.W','CCR','D1')
                       else emit('MOVE.W','SR','D1');
            freshccr := true
            end;
 
   { procedure to set S, Z, and V  CC bits (all but C) }
   procedure setszv;
         begin
            emit('BSR','...SETSZV','');
            freshccr := true
         end;
 
   { procedure to set only C CC bit }
   procedure setc;
         begin
            emit('BSR','...SETC','');
            freshccr := true
         end;
 
   { procedure to clear C CC bit }
   procedure clearc;
         begin
            emit('AND.B','D5','D1')
         end;
 
 
   { procedure to setup operand addressability }
   procedure loadaddr(addr:chars; addrtype:oprtype);
     begin
      case addrtype of
      Dreg,Areg,Aindirect,imaddr: newEA := addr;
      Dindirect,Aindpointer: begin
                          emit('MOVE.W',addr,'A0');
                          newEA := '(A0)'
                          end;
      IXdisp: begin
                          emit('MOVE.W','D6','A0');
                          newEA := concat(addr,'(A0)')
                          end;
      IYdisp: begin
                          emit('MOVE.W','D7','A0');
                          newEA := concat(addr,'(A0)')
                          end;
      immed: newEA := concat('#',addr)
             end;
      end;
 
 
   { procedure to load data into data register }
   procedure loaddata(source,dest:chars; srctype:oprtype);
        begin
          if srctype=Dreg then begin
                             newEA := source;
                             baseaddr := source
                             end
                   else begin
                             loadaddr(source,srctype);
                             baseaddr := newEA;
                             emitsz('MOVE.',newEA,dest);
                             newEA := dest
                             end
          end;
 
 
   { procedure to store register into destination }
   procedure storedata(source,dest:chars; desttype:oprtype);
        begin
              loadaddr(dest,desttype);
              emitsz('MOVE.',source,newEA)
              end;
 
   { procedure to store register back to original load }
   procedure storeback(source: chars);
         begin
              if source<>baseaddr then emitsz('MOVE.',source,baseaddr)
         end;
 
 
   { procedure to convert CC into opposite condition code format }
   procedure scancc;
        begin
              if opr1='(A2)' then opr1 := 'C '; { taken as a register }
              if opr1='C ' then begin
                             emit('BTST.L','#4','D1');
                             ccop := 'EQ' { carry set }
                             end
                 else if opr1='NC' then begin
                             emit('BTST.L','#4','D1');
                             ccop := 'NE' { carry clear }
                             end
                 else if opr1='M ' then ccop := 'PL' { minus }
                 else if opr1='P ' then ccop := 'MI' { plus }
                 else if opr1='Z ' then ccop := 'NE' { zero }
                 else if opr1='NZ' then ccop := 'EQ' { not zero }
                 else if opr1='PE' then ccop := 'VC' { overflow set }
                 else if opr1='PO' then ccop := 'VS'; { overflow clear }
              if not ((opr1='C ') or (opr1='NC')) then refreshccr;
              if (opr1='PO') or (opr1='PE') then
                diagnostic(warning,'P/V branch test unsupported if for 
parity')
              end;
 
   { procedure to emit branch }
   procedure emitbranch;
 
         begin
             if opr2type=none then emit('BRA',opr1,'')
                else begin
                        scancc;
                        if ccop='CC' then ccop := 'CS'
                          else if ccop='CS' then ccop := 'CC'
                          else if ccop='PL' then ccop := 'MI'
                          else if ccop='MI' then ccop := 'PL'
                          else if ccop='VC' then ccop := 'VS'
                          else if ccop='VS' then ccop := 'VC'
                          else if ccop='EQ' then ccop := 'NE'
                          else if ccop='NE' then ccop := 'EQ';
                     emit(concat('B',ccop),opr2,'');
                     end
             end;
 
   { function to return low byte register pair pointer given pair }
   function lowbyte(pair:chars): chars;
      begin
         if pair='(A1)' then lowbyte := '(A2)'
           else if pair='(A3)' then lowbyte := '(A4)'
           else if pair='(SP)' then lowbyte := '(A5)'
      end;
 
   { procedure to handle DEFB }
   procedure DEFB;
 
   var x,y: integer;
       inrange: boolean;
 
   begin
         x := pos(image,concat(' ',opr1)) + 1;
         y := x-1;
         inrange := true;
         while inrange do begin
             y := y + 1;
             if image[y]='''' then repeat y:=y+1 until image[y]='''';
             if image[y] in [' ',';'] then begin
                   inrange := false;
                   y := y - 1
                   end;
             if y=length(image) then inrange := false
             end;
         emit('DC.B',copy(image,x,y-x+1),'')
         end; {DEFB}
 
 
   { procedure to handle DEFW supporting optional multiple fields }
   procedure DEFW;
 
   var x: integer;
       parse: string[imagelen];
 
   begin
 
         x := pos(image,concat(' ',opr1)) + 1;
         parse := delete(image,1,x-1);
         while length(parse) > 0 do begin { emit subgroups }
              opr1 := '';
              x := 0;
              while length(opr1) = 0 do begin { scan for terminator }
                   x := x + 1;
                   case parse[x] of
                     '''': repeat x:=x + 1 until parse[x]='''';
                     ',':  begin
                                opr1 := copy(parse,1,x-1);
                                parse := delete(parse,1,x)
                                end;
                     ' ',';': begin
                                opr1 := copy(parse,1,x-1);
                                parse := ''
                                end;
                     otherwise if x=length(parse) then begin
                                opr1 := parse;
                                parse := ''
                                end
                           end {case}
                   end; {scan terminator}
                emit('DC.B',concat(
                       '(',opr1,')-((',opr1,')/256)*256,(',opr1,')/256') 
,'')
              end {emit subgroups}
         end; {DEFW}
 
 
 
begin {convert}
 
spaces := '                                                    ';
 
if (length(errormsg)=0) and (not passthis) then begin
         writeln(outfile,'* ',copyimage);
         linesout := linesout + 1;
         if lbl <> ' ' then freshccr := false
         end
   else begin { do not process statement }
         passthis := true;
         linesout := linesout + 1;
         writeln(outfile,image);
         if length(errormsg)>0 then diagnostic(error,errormsg);
         end;
 
 
if not passthis then
      if opc = 'ADC' then begin
         if opr1='D0' then begin { A destination }
                loaddata(opr2,'D2',opr2type);
                refreshccr;
                emit('ADDX.B',newEA,'D0');
                saveccr
                end
           else if opr2='A6' then begin {SP to HL}
                loaddata(opr1,'D2',opr1type);
                emit('MOVE.W','A6','D3');
                refreshccr;
                emit('ADDX.W','D3',newEA);
                saveccr;
                storedata(newEA,opr1,opr1type)
                end
           else begin {BC,DE,HL to HL}
                emit('LEA',opr2,'A0');
                refreshccr;
                emit('ADDX.W','-(A0)','-(SP)');
                saveccr;
                emit('ADD.W','#2','SP')
                end
         end
 
   else if opc = 'ADD' then begin
         if opr1='D0' then begin { destination is A }
                loadaddr(opr2,opr2type);
                emitsz('ADD.',newEA,opr1);
                saveccr
                end
           else begin  { destination must be HL,IX,IY }
                if opr1type=Dreg then loadaddr(opr2,opr2type)
                    else loaddata(opr2,'D2',opr2type);
                emit('ADD.W',newEA,opr1);
                setc
                end
         end
 
   else if opc = 'AND' then begin
                loadaddr(opr1,opr1type);
                emit('AND.B',newEA,'D0');
                saveccr;
                clearc
                end
 
   else if opc = 'BIT' then begin
                loadaddr(opr2,opr2type);
                refreshccr;
                if opr2type=Dreg then 
emit('BTST.L',concat('#',opr1),newEA)
                   else emit('BTST.B',concat('#',opr1),newEA);
                saveccr
                end
 
   else if opc = 'CALL' then begin
                if opr2type=none then emit('LEA',opr1,'A0')
                   else begin
                      emit('LEA',opr2,'A0');
                      scancc;
                      emit(concat('B',ccop,'.S'),'*+6','')
                      end;
                emit('BSR','...CALL','');
                freshccr := false
                end
 
   else if opc = 'CCF' then emit('EOR.B','#$11','D1')
 
   else if opc = 'CP' then begin
                emit('MOVE.B','D0','D2');
                loadaddr(opr1,opr1type);
                emit('SUB.B',newEA,'D2');
                saveccr
                end
 
   else if opc = 'CPIR' then emit('BSR','...CPIR','')
 
   else if opc = 'CPI' then emit('BSR','...CPI','')
 
   else if opc = 'CPD' then emit('BSR','...CPD','')
 
   else if opc = 'CPDR' then emit('BSR','...CPDR','')
 
   else if opc = 'CPL' then emit('NOT.B','D0','')
 
   else if opc = 'DAA' then diagnostic(error,'DAA cannot be converted')
 
   else if opc = 'DEC' then
                case datalen of
                   byte: begin
                          loadaddr(opr1,opr1type);
                          emit('SUB.B','#1',newEA);
                          setszv
                          end;
                   word: emit('SUB.W','#1',opr1);
                         end
 
   else if opc = 'DEFB' then DEFB
 
   else if opc = 'DEFM' then emit('DC.B',opr1,'')
 
   else if opc = 'DEFL' then emit('SET',opr1,'')
 
   else if opc = 'DEFS' then emit('DS.B',opr1,'')
 
   else if opc = 'DEFW' then DEFW
 
   else if (opc = 'DI') or (opc = 'EI') then
                diagnostic(error,'DI/EI interrupts require rewrite')
 
   else if opc = 'DJNZ' then begin
                emit('SUB.B','#1','(A1)');
                emit('BNE',opr1,'')
                end
 
   else if opc = 'EJECT' then emit('PAGE','','')
 
   else if opc = 'END' then begin
                if opr1[1] in ['0'..'9'] then
                     diagnostic(error,'fixed address untranslatable');
                if length(opr1)>1 then if
                 ((opr1[1] in ['$','@','%']) and (opr1[2] in 
['0'..'9']))
                     then diagnostic(error,'fixed address 
untranslatable');
                emit('END',opr1,'')
                end
 
   else if opc = 'EQU' then emit('EQU',opr1,'')
 
   else if opc = 'EX' then begin
                if opr1='(A6)' then begin  { (SP),XX }
                     if opr2='(SP)' then emit('BSR','...EXHL','')
                        else if opr2='D6' then emit('BSR','...EXIX','')
                        else if opr2='D7' then emit('BSR','...EXIY','')
                     end
                  else if opr1='(A3)' then begin { DE,HL }
                             emit('MOVE.W',opr1,'D2');
                             emit('MOVE.W',opr2,opr1);
                             emit('MOVE.W','D2',opr2)
                             end
                  else if opr1='AF' then begin { AF,AF' }
                             emit('SWAP.W','D0','');
                             emit('SWAP.W','D1','')
                             end
                  end
 
   else if opc = 'EXX' then emit('BSR','...EXX','')
 
   else if opc = 'HALT' then begin
                emit('STOP','#0','');
                diagnostic(warning,'HALT simulated with STOP 
instruction')
                end
 
   else if opc = 'IM' then diagnostic(error,
                             'IM - set interrupt mode not convertable')
 
   else if opc = 'IN' then diagnostic(error,'IN instruction 
unconvertable')
 
   else if opc = 'INC' then
                case datalen of
                   byte: begin
                          loadaddr(opr1,opr1type);
                          emit('ADD.B','#1',newEA);
                          setszv
                          end;
                   word: emit('ADD.W','#1',opr1);
                         end
 
   else if (opc='IND') or (opc='INDR') or (opc='INI') or (opc='INIR')
                then diagnostic(error,'IND/INDR/INI/INIR I/O 
untranslatable')
 
   else if opc = 'JP' then begin
                if opr1type in [Aindpointer,Dindirect] then begin
                        loadaddr(opr1,opr1type);
                        emit('JMP','(A0)','')
                        end
                   else if opr2type=none then emit('BRA',opr1,'')
                   { conditional jump }
                   else emitbranch
                end
 
   else if opc = 'JR' then begin
                emitbranch;
                if pos(concat(opr1,opr2),'-$') > 0 then 
diagnostic(error,
                             'absolute branch displacements 
untranslatable')
                end
 
   else if opc = 'LD' then begin
                case datalen of
                 { byte moves }
                 byte: case opr1type of
                    IXdisp,IYdisp,Aindpointer,Dindirect: begin
                        loadaddr(opr1,opr1type);
                        if opr2type=immed then opr2 := concat('#',opr2);
                        emit('MOVE.B',opr2,newEA)
                        end;
                    otherwise begin
                        loadaddr(opr2,opr2type);
                        emit('MOVE.B',newEA,opr1)
                        end
                      end;
                 { word moves }
                 word: case opr1type of
                     imaddr: case opr2type of { opr1 is address }
                         Dreg,Areg: begin  { opr2 in register }
                             emit('MOVE.W',opr2,'-(SP)');
                             emit('MOVE.B','1(SP)',opr1);
                             emit('MOVE.B','(SP)+',concat(opr1,'+1'))
                             end;
                         otherwise begin { create a pointer }
                             loadaddr(opr2,opr2type);
                             emit('MOVE.B',lowbyte(opr2),opr1);
                             emit('MOVE.B',opr2,concat(opr1,'+1'))
                             end
                          end;
                     Aindirect: case opr2type of
                           imaddr: begin
                             emit('MOVE.B',opr2,lowbyte(opr1));
                             emit('MOVE.B',concat(opr2,'+1'),opr1)
                             end;
                           otherwise begin
                             loadaddr(opr2,opr2type);
                             emit('MOVE.W',newEA,opr1)
                             end
                         end; { indirect }
                     Dreg,Areg: case opr2type of
                           imaddr: begin
                             emit('MOVE.B',concat(opr2,'+1'),'-(SP)');
                             emit('MOVE.B',opr2,'1(SP)');
                             emit('MOVE.W','(SP)+',opr1)
                             end;
                           otherwise begin
                             loadaddr(opr2,opr2type);
                             emit('MOVE.W',newEA,opr1)
                             end
                         end { Dreg,Areg }
                     end { word }
                 end { case }
            end { LD }
 
   else if opc = 'LDIR' then emit('BSR','...LDIR','')
 
   else if opc = 'LDI' then emit('BSR','...LDI','')
 
   else if opc = 'LDD' then emit('BSR','...LDD','')
 
   else if opc = 'LDDR' then emit('BSR','...LDDR','')
 
   else if opc = 'NEG' then begin
                emit('NEG.B','D0','');
                saveccr
                end
 
   else if opc = 'NOP' then emit('NOP','','')
 
   else if opc = 'OR' then begin
                loadaddr(opr1,opr1type);
                emit('OR.B',newEA,'D0');
                saveccr;
                clearc
                end
 
   else if opc = 'ORG' then begin
                emit('ORG',opr1,'');
                diagnostic(warning,'''ORG'' encountered')
                end
 
   else if opc = 'OUT' then diagnostic(error,'OUT I/O untranslatable')
 
   else if (opc='OUTD') or (opc='OTDR') or (opc='OUTI') or (opc='OTIR')
              then diagnostic(error,'OUTD/OTDR/OUTI/OTIR I/O 
untranslatable')
 
   else if opc = 'POP' then
                case opr1type of
                 Dreg: begin
                   emit('MOVE.B','1(A6)','-(SP)');
                   emit('MOVE.B','(A6)','1(SP)');
                   emit('MOVE.W','(SP)+',opr1);
                   emit('ADD.W','#2','A6')
                   end;
                 Aindirect: begin
                   emit('MOVE.B','(A6)+',lowbyte(opr1));
                   emit('MOVE.B','(A6)+',opr1)
                   end;
                 otherwise begin
                   diagnostic(warning,'flags read as MC68000 CCR 
format');
                   emit('MOVE.B','(A6)+','D1');
                   emit('MOVE.B','(A6)+','D0')
                   end;
                 end
 
   else if opc = 'PUSH' then
                case opr1type of
                 Dreg: begin
                   emit('MOVE.W',opr1,'-(SP)');
                   emit('MOVE.B','1(SP)','-(A6)');
                   emit('MOVE.B','(SP)+','-(A6)')
                   end;
                 Aindirect: begin
                   emit('MOVE.B',opr1,'-(A6)');
                   emit('MOVE.B',lowbyte(opr1),'-(A6)')
                   end;
                 otherwise begin
                   diagnostic(warning,'flags stored as MC68000 CCR 
format');
                   emit('MOVE.B','D0','-(A6)');
                   emit('MOVE.B','D1','-(A6)');
                   end;
                 end
 
   else if opc = 'RES' then begin
                loadaddr(opr2,opr2type);
                refreshccr;
                if opr2type=Dreg then 
emit('BCLR.L',concat('#',opr1),newEA)
                   else emit('BCLR.B',concat('#',opr1),newEA);
                saveccr
                end
 
   else if opc = 'RET' then begin
                if opr1type=none then opr1 := '...RET'
                   else begin
                        opr2 := '...RET';
                        opr2type := imaddr
                        end;
                emitbranch
                end
 
   else if (opc = 'RETI') or (opc = 'RETN') then
                diagnostic(error,'RETI/RETN interrupt returns 
untranslatable')
 
   else if opc = 'RL' then begin
                loaddata(opr1,'D2',opr1type);
                refreshccr;
                emit('ADDX.B',newEA,newEA);
                saveccr;
                storeback(newEA)
                end
 
   else if opc = 'RLA' then begin
               refreshccr;
               emit('ADDX.B','D0','D0');
               setc
               end
 
   else if opc = 'RLC' then begin
                loaddata(opr1,'D2',opr1type);
                emit('ROL.B','#1',newEA);
                saveccr;
                storeback(newEA)
                end
 
   else if opc = 'RLCA' then begin
               emit('ROL.B','#1','D0');
               setc
               end
 
   else if opc = 'RLD' then emit('BSR','...RLD','')
 
   else if opc = 'RR' then begin
                loaddata(opr1,'D2',opr1type);
                refreshccr;
                emit('ROXR.B','#1',newEA);
                saveccr;
                storeback(newEA)
                end
 
   else if opc = 'RRA' then begin
               refreshccr;
               emit('ROXR.B','#1','D0');
               setc
               end
 
   else if opc = 'RRC' then begin
                loaddata(opr1,'D2',opr1type);
                refreshccr;
                emit('ROR.B','#1',newEA);
                saveccr;
                storeback(newEA)
                end
 
   else if opc = 'RRCA' then begin
               emit('ROR.B','#1','D0');
               setc
               end
 
   else if opc = 'RRD' then emit('BSR','...RRD','')
 
   else if opc = 'RST' then diagnostic(error,'RST restart 
untranslatable')
 
   else if opc = 'SBC' then begin
         if opr1='D0' then begin { A destination }
                loaddata(opr2,'D2',opr2type);
                refreshccr;
                emit('SUBX.B',newEA,'D0');
                saveccr
                end
           else if opr2='A6' then begin {SP to HL}
                loaddata(opr1,'D2',opr1type);
                emit('MOVE.W','A6','D3');
                refreshccr;
                emit('SUBX.W','D3',newEA);
                saveccr;
                storedata(newEA,opr1,opr1type)
                end
           else begin {BC,DE,HL to HL}
                emit('LEA',opr2,'A0');
                refreshccr;
                emit('SUBX.W','-(A0)','-(SP)');
                saveccr;
                emit('ADD.W','#2','SP')
                end
         end
 
   else if opc = 'SCF' then emit('OR.B','#$10','D1')
 
   else if opc = 'SET' then begin
                loadaddr(opr2,opr2type);
                refreshccr;
                if opr2type=Dreg then 
emit('BSET.L',concat('#',opr1),newEA)
                   else emit('BSET.B',concat('#',opr1),newEA);
                saveccr
                end
 
   else if opc = 'SLA' then begin
                loaddata(opr1,'D2',opr1type);
                emit('ADD.B',newEA,newEA);
                saveccr;
                storeback(newEA)
                end
 
   else if opc = 'SRA' then begin
                loaddata(opr1,'D2',opr1type);
                emit('ASR.B','#1',newEA);
                saveccr;
                storeback(newEA)
                end
 
   else if opc = 'SRL' then begin
               loaddata(opr1,'D2',opr1type);
               emit('LSR.B','#1','D2');
               saveccr;
               storeback(newEA)
               end
 
   else if opc = 'SUB' then begin
                loadaddr(opr1,opr1type);
                emit('SUB.B',newEA,'D0');
                saveccr
                end
 
   else if opc = 'XOR' then begin
                loaddata(opr1,'D2',opr1type);
                emit('EOR.B',newEA,'D0');
                saveccr;
                clearc
                end
 
   else if (length(opc)=0) and (length(lbl)>0) then begin
                { only label on stmt }
                lbl := concat(lbl,':');
                emit('EQU','*','');
                diagnostic(warning,'label may need word alignment')
                end
 
   else begin
         linesout := linesout + 1;
         writeln(outfile,image);
         diagnostic(error,'this statement unidentified');
         linesunmatched := linesunmatched + 1
         end;
 
end.