Dim Version$/"6800/6809 to Z80 assembly source conversion program V1.1"/
!        Program to massage 6800/6809 assembly language source files...
!        into a form a little more convenient for conversion to
!        Intel 8085/Z80.  This program does little more than
!        convert a series of 6800 opcode mnemonics to Digital Research
!        RMAC Z80 opcode (yuk) mnemonics.
!        It also expands tabs into blanks and LowerCases everything.
!
         dim op$(4)
         dim tabs$/10,16,40/,tab$/:9/
         Dim Blanks$/"                          "/
         Dim TranslatedOps$/"ldx ?stx ?sts ?lds ?jsr ?rts ?",...
&                           "beq ?bra ?bne ?bcs ?bcc ?ldaa?staa?",...
&                           "rmb ?fcc ?fdb ?fcb ?bsr ?",...
&                           "ldd ?std ?cmpa?adda?suba?anda?eora?",...
&                           "deca?inca?oraa?sbca?",...
&                           "sec ?clc ?cli ?sei ?",...
&                           "lbeq?lbra?lbne?lbcs?lbcc?lblo?lbhs?",...
&                           "blo ?bhs ?pshx?popx?pshd?popd?"/
         Dim Line$(300),In/1/,Out/2/
         Dim z80correspondingops$[50](6)
         z80correspondingops$(1)="lhld  "
         z80correspondingops$(2)="shld  "
         z80correspondingops$(3)="sspd  "
         z80correspondingops$(4)="lspd  "
         z80correspondingops$(5)="call  "
         z80correspondingops$(6)="ret   "
         z80correspondingops$(7)="jrz   "
         z80correspondingops$(8)="jr    "
         z80correspondingops$(9)="jrnz  "
         z80correspondingops$(10)="jrc   "
         z80correspondingops$(11)="jrnc  "
         z80correspondingops$(12)="lda   "
         z80correspondingops$(13)="sta   "
         z80correspondingops$(14)="ds    "
         z80correspondingops$(15)="db    "
         z80correspondingops$(16)="dw    "
         z80correspondingops$(17)="db    "
         z80correspondingops$(18)="call  "
         z80correspondingops$(19)="lbcd  "
         z80correspondingops$(20)="sbcd  "
         z80correspondingops$(21)="cmp   "
         z80correspondingops$(22)="add   "
         z80correspondingops$(23)="sub   "
         z80correspondingops$(24)="ana   "
         z80correspondingops$(25)="xra   "
         z80correspondingops$(26)="dcr  a"
         z80correspondingops$(27)="inr  a"
         z80correspondingops$(28)="ora   "
         z80correspondingops$(29)="sbb   "
         z80correspondingops$(30)="stc   "
         z80correspondingops$(31)="ana  a"
         z80correspondingops$(32)="ei    "
         z80correspondingops$(33)="di    "
         z80correspondingops$(34)="jz    "
         z80correspondingops$(35)="jmp   "
         z80correspondingops$(36)="jnz   "
         z80correspondingops$(37)="jc    "
         z80correspondingops$(38)="jnc   "
         z80correspondingops$(39)="jc    "
         z80correspondingops$(40)="jnc   "
         z80correspondingops$(41)="jrc   "
         z80correspondingops$(42)="jrnc  "
         z80correspondingops$(43)="pushix"
         z80correspondingops$(44)="popix "
         z80correspondingops$(45)="push b"
         z80correspondingops$(46)="pop  b"

         Print Version$
         Input "Convert what 6800/6809 file? " line$
         Open #In,line$
         Input "Put z80 result where? " Line$
         Create #Out,Line$
loop:    Input #in,line$
         if eof(in) then exit
         let line$=lowercase$(line$)
         until find(line$,tab$)=0 do
               let i=find(line$,tab$)
               for j=1 to len(tabs$) until tabs$(j)>i do ! find tab stop
               if j>len(tabs$)
               then line$(i)=asc(" ")
               else
                   oldlinelength=len(line$)
                   insertedblankcount=tabs$(j)-i \ ! = # blanks to replace tab
                   len(line$)=len(line$)+insertedblankcount-1
!print "before:";line$
!print "len(line$)";len(line$)
!print "insertedblankcount";insertedblankcount
!print "i";i
                   right$(line$,i+insertedblankcount)=...
&                      line$[i+1,oldlinelength-i]
!print " after:";line$
                   for k=i to tabs$(j)-1 do line$(k)=asc(" ")
               fi
         end
         linewaschanged=false
replacecolons: ...
&        repeat
             i=find(line$,":")
             if i=0 then exit replacecolons
             if i=len(line$) or line$(i+1)=:20 then exit replacecolons
             line$[i]=asc("$")
             linewaschanged=true
         end
         let i=find(Line$,"*")
         if i=1
         then
             line$(1)=asc(';')
             linewaschanged=true
         fi
         if find(line$,';')=0 and len(line$)>=40
         then
             ! insert ";" for comment field in reasonable place
             i=39 \ ! initial guess where blank to left of comment is
             ! locate the end of the operand field
             while i<=len(line$) and line$(i)<>:20 do i=i+1
             ! locate end of blanks following operand field
             while i<=len(line$) and line$(i)=:20 do i=i+1
             ! now i points to 1st nonblank character of comment field
             line$=line$[1,i-1] cat "; " cat right$(line$,i)
             linewaschanged=true
         fi
         let i=find(line$," ")
         if i>0 then
               ! we found leading blank. locate opcode.
               for i=i to len(line$) until line$(i,1)<>" " do ! find non-blank
               if i=len(line$) then donewithline
               if i+3<=len(line$)
               then let op$=lowercase$(line$[i,4])
               else
                   let op$=lowercase$(right$(line$,i))
                   let op$=op$ cat blanks$[1,3-(len(line$)-i)]
               fi
               let op$=op$ cat "?"
               j=find(TranslatedOps$,op$) \ ! see if op trivially translateable
               if j>0
               then
                   ! do trivial transformation on opcode
                   if i+5>len(line$) then len(line$)=i+5
                   let line$(i,6)=z80correspondingops$((j-1)/5+1)
                   linewaschanged=true
                   while line$(len(line$),1)=" " do
                        let len(line$)=len(line$)-1
                   end
               fi
               j=find(line$,",x") \ ! indexed ?
               if j>0
               then
                   ! change ",x" after operand to "x" after opcode
                   line$[j,2]="  " \ ! rip out the "," notation
                   linewaschanged=true
                   i=j-1 \ ! now i points to last char of operand field
                   while i>0 and line$[i]<>:20 do i=i-1 end
                   operandfield=i+1 \ ! start of operand field
                   while i>0 and line$[i]=:20 do i=i-1
                   ! now i points to last byte of opcode
                   if i>=3 and (line$[i-2,2]="ld" or line$[i-2,2]="st")...
&                          and (line$(i,1)="a" or line$(i,1)="b")
                   then
                       accumulator=line$[i] \ ! letter "a" or "b"
                       line$[i]=asc("x")
                       line$[operandfield+2,j-operandfield]=...
&                           line$[operandfield,j-operandfield]
                       line$[operandfield]=accumulator
                       line$[operandfield+1]=asc(",")
                   else
                       line$[i+1]=asc("x") \ ! assert: overwrites a blank
                   fi
               fi
               j=find(line$," #")
               if j>0
               then
                   ! immediate notation, make "#" disappear
                   for i=j+2 to len(line$) until line$(i)=:20 do
                       line$(i-1)=line$(i)
                   end
                   line$(i-1)=asc(" ")
                   linewaschanged=true
                   ! locate end of opcode field
                   i=j-1
                   while i>0 and line$[i]=:20 do i=i-1
                   ! now i points to last character of opcode field
                   line$(i+1)=asc("i") \ ! stick in Z80 immediate notation
               fi
         fi
donewithline:
         if linewaschanged then print line$ \ ! So i can see what changed
         print #out,line$
         goto loop
END

! Code below here used to perform useful duties, since dumped
! (kept because potentially useful again someday)

 dim line$(300)
 open #1,"z80basrtp.asm"
 create #2,"junk"
 loop:  input #1,line$
    if eof(1) then exit
    if len(line$)>=1 and line$[1]=:C
    then
         let line$=right$(line$,2)
         print line$
    fi
    print #2,line$
 goto loop
end
END
         dim line$(300),in/1/,out/2/,
         input "file to tab-expand:" line$
         open #in,line$
         input "where to put results: " line$
         create #out,line$
loop:    input #in,line$
         if eof(in) then exit
         print #out,line$
         goto loop
end
