CNVZ801


               {   (C) Copyright 1982 By Motorola Inc.   }
 
                              {   CNVZ80   }
 
         {**********convert Z80 to MC68000 source utility **********}
 
program convertZ80 (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];  { input image to print }
         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;            { passing statements through }
         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 flag }
 
 
{ phase II processing }
   procedure convert;  forward;
 
 
{ procedure to read statement and parse it }
procedure getstmt;
 
label    endproc;
 
var      i,j,k: integer;
         endofstring: boolean;
         x,y,numbeg: integer;                  { work integers }
         instring: boolean;                  { string flag }
         frontin,backin: boolean;           { flags for $ loc cntr tag }
 
 
      { procedure to decode operand type and convert to MC68000 address 
mode }
         procedure typeclass(var oprnd: chars; var typed: oprtype);
 
              { procedure to set type, EA and size }
              procedure settype(typeis:oprtype; result:chars; len:size);
                 begin
                   typed := typeis;
                   oprnd := result;
                   if len=word then datalen := word
                   end;
 
         begin
 
          { check for $ location counter so error message can be given }
          x := pos(oprnd,'$');
          if x>0 then begin { test for location counter specified }
                   { detect if $ is trailing part of identifier }
              frontin := true;
              backin := true;
              if x>1 then frontin := pos(' ''()*=,-./;:<=>',oprnd[x-1]) 
> 0;
                   { detect if beginning of an identifier }
              if x < length(oprnd) then backin :=
                          pos(' ''()*=,-./;:<=>',oprnd[x+1]) > 0;
              instring := frontin and backin; { determine if loc cntr }
              if instring then oprnd[x] := '*';
              if (opc='JR') or (opc='DJNZ') then begin
                   y := pos(oprnd,'-*');
                   if (y>0) and ((y+1)=length(oprnd)) then begin { JR 
with -$ }
                        instring := false;
                        oprnd := delete(oprnd,y,2) { remove -$ }
                        end
                   end;
              if length(oprnd)=1 then instring := false; { no error if 
alone }
              if instring then errormsg :=
                   '''$'' location counter use may be invalid'
              end;
 
          { single 8-bit registers }
          if oprnd='A ' then        settype(Dreg,'D0',byte)
            else if oprnd='B ' then settype(Aindirect,'(A1)',byte)
            else if oprnd='C ' then settype(Aindirect,'(A2)',byte)
            else if oprnd='D ' then settype(Aindirect,'(A3)',byte)
            else if oprnd='E ' then settype(Aindirect,'(A4)',byte)
            else if oprnd='L ' then settype(Aindirect,'(A5)',byte)
            else if oprnd='H ' then settype(Aindirect,'(SP)',byte)
 
         { 16-bit registers }
         else if oprnd='BC' then settype(Aindirect,'(A1)',word)
         else if oprnd='DE' then settype(Aindirect,'(A3)',word)
         else if oprnd='HL' then settype(Aindirect,'(SP)',word)
         else if oprnd='SP' then settype(Areg,'A6',word)
         else if oprnd='IX' then settype(Dreg,'D6',word)
         else if oprnd='IY' then settype(Dreg,'D7',word)
 
                   { indirect addressing }
         else if oprnd='(SP)' then settype(Aindirect,'(A6)',unknown)
         else if oprnd='(BC)' then settype(Aindpointer,'(A1)',unknown)
         else if oprnd='(DE)' then settype(Aindpointer,'(A3)',unknown)
         else if oprnd='(HL)' then settype(Aindpointer,'(SP)',unknown)
         else if oprnd='(IX)' then settype(Dindirect,'D6',unknown)
         else if oprnd='(IY)' then settype(Dindirect,'D7',unknown)
 
         { register not supported }
         else if oprnd = 'I ' then errormsg := 'I register not 
supported'
         else if oprnd = 'R ' then errormsg := 'R register not 
supported'
 
         { handle (IX+d), (IY+d) and immediates }
         else if copy(oprnd,1,4) = '(IX+' then
                settype(IXdisp,copy(oprnd,5,length(oprnd)-5),unknown)
         else if copy(oprnd,1,4) = '(IY+' then
                settype(IYdisp,copy(oprnd,5,length(oprnd)-5),unknown)
 
                 { not typed so must be immediate }
         else if (oprnd[1]='(') and (pos(oprnd,')')=length(oprnd))
                then settype(imaddr,copy(oprnd,2,length(oprnd)-
2),unknown)
                     else settype(immed,oprnd,unknown)
         end;
 
 
         procedure skipblanks;
                 label 1;
                 begin  while not endofstring do begin
                             if image[i] <> ' ' then goto 1;
                             i := i + 1;
                             endofstring := i > length(image)
                             end;
                   1:   ;
                        end;
 
         procedure skiptoblank;
                label 1;
                 begin  while not endofstring do begin
                             if image[i] = '''' then repeat i := i+1 
until
                                      (i=length(image)) or (image[i] = 
'''');
                             if image[i] = ';' then goto 1; { treat as 
blank }
                             if image[i] = ' ' then goto 1;
                             i := i + 1;
                             endofstring := i > length(image)
                             end;
                   1:   ;
                        end;
 
begin {getstmt}
         lbl := '';
         opc := '';
         opr1 := '';
         opr2 := '';
         opr1type := none;
         opr2type := none;
         datalen := byte;
         comment := '';
         passthis := false;
         endofstring := false;
         errormsg := '';
         i := 1;
 
         readln(infile,image);
 
         { convert lower to upper case }
         for j := 1 to length(image) do begin
              if image[j]='''' then repeat j:=j+1 until
                         (j = length(image)) or (image[j]='''');
              if (image[j]>='a') and (image[j]<='z') then
                                       image[j] := chr(ord(image[j])-32)
              end;
 
 
         copyimage := image;  { for printing }
         lines := lines + 1;
 
         { set special option flags }
         if image = '**MC68010' then MC68010 := true;
 
         { check special bypass mode indicators }
         if image = '**PASS' then passmode := true;
         if image = '**PASSOFF' then begin
                  passmode := false;
                  freshccr := false
                  end;
 
         if passmode then passthis := true;
 
         { skip empty or comment statements }
         if (image=' ') or (copy(image,1,2)='**') then passthis := true;
         x := pos(image,';');
         if x > 0 then if copy(image,1,x-1) = ' ' then begin
                  passthis := true;
                  image[x] := ' ';
                  image[1] := '*'
                  end;
 
         if passthis then goto endproc;
 
         { convert .AND. and .OR. to & and ! }
         while pos(image,'.AND.')>0 do begin
             x := pos(image,'.AND.');
             image := concat(copy(image,1,x-1), '&', 
delete(image,1,x+4));
             end;
         while pos(image,'.OR.')>0 do begin
             x := pos(image,'.OR.');
             image := concat(copy(image,1,x-1), '!', 
delete(image,1,x+3));
             end;
 
         { scan the operand and convert Z80 number formats to MC68000 }
          for x := 1 to length(image) do begin
               { skip strings }
               if image[x]='''' then repeat x:=x+1 until
                                       (x=length(image)) or 
(image[x]='''');
               { test for start of a number and process it }
               if image[x] in ['0'..'9'] then
                if (x=1)or(pos(' &!''()*=,-+./;:<=>',image[x-1])>0) then 
begin
                   numbeg := x;
                   { find end of the number }
                   while (X <= length(image)) and (image[x] in 
['0'..'9',
                             'A'..'F','H','O','Q']) do x := x + 1;
                   { test last character }
                   case image[x-1] of
                         'D':   { decimal }
                              image := delete(image,x-1,1);
                         'O','Q': begin  { octal }
                              image := delete(image,x-1,1);
                              image := insert('@',image,numbeg)
                              end;
                         'B': begin  { binary }
                              image := delete(image,x-1,1);
                              image := insert('%',image,numbeg)
                              end;
                         'H': begin  { hex }
                              image := delete(image,x-1,1);
                              image := insert('$',image,numbeg)
                              end;
                         otherwise { plain vanilla }
                         end {case}
                   end { begin }
               end; { for }
 
         {read non-semicoloned label}
         if image[1] <> ' ' then begin
                   skiptoblank;
                   k := pos(image,':');
                   if (k>0) & (k<i) then begin { colon on label }
                             lbl := copy(image,1,k-1);
                             i := k + 1 { bypass colon }
                             end
                       else lbl := copy(image,1,i-1)
                   end
             { read coloned label }
             else begin
                   skipblanks;
                   j := i;
                   skiptoblank;
                   k := pos(image,':');
                   if (k>0) & (k<i) then begin { found coloned label }
                             lbl := copy(image,j,k-j);
                             i := k + 1  { skip colon }
                             end
                       else begin
                             i := j; { no label so reset back }
                             endofstring := false
                             end
                   end;
 
         {read opcode}
         skipblanks;
         j := i;
         skiptoblank;
         opc := copy(image,j,i-j);
 
         {read operand group if any }
         skipblanks;
         j := i;
         skiptoblank;
         opr1 := copy(image,j,i-j);
 
         { get comment }
         skipblanks;
         if not endofstring then if image[i] = ';'
                              then comment := delete(image,1,i);
 
         { split into two operands if comma in middle }
         for j := 1 to length(opr1) do begin
                   if opr1[j]='''' then repeat j:= j + 1 until 
opr1[j]='''';
                   if opr1[j] = ',' then begin
                              opr2 := delete(opr1,1,j);
                              opr1 := copy(opr1,1,j-1);
                              j := 1000  { fall out }
                              end
                   end;
 
         { now perform operand type processing }
         if length(opr1) > 0 then typeclass(opr1,opr1type);
         if length(opr2) > 0 then typeclass(opr2,opr2type);
 
      endproc: begin end
 
 
         end;
 
begin {CNVZ80}
 
rewrite(outfile);
reset(infile);
lines := 0;
linesout := 0;
passmode := false;
msgs := 0;
freshccr := false;
MC68010 := false;
 
{ send copyright and hello message }
writeln('CNVZ80 -  Z80 To MC68000 Source Cross Utility  V1.0');
writeln('       (C) Copyright 1982 by Motorola Inc.');
writeln(outfile,'* CNVZ80 - Z80 To MC68000 Source Cross Utility  V1.0');
writeln(outfile,'*      (C) Copyright 1982 by Motorola Inc.');
 
while not eof(infile) do begin
         getstmt; { get next statement and parse }
         convert  { convert }
         end;
 
 
writeln;
writeln('input lines=',lines:5,
        '  output lines=',linesout:5,
        '  unconverted lines=',linesunmatched:3,
        '  diagnostics=',msgs:3)
 
end.