* m68k fixes, splitted cg68k like cgi386

compiler/ag68kgas.pas

@@ -20,29 +20,31 @@
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
  ****************************************************************************
-
-  What's to do:
-    o Verify if this actually work as indirect mode with name of variables
-    o write lines numbers and file names to output file
-    o generate debugging informations
 }
+{ R- Necessary for the in [] }
+{$ifdef TP}
+  {$N+,E+,R-}
+{$endif}
 unit ag68kgas;
 
     interface
 
-    uses aasm,assemble;
+    uses cobjects,aasm,assemble;
 
     type
       pm68kgasasmlist=^tm68kgasasmlist;
       tm68kgasasmlist = object(tasmlist)
         procedure WriteTree(p:paasmoutput);virtual;
         procedure WriteAsmList;virtual;
+{$ifdef GDB}
+        procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
+{$endif}
       end;
 
    implementation
 
     uses
-      dos,globals,systems,cobjects,m68k,
+      dos,globals,systems,m68k,
       strings,files,verbose
 {$ifdef GDB}
       ,gdb
@@ -220,10 +222,75 @@ unit ag68kgas;
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
         (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
 
-      ait_section2str : array[tsection] of string[6]=
-       ('','.text','.data','.bss','.idata');
+    function ait_section2str(s:tsection):string;
+    begin
+      case s of
+        sec_code : ait_section2str:='.text';
+        sec_data : ait_section2str:='.data';
+         sec_bss : ait_section2str:='.bss';
+      else
+       ait_section2str:='';
+      end;
+      LastSec:=s;
+    end;
+
+{$ifdef GDB}
+    var
+      curr_n    : byte;
+      infile    : pinputfile;
+      funcname  : pchar;
+      linecount : longint;
+
+      procedure tm68kgasasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
+        begin
+          if not (cs_debuginfo in aktmoduleswitches) then
+           exit;
+        { file changed ? (must be before line info) }
+          if lastfileindex<>fileinfo.fileindex then
+           begin
+             infile:=current_module^.sourcefiles.get_file(fileinfo.fileindex);
+             if includecount=0 then
+              curr_n:=n_sourcefile
+             else
+              curr_n:=n_includefile;
+             if (infile^.path^<>'') then
+              begin
+                AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^)))+'",'+
+                  tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
+              end;
+             AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
+               tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
+             AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
+             inc(includecount);
+             lastfileindex:=fileinfo.fileindex;
+           end;
+        { line changed ? }
+          if (fileinfo.line<>lastline) and (fileinfo.line<>0) then
+           begin
+             if (n_line=n_textline) and assigned(funcname) and
+                (target_os.use_function_relative_addresses) then
+              begin
+                AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
+                AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+
+                           target_asm.labelprefix+'l'+tostr(linecount)+' - ');
+                AsmWritePChar(FuncName);
+                AsmLn;
+                inc(linecount);
+              end
+             else
+              AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line));
+             lastline:=fileinfo.line;
+           end;
+        end;
+{$endif GDB}
+
 
     procedure tm68kgasasmlist.WriteTree(p:paasmoutput);
+    type
+      twowords=record
+        word1,word2:word;
+      end;
+      textendedarray = array[0..9] of byte; { last longint will be and $ffff }
     var
       hp        : pai;
       ch        : char;
@@ -231,19 +298,9 @@ unit ag68kgas;
       s         : string;
       pos,l,i   : longint;
       found     : boolean;
-{$ifdef GDB}
-      curr_n    : byte;
-      infile    : pinputfile;
-      funcname  : pchar;
-      linecount : longint;
-{$endif GDB}
     begin
       if not assigned(p) then
        exit;
-{$ifdef GDB}
-      funcname:=nil;
-      linecount:=1;
-{$endif GDB}
       hp:=pai(p^.first);
       while assigned(hp) do
        begin
@@ -253,44 +310,7 @@ unit ag68kgas;
           begin
             if not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,
                    ait_label,ait_cut,ait_align,ait_stab_function_name]) then
-             begin
-             { file changed ? (must be before line info) }
-               if lastfileindex<>hp^.fileinfo.fileindex then
-                begin
-                  infile:=current_module^.sourcefiles.get_file(hp^.fileinfo.fileindex);
-                  if includecount=0 then
-                   curr_n:=n_sourcefile
-                  else
-                   curr_n:=n_includefile;
-                  if (infile^.path^<>'') then
-                   begin
-                     AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^)))+'",'+
-                       tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
-                   end;
-                  AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
-                    tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
-                  AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
-                  inc(includecount);
-                  lastfileindex:=hp^.fileinfo.fileindex;
-                end;
-             { line changed ? }
-               if (hp^.fileinfo.line<>lastline) and (hp^.fileinfo.line<>0) then
-                begin
-                  if (n_line=n_textline) and assigned(funcname) and
-                     (target_os.use_function_relative_addresses) then
-                   begin
-                     AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
-                     AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line)+','+
-                                target_asm.labelprefix+'l'+tostr(linecount)+' - ');
-                     AsmWritePChar(FuncName);
-                     AsmLn;
-                     inc(linecount);
-                   end
-                  else
-                   AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line));
-                  lastline:=hp^.fileinfo.line;
-                end;
-             end;
+              WriteFileLineInfo(hp^.fileinfo);
           end;
 {$endif GDB}
 
@@ -310,7 +330,7 @@ unit ag68kgas;
                        if pai_section(hp)^.sec<>sec_none then
                         begin
                           AsmLn;
-                          AsmWrite(ait_section2str[pai_section(hp)^.sec]);
+                          AsmWrite(ait_section2str(pai_section(hp)^.sec));
                           if pai_section(hp)^.idataidx>0 then
                            AsmWrite('$'+tostr(pai_section(hp)^.idataidx));
                           AsmLn;
@@ -532,8 +552,10 @@ ait_labeled_instruction : begin
 ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 {$endif GDB}
            ait_cut : begin
-                     { create only a new file when the last is not empty }
-                       if AsmSize>0 then
+                     { only reset buffer if nothing has changed }
+                       if AsmSize=AsmStartSize then
+                        AsmClear
+                       else
                         begin
                           AsmClose;
                           DoAssemble;
@@ -546,11 +568,27 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
                            begin
                              lastsec:=pai_section(hp^.next)^.sec;
                              lastsecidx:=pai_section(hp^.next)^.idataidx;
+{$ifdef GDB}
+                             { this is needed for line info in data }
+                             case pai_section(hp^.next)^.sec of
+                              sec_code : n_line:=n_textline;
+                              sec_data : n_line:=n_dataline;
+                               sec_bss : n_line:=n_bssline;
+                             end;
+{$endif GDB}
                            end;
                           hp:=pai(hp^.next);
                         end;
+{$ifdef GDB}
+                       { force write of filename }
+                       lastfileindex:=0;
+                       includecount:=0;
+                       funcname:=nil;
+                       WriteFileLineInfo(hp^.fileinfo);
+{$endif GDB}
                        if lastsec<>sec_none then
-                         AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
+                         AsmWriteLn(ait_section2str(lastsec));
+                       AsmStartSize:=AsmSize;
                      end;
          else
           internalerror(10000);
@@ -559,24 +597,23 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
        end;
     end;
 
+
     procedure tm68kgasasmlist.WriteAsmList;
     var
       p:dirstr;
       n:namestr;
       e:extstr;
+{$ifdef GDB}
+      fileinfo : tfileposinfo;
+{$endif GDB}
+
     begin
 {$ifdef EXTDEBUG}
       if assigned(current_module^.mainsource) then
        comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
 {$endif}
 
-      lastline:=0;
-      lastfileindex:=0;
       LastSec:=sec_none;
-{$ifdef GDB}
-      includecount:=0;
-      n_line:=n_bssline;
-{$endif GDB}
 
       if assigned(current_module^.mainsource) then
        fsplit(current_module^.mainsource^,p,n,e)
@@ -589,6 +626,20 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
     { to get symify to work }
       AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
 
+{$ifdef GDB}
+      includecount:=0;
+      n_line:=n_bssline;
+      lastline:=0;
+      lastfileindex:=0;
+      funcname:=nil;
+      linecount:=1;
+      fileinfo.fileindex:=1;
+      fileinfo.line:=1;
+      { Write main file }
+      WriteFileLineInfo(fileinfo);
+{$endif GDB}
+      AsmStartSize:=AsmSize;
+
       { there should be nothing but externals so we don't need to process
       WriteTree(externals); }
 
@@ -612,7 +663,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 end.
 {
   $Log$
-  Revision 1.9  1998-08-31 12:26:20  peter
+  Revision 1.10  1998-09-01 09:07:08  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+  Revision 1.9  1998/08/31 12:26:20  peter
     * m68k and palmos updates from surebugfixes
 
   Revision 1.8  1998/08/10 14:49:36  peter

compiler/cg68kadd.pas

@@ -0,0 +1,1269 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for add node
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kadd;
+interface
+
+    uses
+      tree;
+
+    procedure secondadd(var p : ptree);
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      symtable,aasm,types,
+      temp_gen,hcodegen,pass_2,
+      m68k,cga68k,tgen68k;
+
+{*****************************************************************************
+                                Helpers
+*****************************************************************************}
+
+ procedure processcc(p: ptree);
+ const
+       { process condition codes bit definitions }
+       CARRY_FLAG    = $01;
+       OVFL_FLAG     = $02;
+       ZERO_FLAG     = $04;
+       NEG_FLAG      = $08;
+ var
+   label1,label2: plabel;
+ (*************************************************************************)
+ (*  Description: This routine handles the conversion of Floating point   *)
+ (*  condition codes to normal cpu condition codes.                       *)
+ (*************************************************************************)
+ begin
+      getlabel(label1);
+      getlabel(label2);
+      case p^.treetype of
+        equaln,unequaln: begin
+                           { not equal clear zero flag }
+                           emitl(A_FBEQ,label1);
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_AND, S_B, NOT ZERO_FLAG, R_CCR)));
+                           emitl(A_BRA,label2);
+                           emitl(A_LABEL,label1);
+                           { equal - set zero flag }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_OR,S_B, ZERO_FLAG, R_CCR)));
+                           emitl(A_LABEL,label2);
+                        end;
+         ltn:           begin
+                           emitl(A_FBLT,label1);
+                           { not less than       }
+                           { clear N and V flags }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_AND, S_B, NOT (NEG_FLAG OR OVFL_FLAG), R_CCR)));
+                           emitl(A_BRA,label2);
+                           emitl(A_LABEL,label1);
+                           { less than }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_OR,S_B, NEG_FLAG, R_CCR)));
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_AND,S_B, NOT OVFL_FLAG, R_CCR)));
+                           emitl(A_LABEL,label2);
+                        end;
+         gtn:           begin
+                           emitl(A_FBGT,label1);
+                           { not greater than }
+                           { set Z flag       }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_OR, S_B, ZERO_FLAG, R_CCR)));
+                           emitl(A_BRA,label2);
+                           emitl(A_LABEL,label1);
+                           { greater than      }
+                           { set N and V flags }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_OR,S_B, NEG_FLAG OR OVFL_FLAG , R_CCR)));
+                           emitl(A_LABEL,label2);
+                        end;
+         gten:           begin
+                           emitl(A_FBGE,label1);
+                           { not greater or equal }
+                           { set N and clear V    }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_AND, S_B, NOT OVFL_FLAG, R_CCR)));
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_OR,S_B, NEG_FLAG, R_CCR)));
+                           emitl(A_BRA,label2);
+                           emitl(A_LABEL,label1);
+                           { greater or equal    }
+                           { clear V and N flags }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_AND, S_B, NOT (OVFL_FLAG OR NEG_FLAG), R_CCR)));
+                           emitl(A_LABEL,label2);
+                        end;
+         lten:           begin
+                           emitl(A_FBLE,label1);
+                           { not less or equal }
+                           { clear Z, N and V  }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_AND, S_B, NOT (ZERO_FLAG OR NEG_FLAG OR OVFL_FLAG), R_CCR)));
+                           emitl(A_BRA,label2);
+                           emitl(A_LABEL,label1);
+                           { less or equal     }
+                           { set Z and N       }
+                           { and clear V       }
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_OR,S_B, ZERO_FLAG OR NEG_FLAG, R_CCR)));
+                           exprasmlist^.concat(new(pai68k, op_const_reg(
+                             A_AND,S_B, NOT OVFL_FLAG, R_CCR)));
+                           emitl(A_LABEL,label2);
+                        end;
+           else
+             begin
+               InternalError(34);
+             end;
+      end; { end case }
+ end;
+
+
+    procedure SetResultLocation(cmpop,unsigned:boolean;var p :ptree);
+      var
+         flags : tresflags;
+      begin
+         { remove temporary location if not a set or string }
+         if (p^.left^.resulttype^.deftype<>stringdef) and
+            ((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
+            (p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+           ungetiftemp(p^.left^.location.reference);
+         if (p^.right^.resulttype^.deftype<>stringdef) and
+            ((p^.right^.resulttype^.deftype<>setdef) or (psetdef(p^.right^.resulttype)^.settype=smallset)) and
+            (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+           ungetiftemp(p^.right^.location.reference);
+         { in case of comparison operation the put result in the flags }
+         if cmpop then
+           begin
+              if not(unsigned) then
+                begin
+                   if p^.swaped then
+                     case p^.treetype of
+                        equaln : flags:=F_E;
+                        unequaln : flags:=F_NE;
+                        ltn : flags:=F_G;
+                        lten : flags:=F_GE;
+                        gtn : flags:=F_L;
+                        gten : flags:=F_LE;
+                     end
+                   else
+                     case p^.treetype of
+                        equaln : flags:=F_E;
+                        unequaln : flags:=F_NE;
+                        ltn : flags:=F_L;
+                        lten : flags:=F_LE;
+                        gtn : flags:=F_G;
+                        gten : flags:=F_GE;
+                     end;
+                end
+              else
+                begin
+                   if p^.swaped then
+                     case p^.treetype of
+                        equaln : flags:=F_E;
+                        unequaln : flags:=F_NE;
+                        ltn : flags:=F_A;
+                        lten : flags:=F_AE;
+                        gtn : flags:=F_B;
+                        gten : flags:=F_BE;
+                     end
+                   else
+                     case p^.treetype of
+                        equaln : flags:=F_E;
+                        unequaln : flags:=F_NE;
+                        ltn : flags:=F_B;
+                        lten : flags:=F_BE;
+                        gtn : flags:=F_A;
+                        gten : flags:=F_AE;
+                     end;
+                end;
+              p^.location.loc:=LOC_FLAGS;
+              p^.location.resflags:=flags;
+           end;
+      end;
+
+
+{*****************************************************************************
+                                Addstring
+*****************************************************************************}
+
+    procedure addstring(var p : ptree);
+      var
+        pushedregs : tpushed;
+        href       : treference;
+        pushed,
+        cmpop      : boolean;
+      begin
+        { string operations are not commutative }
+        if p^.swaped then
+         swaptree(p);
+
+{$ifdef UseAnsiString}
+              if is_ansistring(p^.left^.resulttype) then
+                begin
+                  case p^.treetype of
+                  addn :
+                    begin
+                       { we do not need destination anymore }
+                       del_reference(p^.left^.location.reference);
+                       del_reference(p^.right^.location.reference);
+                       { concatansistring(p); }
+                    end;
+                  ltn,lten,gtn,gten,
+                  equaln,unequaln :
+                    begin
+                       pushusedregisters(pushedregs,$ff);
+                       secondpass(p^.left);
+                       del_reference(p^.left^.location.reference);
+                       emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                       secondpass(p^.right);
+                       del_reference(p^.right^.location.reference);
+                       emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                       emitcall('ANSISTRCMP',true);
+                       maybe_loada5;
+                       popusedregisters(pushedregs);
+                    end;
+                  end;
+                end
+              else
+{$endif UseAnsiString}
+
+              case p^.treetype of
+                 addn : begin
+                           cmpop:=false;
+                           secondpass(p^.left);
+                           if (p^.left^.treetype<>addn) then
+                             begin
+                                { can only reference be }
+                                { string in register would be funny    }
+                                { therefore produce a temporary string }
+
+                                { release the registers }
+                                del_reference(p^.left^.location.reference);
+                                gettempofsizereference(256,href);
+                                copystring(href,p^.left^.location.reference,255);
+                                ungetiftemp(p^.left^.location.reference);
+
+                                { does not hurt: }
+                                p^.left^.location.loc:=LOC_MEM;
+                                p^.left^.location.reference:=href;
+                             end;
+
+                           secondpass(p^.right);
+
+                           { on the right we do not need the register anymore too }
+                           del_reference(p^.right^.location.reference);
+                           pushusedregisters(pushedregs,$ffff);
+                           { WE INVERSE THE PARAMETERS!!! }
+                           { Because parameters are inversed in the rtl }
+                           emitpushreferenceaddr(p^.right^.location.reference);
+                           emitpushreferenceaddr(p^.left^.location.reference);
+                           emitcall('STRCONCAT',true);
+                           maybe_loadA5;
+                           popusedregisters(pushedregs);
+                           set_location(p^.location,p^.left^.location);
+                           ungetiftemp(p^.right^.location.reference);
+                        end; { this case }
+              ltn,lten,gtn,gten,
+                equaln,unequaln :
+                        begin
+                           secondpass(p^.left);
+                           { are too few registers free? }
+                           pushed:=maybe_push(p^.right^.registers32,p);
+                           secondpass(p^.right);
+                           if pushed then restore(p);
+                           cmpop:=true;
+                           del_reference(p^.right^.location.reference);
+                           del_reference(p^.left^.location.reference);
+                           { generates better code }
+                           { s='' and s<>''        }
+                           if (p^.treetype in [equaln,unequaln]) and
+                             (
+                               ((p^.left^.treetype=stringconstn) and
+                                (p^.left^.values^='')) or
+                               ((p^.right^.treetype=stringconstn) and
+                                (p^.right^.values^=''))
+                             ) then
+                             begin
+                                { only one node can be stringconstn }
+                                { else pass 1 would have evaluted   }
+                                { this node                         }
+                                if p^.left^.treetype=stringconstn then
+                                  exprasmlist^.concat(new(pai68k,op_ref(
+                                    A_TST,S_B,newreference(p^.right^.location.reference))))
+                                else
+                                  exprasmlist^.concat(new(pai68k,op_ref(
+                                    A_TST,S_B,newreference(p^.left^.location.reference))));
+                             end
+                           else
+                             begin
+                               pushusedregisters(pushedregs,$ffff);
+
+                               { parameters are directly passed via registers       }
+                               { this has several advantages, no loss of the flags  }
+                               { on exit ,and MUCH faster on m68k machines          }
+                               {  speed difference (68000)                          }
+                               {   normal routine: entry, exit code + push  = 124   }
+                               {   (best case)                                      }
+                               {   assembler routine: param setup (worst case) = 48 }
+
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(
+                                    A_LEA,S_L,newreference(p^.left^.location.reference),R_A0)));
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(
+                                    A_LEA,S_L,newreference(p^.right^.location.reference),R_A1)));
+{
+                               emitpushreferenceaddr(p^.left^.location.reference);
+                               emitpushreferenceaddr(p^.right^.location.reference); }
+                               emitcall('STRCMP',true);
+                               maybe_loada5;
+                               popusedregisters(pushedregs);
+                          end;
+                           ungetiftemp(p^.left^.location.reference);
+                           ungetiftemp(p^.right^.location.reference);
+                        end; { end this case }
+                else Message(sym_e_type_mismatch);
+              end; { end case }
+
+        SetResultLocation(cmpop,true,p);
+      end;
+
+
+{*****************************************************************************
+                                Addset
+*****************************************************************************}
+
+    procedure addset(var p : ptree);
+      var
+        cmpop,
+        pushed : boolean;
+        href   : treference;
+        pushedregs : tpushed;
+      begin
+        cmpop:=false;
+
+        { not commutative }
+        if p^.swaped then
+         swaptree(p);
+
+        secondpass(p^.left);
+        { are too few registers free? }
+        pushed:=maybe_push(p^.right^.registers32,p);
+        secondpass(p^.right);
+        if codegenerror then
+          exit;
+        if pushed then
+          restore(p);
+
+        set_location(p^.location,p^.left^.location);
+
+        { handle operations }
+        case p^.treetype of
+          equaln,
+        unequaln : begin
+                     cmpop:=true;
+                     del_reference(p^.left^.location.reference);
+                     del_reference(p^.right^.location.reference);
+                     pushusedregisters(pushedregs,$ff);
+                     emitpushreferenceaddr(p^.right^.location.reference);
+                     emitpushreferenceaddr(p^.left^.location.reference);
+                     emitcall('SET_COMP_SETS',true);
+                     maybe_loada5;
+                     popusedregisters(pushedregs);
+                     ungetiftemp(p^.left^.location.reference);
+                     ungetiftemp(p^.right^.location.reference);
+                   end;
+            addn : begin
+                   { add can be an other SET or Range or Element ! }
+                     del_reference(p^.left^.location.reference);
+                     del_reference(p^.right^.location.reference);
+                     pushusedregisters(pushedregs,$ff);
+                     href.symbol:=nil;
+                     gettempofsizereference(32,href);
+                   { add a range or a single element? }
+                     if p^.right^.treetype=setelementn then
+                      begin
+                        concatcopy(p^.left^.location.reference,href,32,false);
+                        if assigned(p^.right^.right) then
+                         begin
+                           loadsetelement(p^.right^.right);
+                           loadsetelement(p^.right^.left);
+                           emitpushreferenceaddr(href);
+                           emitcall('SET_SET_RANGE',true);
+                         end
+                        else
+                         begin
+                           loadsetelement(p^.right^.left);
+                           emitpushreferenceaddr(href);
+                           emitcall('SET_SET_BYTE',true);
+                         end;
+                      end
+                     else
+                      begin
+                      { must be an other set }
+                        emitpushreferenceaddr(href);
+                        emitpushreferenceaddr(p^.right^.location.reference);
+                        emitpushreferenceaddr(p^.left^.location.reference);
+                        emitcall('SET_ADD_SETS',true);
+                      end;
+                     maybe_loada5;
+                     popusedregisters(pushedregs);
+                     ungetiftemp(p^.left^.location.reference);
+                     ungetiftemp(p^.right^.location.reference);
+                     p^.location.loc:=LOC_MEM;
+                     stringdispose(p^.location.reference.symbol);
+                     p^.location.reference:=href;
+                   end;
+            subn,
+         symdifn,
+            muln : begin
+                     del_reference(p^.left^.location.reference);
+                     del_reference(p^.right^.location.reference);
+                     href.symbol:=nil;
+                     pushusedregisters(pushedregs,$ff);
+                     gettempofsizereference(32,href);
+                     emitpushreferenceaddr(href);
+                     emitpushreferenceaddr(p^.right^.location.reference);
+                     emitpushreferenceaddr(p^.left^.location.reference);
+                     case p^.treetype of
+                      subn : emitcall('SET_SUB_SETS',true);
+                   symdifn : emitcall('SET_SYMDIF_SETS',true);
+                      muln : emitcall('SET_MUL_SETS',true);
+                     end;
+                     maybe_loada5;
+                     popusedregisters(pushedregs);
+                     ungetiftemp(p^.left^.location.reference);
+                     ungetiftemp(p^.right^.location.reference);
+                     p^.location.loc:=LOC_MEM;
+                     stringdispose(p^.location.reference.symbol);
+                     p^.location.reference:=href;
+                   end;
+        else
+          Message(sym_e_type_mismatch);
+        end;
+        SetResultLocation(cmpop,true,p);
+      end;
+
+
+{*****************************************************************************
+                                SecondAdd
+*****************************************************************************}
+
+    procedure secondadd(var p : ptree);
+    { is also being used for xor, and "mul", "sub, or and comparative }
+    { operators                                                       }
+
+      label do_normal;
+
+      var
+         hregister : tregister;
+         noswap,
+         pushed,mboverflow,cmpop : boolean;
+         op : tasmop;
+         flags : tresflags;
+         otl,ofl : plabel;
+         power : longint;
+         opsize : topsize;
+         hl4: plabel;
+         tmpref : treference;
+        
+
+         { true, if unsigned types are compared }
+         unsigned : boolean;
+         { true, if a small set is handled with the longint code }
+         is_set : boolean;
+         { is_in_dest if the result is put directly into }
+         { the resulting refernce or varregister }
+         is_in_dest : boolean;
+         { true, if for sets subtractions the extra not should generated }
+         extra_not : boolean;
+
+      begin
+      { to make it more readable, string and set (not smallset!) have their
+        own procedures }
+         case p^.left^.resulttype^.deftype of
+         stringdef : begin
+                       addstring(p);
+                       exit;
+                     end;
+            setdef : begin
+                     { normalsets are handled separate }
+                       if not(psetdef(p^.left^.resulttype)^.settype=smallset) then
+                        begin
+                          addset(p);
+                          exit;
+                        end;
+                     end;
+         end;
+
+         { defaults }
+         unsigned:=false;
+         is_in_dest:=false;
+         extra_not:=false;
+         noswap:=false;
+         opsize:=S_L;
+
+         { are we a (small)set, must be set here because the side can be
+           swapped ! (PFV) }
+         is_set:=(p^.left^.resulttype^.deftype=setdef);
+
+         { calculate the operator which is more difficult }
+         firstcomplex(p);
+
+         { handling boolean expressions extra: }
+         if ((p^.left^.resulttype^.deftype=orddef) and
+            (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) or
+            ((p^.right^.resulttype^.deftype=orddef) and
+            (porddef(p^.right^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) then
+           begin
+             if (porddef(p^.left^.resulttype)^.typ=bool8bit) or
+                (porddef(p^.right^.resulttype)^.typ=bool8bit) then
+               opsize:=S_B
+             else
+               if (porddef(p^.left^.resulttype)^.typ=bool16bit) or
+                  (porddef(p^.right^.resulttype)^.typ=bool16bit) then
+                 opsize:=S_W
+             else
+               opsize:=S_L;
+             case p^.treetype of
+              andn,
+               orn : begin
+                       p^.location.loc:=LOC_JUMP;
+                       cmpop:=false;
+                       case p^.treetype of
+                        andn : begin
+                                  otl:=truelabel;
+                                  getlabel(truelabel);
+                                  secondpass(p^.left);
+                                  maketojumpbool(p^.left);
+                                  emitl(A_LABEL,truelabel);
+                                  truelabel:=otl;
+                               end;
+                        orn : begin
+                                 ofl:=falselabel;
+                                 getlabel(falselabel);
+                                 secondpass(p^.left);
+                                 maketojumpbool(p^.left);
+                                 emitl(A_LABEL,falselabel);
+                                 falselabel:=ofl;
+                              end;
+                       else
+                         Message(sym_e_type_mismatch);
+                       end;
+                       secondpass(p^.right);
+                       maketojumpbool(p^.right);
+                     end;
+          unequaln,
+       equaln,xorn : begin
+                       if p^.left^.treetype=ordconstn then
+                        swaptree(p);
+                       secondpass(p^.left);
+                       p^.location:=p^.left^.location;
+                       { are enough registers free ? }
+                       pushed:=maybe_push(p^.right^.registers32,p);
+                       secondpass(p^.right);
+                       if pushed then restore(p);
+                       goto do_normal;
+                    end
+             else
+               Message(sym_e_type_mismatch);
+             end
+           end
+         else
+           begin
+              { in case of constant put it to the left }
+              if (p^.left^.treetype=ordconstn) then
+               swaptree(p);
+              secondpass(p^.left);
+              { this will be complicated as
+               a lot of code below assumes that
+               p^.location and p^.left^.location are the same }
+
+{$ifdef test_dest_loc}
+              if dest_loc_known and (dest_loc_tree=p) and
+                 ((dest_loc.loc=LOC_REGISTER) or (dest_loc.loc=LOC_CREGISTER)) then
+                begin
+                   set_location(p^.location,dest_loc);
+                   in_dest_loc:=true;
+                   is_in_dest:=true;
+                end
+              else
+{$endif test_dest_loc}
+                set_location(p^.location,p^.left^.location);
+
+              { are too few registers free? }
+              pushed:=maybe_push(p^.right^.registers32,p);
+              secondpass(p^.right);
+              if pushed then
+                restore(p);
+
+              if (p^.left^.resulttype^.deftype=pointerdef) or
+
+                 (p^.right^.resulttype^.deftype=pointerdef) or
+
+                 ((p^.right^.resulttype^.deftype=objectdef) and
+                  pobjectdef(p^.right^.resulttype)^.isclass and
+                 (p^.left^.resulttype^.deftype=objectdef) and
+                  pobjectdef(p^.left^.resulttype)^.isclass
+                 ) or
+
+                 (p^.left^.resulttype^.deftype=classrefdef) or
+
+                 (p^.left^.resulttype^.deftype=procvardef) or
+
+                 (p^.left^.resulttype^.deftype=enumdef) or
+
+                 ((p^.left^.resulttype^.deftype=orddef) and
+                 (porddef(p^.left^.resulttype)^.typ=s32bit)) or
+                 ((p^.right^.resulttype^.deftype=orddef) and
+                 (porddef(p^.right^.resulttype)^.typ=s32bit)) or
+
+                ((p^.left^.resulttype^.deftype=orddef) and
+                 (porddef(p^.left^.resulttype)^.typ=u32bit)) or
+                 ((p^.right^.resulttype^.deftype=orddef) and
+                 (porddef(p^.right^.resulttype)^.typ=u32bit)) or
+
+                { as well as small sets }
+                 is_set then
+                begin
+          do_normal:
+                   mboverflow:=false;
+                   cmpop:=false;
+                   if (p^.left^.resulttype^.deftype=pointerdef) or
+                      (p^.right^.resulttype^.deftype=pointerdef) or
+                      ((p^.left^.resulttype^.deftype=orddef) and
+                       (porddef(p^.left^.resulttype)^.typ=u32bit)) or
+                      ((p^.right^.resulttype^.deftype=orddef) and
+                       (porddef(p^.right^.resulttype)^.typ=u32bit)) then
+                     unsigned:=true;
+                   case p^.treetype of
+                      addn : begin
+                               if is_set then
+                                begin
+                                { adding elements is not commutative }
+                                  if p^.swaped and (p^.left^.treetype=setelementn) then
+                                   swaptree(p);
+                                { are we adding set elements ? }
+                                  if p^.right^.treetype=setelementn then
+                                   begin
+                                   { no range support for smallsets! }
+                                     if assigned(p^.right^.right) then
+                                      internalerror(43244);
+                                   { Not supported for m68k}
+                                     Comment(V_Fatal,'No smallsets for m68k');
+                                   end
+                                  else
+                                   op:=A_OR;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                end
+                               else
+                                begin
+                                  op:=A_ADD;
+                                  mboverflow:=true;
+                                end;
+                             end;
+                   symdifn : begin
+                               { the symetric diff is only for sets }
+                               if is_set then
+                                begin
+                                  op:=A_EOR;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                end
+                               else
+                                Message(sym_e_type_mismatch);
+                             end;
+                      muln : begin
+                               if is_set then
+                                begin
+                                  op:=A_AND;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                end
+                               else
+                                begin
+                                  if unsigned then
+                                   op:=A_MULU
+                                  else
+                                   op:=A_MULS;
+                                  mboverflow:=true;
+                                end;
+                             end;
+                      subn : begin
+                               if is_set then
+                                begin
+                                  op:=A_AND;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                  extra_not:=true;
+                                end
+                               else
+                                begin
+                                  op:=A_SUB;
+                                  mboverflow:=true;
+                                end;
+                             end;
+                  ltn,lten,
+                  gtn,gten,
+           equaln,unequaln : begin
+                               op:=A_CMP;
+                               cmpop:=true;
+                             end;
+                      xorn : op:=A_EOR;
+                       orn : op:=A_OR;
+                      andn : op:=A_AND;
+                   else
+                     Message(sym_e_type_mismatch);
+                   end;
+
+                   { left and right no register?  }
+                   { then one must be demanded    }
+                   if (p^.left^.location.loc<>LOC_REGISTER) and
+                      (p^.right^.location.loc<>LOC_REGISTER) then
+                     begin
+                        { register variable ? }
+                        if (p^.left^.location.loc=LOC_CREGISTER) then
+                          begin
+                             { it is OK if this is the destination }
+                             if is_in_dest then
+                               begin
+                                  hregister:=p^.location.register;
+                                  emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
+                                    hregister);
+                               end
+                             else
+                             if cmpop then
+                               begin
+                                  { do not disturb the register }
+                                  hregister:=p^.location.register;
+                               end
+                             else
+                               begin
+                                  emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
+                                    hregister);
+                               end
+                          end
+                        else
+                          begin
+                             del_reference(p^.left^.location.reference);
+                             if is_in_dest then
+                               begin
+                                  hregister:=p^.location.register;
+                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
+                                    newreference(p^.left^.location.reference),hregister)));
+                               end
+                             else
+                               begin
+                                  { first give free, then demand new register }
+                                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
+                                   newreference(p^.left^.location.reference),hregister)));
+                               end;
+                          end;
+                        p^.location.loc:=LOC_REGISTER;
+                        p^.location.register:=hregister;
+                     end
+                   else
+                     { if on the right the register then swap }
+                     if not(noswap) and (p^.right^.location.loc=LOC_REGISTER) then
+                       begin
+                          swap_location(p^.location,p^.right^.location);
+
+                          { newly swapped also set swapped flag }
+                          p^.swaped:=not(p^.swaped);
+                       end;
+                   { at this point, p^.location.loc should be LOC_REGISTER }
+                   { and p^.location.register should be a valid register   }
+                   { containing the left result                            }
+                   if p^.right^.location.loc<>LOC_REGISTER then
+                     begin
+                        if (p^.treetype=subn) and p^.swaped then
+                          begin
+                             if p^.right^.location.loc=LOC_CREGISTER then
+                               begin
+                                  if extra_not then
+                                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,opsize,p^.location.register)));
+
+                                  emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,R_D6);
+                                  emit_reg_reg(op,opsize,p^.location.register,R_D6);
+                                  emit_reg_reg(A_MOVE,opsize,R_D6,p^.location.register);
+                               end
+                             else
+                               begin
+                                  if extra_not then
+                                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,opsize,p^.location.register)));
+
+                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
+                                    newreference(p^.right^.location.reference),R_D6)));
+                                  exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,p^.location.register,R_D6)));
+                                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,opsize,R_D6,p^.location.register)));
+                                  del_reference(p^.right^.location.reference);
+                               end;
+                          end
+                        else
+                          begin
+                             if (p^.right^.treetype=ordconstn) and (op=A_CMP) and
+                                (p^.right^.value=0) then
+                                  exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,p^.location.register)))
+                             else
+                                if (p^.right^.treetype=ordconstn) and (op=A_MULS) and
+                                   (ispowerof2(p^.right^.value,power)) then
+                                  begin
+                                    if (power <= 8) then
+                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_ASL,opsize,power,
+                                         p^.location.register)))
+                                    else
+                                      begin
+                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,power,
+                                         R_D6)));
+                                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_ASL,opsize,R_D6,
+                                          p^.location.register)))
+                                      end;
+                                  end
+                             else
+                               begin
+                                  if (p^.right^.location.loc=LOC_CREGISTER) then
+                                    begin
+                                       if extra_not then
+                                         begin
+                                            emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D6);
+                                            exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,R_D6)));
+                                            emit_reg_reg(A_AND,S_L,R_D6,
+                                              p^.location.register);
+                                         end
+                                       else
+                                         begin
+                                            if (op=A_MULS) and (opsize = S_L) and (aktoptprocessor=MC68000) then
+                                            { Emulation for MC68000 }
+                                            begin
+                                              emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
+                                                 R_D0);
+                                              emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
+                                              emitcall('LONGMUL',true);
+                                              emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
+                                            end
+                                            else
+                                            if (op=A_MULU) and (opsize = S_L) and (aktoptprocessor=MC68000) then
+                                             Message(cg_f_32bit_not_supported_in_68000)
+                                            else
+                                              emit_reg_reg(op,opsize,p^.right^.location.register,
+                                                p^.location.register);
+                                         end;
+                                    end
+                                  else
+                                    begin
+                                       if extra_not then
+                                         begin
+                                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
+                                              p^.right^.location.reference),R_D6)));
+                                            exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,R_D6)));
+                                            emit_reg_reg(A_AND,S_L,R_D6,
+                                              p^.location.register);
+                                         end
+                                       else
+                                         begin
+                                            if (op=A_MULS) and (opsize = S_L) and (aktoptprocessor=MC68000) then
+                                            { Emulation for MC68000 }
+                                            begin
+                                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE, opsize,
+                                                 newreference(p^.right^.location.reference),R_D1)));
+                                              emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D0);
+                                              emitcall('LONGMUL',true);
+                                              emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
+                                            end
+                                            else
+                                            if (op=A_MULU) and (opsize = S_L) and (aktoptprocessor=MC68000) then
+                                             Message(cg_f_32bit_not_supported_in_68000)
+                                            else
+                                            { When one of the source/destination is a memory reference  }
+                                            { and the operator is EOR, the we must load it into the     }
+                                            { value into a register first since only EOR reg,reg exists }
+                                            { on the m68k                                               }
+                                            if (op=A_EOR) then
+                                              begin
+                                                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
+                                                    p^.right^.location.reference),R_D0)));
+                                                exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,R_D0,
+                                                    p^.location.register)));
+                                              end
+                                            else
+                                              exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,newreference(
+                                                p^.right^.location.reference),p^.location.register)));
+                                         end;
+                                       del_reference(p^.right^.location.reference);
+                                    end;
+                               end;
+                          end;
+                     end
+                   else
+                     begin
+                        { when swapped another result register }
+                        if (p^.treetype=subn) and p^.swaped then
+                          begin
+                             if extra_not then
+                               exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
+
+                             exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
+                               p^.location.register,p^.right^.location.register)));
+                               swap_location(p^.location,p^.right^.location);
+
+                               { newly swapped also set swapped flag }
+                               { just to maintain ordering           }
+                               p^.swaped:=not(p^.swaped);
+                          end
+                        else
+                          begin
+                             if extra_not then
+                                   exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.right^.location.register)));
+
+                             if (op=A_MULS) and (opsize = S_L) and (aktoptprocessor=MC68000) then
+                             { Emulation for MC68000 }
+                             begin
+                               emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
+                               R_D0);
+                               emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
+                               emitcall('LONGMUL',true);
+                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
+                             end
+                             else
+                             if (op=A_MULU) and (opsize = S_L) and (aktoptprocessor=MC68000) then
+                              Message(cg_f_32bit_not_supported_in_68000)
+                             else
+
+                               exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
+                               p^.right^.location.register,
+                               p^.location.register)));
+                          end;
+                       ungetregister32(p^.right^.location.register);
+                     end;
+
+                   if cmpop then
+                     ungetregister32(p^.location.register);
+
+                   { only in case of overflow operations }
+                   { produce overflow code }
+                   if mboverflow then
+                     emitoverflowcheck(p);
+                   { only in case of overflow operations }
+                   { produce overflow code }
+                   { we must put it here directly, because sign of operation }
+                   { is in unsigned VAR!!                                    }
+                end
+              else
+
+              { Char type }
+                if ((p^.left^.resulttype^.deftype=orddef) and
+                    (porddef(p^.left^.resulttype)^.typ=uchar)) then
+                 begin
+                   case p^.treetype of
+                      ltn,lten,gtn,gten,
+                      equaln,unequaln :
+                                cmpop:=true;
+                      else Message(sym_e_type_mismatch);
+                   end;
+                   unsigned:=true;
+                   { left and right no register? }
+                   { the one must be demanded    }
+                   if (p^.location.loc<>LOC_REGISTER) and
+                     (p^.right^.location.loc<>LOC_REGISTER) then
+                     begin
+                        if p^.location.loc=LOC_CREGISTER then
+                          begin
+                             if cmpop then
+                               { do not disturb register }
+                               hregister:=p^.location.register
+                             else
+                               begin
+                                  hregister:=getregister32;
+                                  emit_reg_reg(A_MOVE,S_B,p^.location.register,
+                                    hregister);
+                               end;
+                          end
+                        else
+                          begin
+                             del_reference(p^.location.reference);
+
+                             { first give free then demand new register }
+                             hregister:=getregister32;
+                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),
+                               hregister)));
+                          end;
+                        p^.location.loc:=LOC_REGISTER;
+                        p^.location.register:=hregister;
+                     end;
+
+                   { now p always a register }
+
+                   if (p^.right^.location.loc=LOC_REGISTER) and
+                      (p^.location.loc<>LOC_REGISTER) then
+                     begin
+                       swap_location(p^.location,p^.right^.location);
+
+                        { newly swapped also set swapped flag }
+                        p^.swaped:=not(p^.swaped);
+                     end;
+                   if p^.right^.location.loc<>LOC_REGISTER then
+                     begin
+                        if p^.right^.location.loc=LOC_CREGISTER then
+                          begin
+                             emit_reg_reg(A_CMP,S_B,
+                                p^.right^.location.register,p^.location.register);
+                          end
+                        else
+                          begin
+                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,S_B,newreference(
+                                p^.right^.location.reference),p^.location.register)));
+                             del_reference(p^.right^.location.reference);
+                          end;
+                     end
+                   else
+                     begin
+                        emit_reg_reg(A_CMP,S_B,p^.right^.location.register,
+                          p^.location.register);
+                        ungetregister32(p^.right^.location.register);
+                     end;
+                   ungetregister32(p^.location.register);
+                end
+              else
+
+              { Floating point }
+               if (p^.left^.resulttype^.deftype=floatdef) and
+                  (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
+                 begin
+                    { real constants to the left }
+                    if p^.left^.treetype=realconstn then
+                     swaptree(p);
+                    cmpop:=false;
+                    case p^.treetype of
+                       addn : op:=A_FADD;
+                       muln : op:=A_FMUL;
+                       subn : op:=A_FSUB;
+                       slashn : op:=A_FDIV;
+                       ltn,lten,gtn,gten,
+                       equaln,unequaln : begin
+                                            op:=A_FCMP;
+                                            cmpop:=true;
+                                         end;
+                       else Message(sym_e_type_mismatch);
+                    end;
+
+                    if (p^.left^.location.loc <> LOC_FPU) and
+                       (p^.right^.location.loc <> LOC_FPU) then
+                      begin
+                         { we suppose left in reference }
+                         del_reference(p^.left^.location.reference);
+                         { get a copy, since we don't want to modify the same }
+                         { node at the same time.                             }
+                         tmpref:=p^.left^.location.reference;
+                         if assigned(p^.left^.location.reference.symbol) then
+                           tmpref.symbol:=stringdup(p^.left^.location.reference.symbol^);
+
+                         floatload(pfloatdef(p^.left^.resulttype)^.typ, tmpref,
+                           p^.left^.location);
+                         clear_reference(tmpref);
+                      end
+                    else
+                      begin
+                        if (p^.right^.location.loc = LOC_FPU)
+                        and(p^.left^.location.loc <> LOC_FPU) then
+                           begin
+                             swap_location(p^.left^.location, p^.right^.location);
+                             p^.swaped := not(p^.swaped);
+                           end
+                      end;
+
+                   { ---------------- LEFT = LOC_FPUREG -------------------- }
+                       if ((p^.treetype =subn) or (p^.treetype = slashn)) and (p^.swaped) then
+                          {  fpu_reg =  right(FP1) / fpu_reg }
+                          {  fpu_reg = right(FP1) -  fpu_reg  }
+                          begin
+                             if (cs_fp_emulation in aktmoduleswitches) then
+                              begin
+                               { fpu_reg = right / D1 }
+                               { fpu_reg = right - D1 }
+                                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));
+
+
+                                  { load value into D1 }
+                                  if p^.right^.location.loc <> LOC_FPU then
+                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                       newreference(p^.right^.location.reference),R_D1)))
+                                  else
+                                     emit_reg_reg(A_MOVE,S_L,p^.right^.location.fpureg,R_D1);
+
+                                  { probably a faster way to do this but... }
+                                  case op of
+                                   A_FADD: emitcall('SINGLE_ADD',true);
+                                   A_FMUL: emitcall('SINGLE_MUL',true);
+                                   A_FSUB: emitcall('SINGLE_SUB',true);
+                                   A_FDIV: emitcall('SINGLE_DIV',true);
+                                   A_FCMP: emitcall('SINGLE_CMP',true);
+                                  end;
+                                  if not cmpop then { only flags are affected with cmpop }
+                                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
+                                       p^.left^.location.fpureg)));
+
+                                  { if this was a reference, then delete as it }
+                                  { it no longer required.                     }
+                                  if p^.right^.location.loc <> LOC_FPU then
+                                     del_reference(p^.right^.location.reference);
+                              end
+                             else
+                              begin
+
+                                  if p^.right^.location.loc <> LOC_FPU then
+                                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
+                                       getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
+                                      newreference(p^.right^.location.reference),
+                                      R_FP1)))
+                                  else
+                                    { FPm --> FPn must use extended precision }
+                                    emit_reg_reg(A_FMOVE,S_FX,p^.right^.location.fpureg,R_FP1);
+
+                                  { arithmetic expression performed in extended mode }
+                                  exprasmlist^.concat(new(pai68k,op_reg_reg(op,S_FX,
+                                      p^.left^.location.fpureg,R_FP1)));
+
+                                  { cmpop does not change any floating point register!! }
+                                  if not cmpop then
+                                       emit_reg_reg(A_FMOVE,S_FX,R_FP1,p^.left^.location.fpureg)
+{                                       exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
+                                       getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
+                                       R_FP1,p^.left^.location.fpureg)))}
+                                  else
+                                  { process comparison, to make it compatible with the rest of the code }
+                                      processcc(p);
+
+                                  { if this was a reference, then delete as it }
+                                  { it no longer required.                     }
+                                  if p^.right^.location.loc <> LOC_FPU then
+                                     del_reference(p^.right^.location.reference);
+                              end;
+                          end
+                       else { everything is in the right order }
+                         begin
+                           {  fpu_reg = fpu_reg / right }
+                           {  fpu_reg = fpu_reg - right }
+                           { + commutative ops }
+                           if cs_fp_emulation in aktmoduleswitches then
+                           begin
+
+                             { load value into D7 }
+                             if p^.right^.location.loc <> LOC_FPU then
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                 newreference(p^.right^.location.reference),R_D0)))
+                             else
+                               emit_reg_reg(A_MOVE,S_L,p^.right^.location.fpureg,R_D0);
+
+                             emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D1);
+                             { probably a faster way to do this but... }
+                             case op of
+                               A_FADD: emitcall('SINGLE_ADD',true);
+                               A_FMUL: emitcall('SINGLE_MUL',true);
+                               A_FSUB: emitcall('SINGLE_SUB',true);
+                               A_FDIV: emitcall('SINGLE_DIV',true);
+                               A_FCMP: emitcall('SINGLE_CMP',true);
+                             end;
+                             if not cmpop then { only flags are affected with cmpop }
+                               exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
+                                 p^.left^.location.fpureg)));
+                             { if this was a reference, then delete as it }
+                             { it no longer required.                     }
+                             if p^.right^.location.loc <> LOC_FPU then
+                               del_reference(p^.right^.location.reference);
+                           end
+                           else
+                           begin
+                             if p^.right^.location.loc <> LOC_FPU then
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
+                                 getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
+                                 newreference(p^.right^.location.reference),R_FP1)))
+                             else
+                               emit_reg_reg(A_FMOVE,getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
+                                 p^.right^.location.fpureg,R_FP1);
+
+                               emit_reg_reg(op,S_FX,R_FP1,p^.left^.location.fpureg);
+
+                               if cmpop then
+                                 processcc(p);
+
+                             { if this was a reference, then delete as it }
+                             { it no longer required.                     }
+                             if p^.right^.location.loc <> LOC_FPU then
+                               del_reference(p^.right^.location.reference);
+
+                           end
+                         end; { endif treetype = .. }
+
+
+                         if cmpop then
+                          begin
+                             if p^.swaped then
+                                 case p^.treetype of
+                                     equaln: flags := F_E;
+                                     unequaln: flags := F_NE;
+                                     ltn : flags := F_G;
+                                     lten : flags := F_GE;
+                                     gtn : flags := F_L;
+                                     gten: flags := F_LE;
+                                 end
+                             else
+                                 case p^.treetype of
+                                     equaln: flags := F_E;
+                                     unequaln : flags := F_NE;
+                                     ltn: flags := F_L;
+                                     lten : flags := F_LE;
+                                     gtn : flags := F_G;
+                                     gten: flags := F_GE;
+                                 end;
+                             p^.location.loc := LOC_FLAGS;
+                             p^.location.resflags := flags;
+                             cmpop := false;
+                          end
+                         else
+                         begin
+                             p^.location.loc := LOC_FPU;
+                             if p^.left^.location.loc = LOC_FPU then
+                             { copy fpu register result . }
+                             { HERE ON EXIT FPU REGISTER IS IN EXTENDED MODE! }
+                                p^.location.fpureg := p^.left^.location.fpureg
+                             else
+                             begin
+                               InternalError(34);
+                             end;
+                         end;
+                 end
+                
+
+              else Message(sym_e_type_mismatch);
+           end;
+       SetResultLocation(cmpop,unsigned,p);
+    end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}

compiler/cg68kcal.pas

@@ -0,0 +1,1055 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for in call nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kcal;
+interface
+
+    uses
+      symtable,tree;
+
+    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
+                push_from_left_to_right : boolean);
+    procedure secondcalln(var p : ptree);
+    procedure secondprocinline(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      aasm,types,
+      hcodegen,temp_gen,pass_2,
+      m68k,cga68k,tgen68k,cg68kld;
+
+{*****************************************************************************
+                             SecondCallParaN
+*****************************************************************************}
+
+    { save the size of pushed parameter }
+    var
+       pushedparasize : longint;
+
+    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
+                push_from_left_to_right : boolean);
+
+      procedure maybe_push_open_array_high;
+        var
+           r : preference;
+        begin
+           { open array ? }
+           { defcoll^.data can be nil for read/write }
+           if assigned(defcoll^.data) and
+              is_open_array(defcoll^.data) then
+             begin
+                inc(pushedparasize,4);
+                { push high }
+                if is_open_array(p^.left^.resulttype) then
+                 begin
+                   new(r);
+                   reset_reference(r^);
+                   r^.base:=highframepointer;
+                   r^.offset:=highoffset+4;
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)));
+                 end
+                else
+                 push_int(parraydef(p^.left^.resulttype)^.highrange-parraydef(p^.left^.resulttype)^.lowrange);
+             end;
+        end;
+
+      var
+         size : longint;
+         stackref : treference;
+         otlabel,hlabel,oflabel : plabel;
+         { temporary variables: }
+         reg : tregister;
+         tempdeftype : tdeftype;
+         tempreference : treference;
+         r : preference;
+         s : topsize;
+         op : tasmop;
+
+      begin
+         { push from left to right if specified }
+         if push_from_left_to_right and assigned(p^.right) then
+           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         secondpass(p^.left);
+         { in codegen.handleread.. defcoll^.data is set to nil }
+         if assigned(defcoll^.data) and
+           (defcoll^.data^.deftype=formaldef) then
+           begin
+              { allow @var }
+              if p^.left^.treetype=addrn then
+                begin
+                   { allways a register }
+                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_SPPUSH)));
+                   ungetregister32(p^.left^.location.register);
+                end
+              else
+                begin
+                   if (p^.left^.location.loc<>LOC_REFERENCE) and
+                      (p^.left^.location.loc<>LOC_MEM) then
+                     Message(sym_e_type_mismatch)
+                   else
+                     begin
+                        emitpushreferenceaddr(p^.left^.location.reference);
+                        del_reference(p^.left^.location.reference);
+                     end;
+                end;
+              inc(pushedparasize,4);
+           end
+         { handle call by reference parameter }
+         else if (defcoll^.paratyp=vs_var) then
+           begin
+              if (p^.left^.location.loc<>LOC_REFERENCE) then
+                Message(cg_e_var_must_be_reference);
+              maybe_push_open_array_high;
+              inc(pushedparasize,4);
+              emitpushreferenceaddr(p^.left^.location.reference);
+              del_reference(p^.left^.location.reference);
+           end
+         else
+           begin
+              tempdeftype:=p^.resulttype^.deftype;
+              if tempdeftype=filedef then
+               Message(cg_e_file_must_call_by_reference);
+              if (defcoll^.paratyp=vs_const) and
+                 dont_copy_const_param(p^.resulttype) then
+                begin
+                   maybe_push_open_array_high;
+                   inc(pushedparasize,4);
+                   emitpushreferenceaddr(p^.left^.location.reference);
+                   del_reference(p^.left^.location.reference);
+                end
+              else
+                case p^.left^.location.loc of
+                   LOC_REGISTER,
+                   LOC_CREGISTER : begin
+                                   { HERE IS A BIG PROBLEM }
+                                   { --> We *MUST* know the data size to push     }
+                                   { for the moment, we can say that the savesize }
+                                   { indicates the parameter size to push, but    }
+                                   { that is CERTAINLY NOT TRUE!                  }
+                                   { CAN WE USE LIKE LOC_MEM OR LOC_REFERENCE??   }
+                                     case integer(p^.left^.resulttype^.savesize) of
+                                     1 : Begin
+                                     { A byte sized value normally increments       }
+                                     { the SP by 2, BUT because how memory has      }
+                                     { been setup OR because of GAS, a byte sized   }
+                                     { push CRASHES the Amiga, therefore, we do it  }
+                                     { by hand instead.                             }
+                                     {  PUSH A WORD SHIFTED LEFT 8                  }
+                                           reg := getregister32;
+                                           emit_reg_reg(A_MOVE, S_B, p^.left^.location.register, reg);
+                                           exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
+                                             8, reg)));
+                                           exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
+                                            reg,R_SPPUSH)));
+                                           { offset will be TWO greater              }
+                                           inc(pushedparasize,2);
+                                           ungetregister32(reg);
+                                           ungetregister32(p^.left^.location.register);
+                                         end;
+                                     2 :
+                                              Begin
+                                                 exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
+                                                   p^.left^.location.register,R_SPPUSH)));
+                                                 inc(pushedparasize,2);
+                                                 ungetregister32(p^.left^.location.register);
+                                              end;
+                                      4 : Begin
+                                             exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+                                                 p^.left^.location.register,R_SPPUSH)));
+                                             inc(pushedparasize,4);
+                                             ungetregister32(p^.left^.location.register);
+                                          end;
+                                      else
+                                       Begin
+                                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+                                           p^.left^.location.register,R_SPPUSH)));
+                                         inc(pushedparasize,4);
+                                         ungetregister32(p^.left^.location.register);
+                                       end;
+                                     end; { end case }
+                                   end;
+                   LOC_FPU : begin
+                                        size:=pfloatdef(p^.left^.resulttype)^.size;
+                                        inc(pushedparasize,size);
+                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)));
+                                        new(r);
+                                        reset_reference(r^);
+                                        r^.base:=R_SP;
+                                        s:=getfloatsize(pfloatdef(p^.left^.resulttype)^.typ);
+                                        if (cs_fp_emulation in aktmoduleswitches) or (s=S_FS) then
+                                        begin
+                                          { when in emulation mode... }
+                                          { only single supported!!!  }
+                                          exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
+                                             p^.left^.location.fpureg,r)));
+                                        end
+                                        else
+                                          { convert back from extended to normal type }
+                                          exprasmlist^.concat(new(pai68k,op_reg_ref(A_FMOVE,s,
+                                             p^.left^.location.fpureg,r)));
+                                     end;
+                   LOC_REFERENCE,LOC_MEM :
+                               begin
+                                  tempreference:=p^.left^.location.reference;
+                                  del_reference(p^.left^.location.reference);
+                                  case p^.resulttype^.deftype of
+                                     orddef : begin
+                                                   case porddef(p^.resulttype)^.typ of
+                                                      s32bit,u32bit :
+                                                        begin
+                                                           emit_push_mem(tempreference);
+                                                           inc(pushedparasize,4);
+                                                        end;
+                                                      s8bit,u8bit,uchar,bool8bit:
+                                                      Begin
+                                                          { We push a BUT, the SP is incremented by 2      }
+                                                          { as specified in the Motorola Prog's Ref Manual }
+                                                          { Therefore offet increments BY 2!!!             }
+                                                          { BUG??? ...                                     }
+                                                          { SWAP OPERANDS:                                 }
+                                                          if tempreference.isintvalue then
+                                                          Begin
+                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,
+                                                             tempreference.offset shl 8,R_SPPUSH)));
+                                                          end
+                                                          else
+                                                          Begin
+                                                           { A byte sized value normally increments       }
+                                                           { the SP by 2, BUT because how memory has      }
+                                                           { been setup OR because of GAS, a byte sized   }
+                                                           { push CRASHES the Amiga, therefore, we do it  }
+                                                           { by hand instead.                             }
+                                                           {  PUSH A WORD SHIFTED LEFT 8                  }
+                                                            reg:=getregister32;
+                                                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
+                                                             newreference(tempreference),reg)));
+                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
+                                                             8, reg)));
+                                                            exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
+                                                             reg,R_SPPUSH)));
+                                                            ungetregister32(reg);
+{                                                           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
+                                                             newreference(tempreference),R_SPPUSH))); }
+                                                          end;
+                                                          inc(pushedparasize,2);
+
+                                                      end;
+                                                      s16bit,u16bit : begin
+                                                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
+                                                            newreference(tempreference),R_SPPUSH)));
+                                                          inc(pushedparasize,2);
+                                                      end;
+                                                    end;
+                                              end;
+                                     floatdef : begin
+                                                   case pfloatdef(p^.resulttype)^.typ of
+                                                      f32bit,
+                                                      s32real :
+                                                        begin
+                                                           emit_push_mem(tempreference);
+                                                           inc(pushedparasize,4);
+                                                        end;
+                                                      s64real:
+                                                      {s64bit }
+                                                                begin
+                                                                   inc(tempreference.offset,4);
+                                                                   emit_push_mem(tempreference);
+                                                                   dec(tempreference.offset,4);
+                                                                   emit_push_mem(tempreference);
+                                                                   inc(pushedparasize,8);
+                                                                end;
+{$ifdef use48}
+                                                      s48real : begin
+                                                                end;
+{$endif}
+                                                      s80real : begin
+                                                                    Message(cg_f_extended_cg68k_not_supported);
+{                                                                   inc(tempreference.offset,6);
+                                                                   emit_push_mem(tempreference);
+                                                                   dec(tempreference.offset,4);
+                                                                   emit_push_mem(tempreference);
+                                                                   dec(tempreference.offset,2);
+                                                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
+                                                                     newreference(tempreference),R_SPPUSH)));
+                                                                   inc(pushedparasize,extended_size);}
+                                                                end;
+                                                   end;
+                                                end;
+                                     pointerdef,procvardef,
+                                         enumdef,classrefdef:  begin
+                                                      emit_push_mem(tempreference);
+                                                      inc(pushedparasize,4);
+                                                   end;
+                                     arraydef,recorddef,stringdef,setdef,objectdef :
+                                                begin
+                                                   if ((p^.resulttype^.deftype=setdef) and
+                                                     (psetdef(p^.resulttype)^.settype=smallset)) then
+                                                     begin
+                                                        emit_push_mem(tempreference);
+                                                        inc(pushedparasize,4);
+                                                     end
+                                                   else
+                                                     begin
+                                                        size:=p^.resulttype^.size;
+
+                                                        { Alignment }
+                                                        {
+                                                        if (size>=4) and ((size and 3)<>0) then
+                                                          inc(size,4-(size and 3))
+                                                        else if (size>=2) and ((size and 1)<>0) then
+                                                          inc(size,2-(size and 1))
+                                                        else
+                                                        if size=1 then size:=2;
+                                                        }
+                                                        { create stack space }
+                                                        if (size > 0) and (size < 9) then
+                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)))
+                                                        else
+                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBA,
+                                                              S_L,size,R_SP)));
+                                                        inc(pushedparasize,size);
+                                                        { create stack reference }
+                                                        stackref.symbol := nil;
+                                                        clear_reference(stackref);
+                                                        stackref.base:=R_SP;
+                                                        { produce copy }
+                                                        if p^.resulttype^.deftype=stringdef then
+                                                          begin
+                                                             copystring(stackref,p^.left^.location.reference,
+                                                               pstringdef(p^.resulttype)^.len);
+                                                          end
+                                                        else
+                                                          begin
+                                                             concatcopy(p^.left^.location.reference,
+                                                             stackref,p^.resulttype^.size,true);
+                                                          end;
+                                                     end;
+                                                end;
+                                     else Message(cg_e_illegal_expression);
+                                  end;
+                               end;
+                 LOC_JUMP     : begin
+                                   getlabel(hlabel);
+                                   inc(pushedparasize,2);
+                                   emitl(A_LABEL,truelabel);
+                                   exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,1 shl 8,R_SPPUSH)));
+                                   emitl(A_JMP,hlabel);
+                                   emitl(A_LABEL,falselabel);
+                                   exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,0,R_SPPUSH)));
+                                   emitl(A_LABEL,hlabel);
+                                end;
+                 LOC_FLAGS    : begin
+                                   exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
+                                     R_D0)));
+                                   exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
+                                   exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_W,$ff, R_D0)));
+                                   inc(pushedparasize,2);
+                                   { ----------------- HACK ----------------------- }
+                                   { HERE IS THE BYTE SIZED PUSH HACK ONCE AGAIN    }
+                                   { SHIFT LEFT THE BYTE TO MAKE IT WORK!           }
+                                   exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,8, R_D0)));
+                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,R_D0,R_SPPUSH)));
+                                end;
+                end;
+           end;
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+         { push from right to left }
+         if not push_from_left_to_right and assigned(p^.right) then
+           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
+      end;
+
+
+{*****************************************************************************
+                             SecondCallN
+*****************************************************************************}
+
+    procedure secondcalln(var p : ptree);
+
+      var
+         unusedregisters : tregisterset;
+         pushed : tpushed;
+         funcretref : treference;
+         hregister : tregister;
+         oldpushedparasize : longint;
+         { true if a5 must be loaded again after the subroutine }
+         loada5 : boolean;
+         { true if a virtual method must be called directly }
+         no_virtual_call : boolean;
+         { true if we produce a con- or destrutor in a call }
+         is_con_or_destructor : boolean;
+         { true if a constructor is called again }
+         extended_new : boolean;
+         { adress returned from an I/O-error }
+         iolabel : plabel;
+         { lexlevel count }
+         i : longint;
+         { help reference pointer }
+         r : preference;
+         pp,params : ptree;
+         { temp register allocation }
+         reg: tregister;
+         { help reference pointer }
+         ref: preference;
+
+      label
+         dont_call;
+
+      begin
+         extended_new:=false;
+         iolabel:=nil;
+         loada5:=true;
+         no_virtual_call:=false;
+         unusedregisters:=unused;
+         if not assigned(p^.procdefinition) then
+           exit;
+         { only if no proc var }
+         if not(assigned(p^.right)) then
+           is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
+             or ((p^.procdefinition^.options and podestructor)<>0);
+         { proc variables destroy all registers }
+         if (p^.right=nil) and
+         { virtual methods too }
+           ((p^.procdefinition^.options and povirtualmethod)=0) then
+           begin
+              if ((p^.procdefinition^.options and poiocheck)<>0)
+                and (cs_check_io in aktlocalswitches) then
+                begin
+                       getlabel(iolabel);
+                   emitl(A_LABEL,iolabel);
+                end
+              else iolabel:=nil;
+
+              { save all used registers }
+              pushusedregisters(pushed,p^.procdefinition^.usedregisters);
+
+              { give used registers through }
+              usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
+           end
+         else
+           begin
+              pushusedregisters(pushed,$ffff);
+              usedinproc:=$ffff;
+
+              { no IO check for methods and procedure variables }
+              iolabel:=nil;
+           end;
+
+         { generate the code for the parameter and push them }
+         oldpushedparasize:=pushedparasize;
+         pushedparasize:=0;
+         if (p^.resulttype<>pdef(voiddef)) and
+            ret_in_param(p^.resulttype) then
+           begin
+              funcretref.symbol:=nil;
+{$ifdef test_dest_loc}
+              if dest_loc_known and (dest_loc_tree=p) and
+                 (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
+                begin
+                   funcretref:=dest_loc.reference;
+                   if assigned(dest_loc.reference.symbol) then
+                     funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
+                   in_dest_loc:=true;
+                end
+              else
+{$endif test_dest_loc}
+              gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
+           end;
+         if assigned(p^.left) then
+           begin
+              pushedparasize:=0;
+              { be found elsewhere }
+              if assigned(p^.right) then
+                secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
+                  (p^.procdefinition^.options and poleftright)<>0)
+              else
+                secondcallparan(p^.left,p^.procdefinition^.para1,
+                  (p^.procdefinition^.options and poleftright)<>0);
+           end;
+         params:=p^.left;
+         p^.left:=nil;
+         if ret_in_param(p^.resulttype) then
+           begin
+              emitpushreferenceaddr(funcretref);
+              inc(pushedparasize,4);
+           end;
+         { overloaded operator have no symtable }
+         if (p^.right=nil) then
+           begin
+              { push self }
+              if assigned(p^.symtable) and
+                (p^.symtable^.symtabletype=withsymtable) then
+                begin
+                   { dirty trick to avoid the secondcall below }
+                   p^.methodpointer:=genzeronode(callparan);
+                   p^.methodpointer^.location.loc:=LOC_REGISTER;
+                   p^.methodpointer^.location.register:=R_A5;
+                   { make a reference }
+                   new(r);
+                   reset_reference(r^);
+                   r^.offset:=p^.symtable^.datasize;
+                   r^.base:=procinfo.framepointer;
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
+                end;
+
+              { push self }
+              if assigned(p^.symtable) and
+                ((p^.symtable^.symtabletype=objectsymtable) or
+                (p^.symtable^.symtabletype=withsymtable)) then
+                begin
+                   if assigned(p^.methodpointer) then
+                     begin
+                        case p^.methodpointer^.treetype of
+                           typen : begin
+                                      { direct call to inherited method }
+                                      if (p^.procdefinition^.options and poabstractmethod)<>0 then
+                                        begin
+                                           Message(cg_e_cant_call_abstract_method);
+                                           goto dont_call;
+                                        end;
+                                      { generate no virtual call }
+                                      no_virtual_call:=true;
+                             if (p^.symtableprocentry^.properties and sp_static)<>0 then
+                                 begin
+                                    { well lets put the VMT address directly into a5 }
+                                    { it is kind of dirty but that is the simplest    }
+                                    { way to accept virtual static functions (PM)     }
+                                    loada5:=true;
+                                    exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,S_L,
+                                      newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_A5)));
+                                    concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
+                                    exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
+                                 end
+                               else
+
+                                  { this is a member call, so A5 isn't modfied }
+                                  loada5:=false;
+
+                               if not(is_con_or_destructor and
+                                  pobjectdef(p^.methodpointer^.resulttype)^.isclass and
+                                  assigned(aktprocsym) and
+                                  ((aktprocsym^.definition^.options and
+                                  (poconstructor or podestructor))<>0)) then
+                                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
+                                 { if an inherited con- or destructor should be  }
+                                 { called in a con- or destructor then a warning }
+                                 { will be made                                  }
+                                 { con- and destructors need a pointer to the vmt }
+                                 if is_con_or_destructor and
+                                   ((pobjectdef(p^.methodpointer^.resulttype)^.options and oois_class)=0) and
+                                   assigned(aktprocsym) then
+                                   begin
+                                    if not ((aktprocsym^.definition^.options
+                                      and (poconstructor or podestructor))<>0) then
+                                        Message(cg_w_member_cd_call_from_method);
+                                   end;
+                                      { con- and destructors need a pointer to the vmt }
+                                      if is_con_or_destructor then
+                                        begin
+                                           { classes need the mem ! }
+                                           if ((pobjectdef(p^.methodpointer^.resulttype)^.options and
+
+                                            oois_class)=0) then
+                                             push_int(0)
+                                           else
+                                               begin
+                                                  exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,
+                                                   S_L,newcsymbol(pobjectdef(p^.methodpointer^.
+                                                   resulttype)^.vmt_mangledname,0))));
+                                                   concat_external(pobjectdef(p^.methodpointer^.resulttype)^.
+                                                  vmt_mangledname,EXT_NEAR);
+                                               end;
+                                        end;
+                                   end;
+                           hnewn : begin
+                                     { extended syntax of new }
+                                     { A5 must be zero }
+                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,0,R_A5)));
+                                     emit_reg_reg(A_MOVE,S_L,R_A5, R_SPPUSH);
+                                     { insert the vmt }
+                                     exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
+                                       newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
+                                     concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
+                                              extended_new:=true;
+                                  end;
+                           hdisposen : begin
+                                          secondpass(p^.methodpointer);
+
+                                          { destructor with extended syntax called from dispose }
+                                          { hdisposen always deliver LOC_REFRENZ }
+                                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+                                            newreference(p^.methodpointer^.location.reference),R_A5)));
+                                          del_reference(p^.methodpointer^.location.reference);
+                                          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
+                                          exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
+                                            newcsymbol(pobjectdef
+                                               (p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
+                                          concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
+                                       end;
+                           else
+                             begin
+                                { call to a instance member }
+                                if (p^.symtable^.symtabletype<>withsymtable) then
+                                  begin
+                                     secondpass(p^.methodpointer);
+
+
+                                     case p^.methodpointer^.location.loc of
+                                        LOC_REGISTER :
+                                           begin
+                                             ungetregister32(p^.methodpointer^.location.register);
+                                             emit_reg_reg(A_MOVE,S_L,p^.methodpointer^.location.register,R_A5);
+                                           end;
+                                        else
+                                           begin
+                                                 if (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                                   pobjectdef(p^.methodpointer^.resulttype)^.isclass then
+                                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                                     newreference(p^.methodpointer^.location.reference),R_A5)))
+                                                 else
+                                                  Begin
+                                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+                                                     newreference(p^.methodpointer^.location.reference),R_A5)));
+                                                  end;
+
+                                                del_reference(p^.methodpointer^.location.reference);
+                                             end;
+                                     end;
+                                  end;
+                                    { when calling a class method, we have
+                                      to load ESI with the VMT !
+                                      But that's wrong, if we call a class method via self
+                                    }
+                                    if ((p^.procdefinition^.options and poclassmethod)<>0)
+                                       and not(p^.methodpointer^.treetype=selfn) then
+                                      begin
+                                         { class method needs current VMT }
+                                         new(r);
+                                         reset_reference(r^);
+                                         r^.base:=R_A5;
+                                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
+                                      end;
+
+                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
+                                   if is_con_or_destructor then
+                                   begin
+                                         { classes don't get a VMT pointer pushed }
+                                         if (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                           not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                           begin
+
+                                            if ((p^.procdefinition^.options and poconstructor)<>0) then
+                                              begin
+                                               { it's no bad idea, to insert the VMT }
+                                                      exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
+                                               newcsymbol(pobjectdef(
+                                                 p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
+                                               concat_external(pobjectdef(
+                                                 p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
+                                              end
+                                            { destructors haven't to dispose the instance, if this is }
+                                            { a direct call                                           }
+                                            else
+                                              push_int(0);
+                                           end;
+                                  end;
+                             end;
+                        end;
+                     end
+                   else
+                     begin
+                         if ((p^.procdefinition^.options and poclassmethod)<>0) and
+                          not(
+                            assigned(aktprocsym) and
+                            ((aktprocsym^.definition^.options and poclassmethod)<>0)
+                          ) then
+                          begin
+                             { class method needs current VMT }
+                             new(r);
+                             reset_reference(r^);
+                             r^.base:=R_A5;
+                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
+                          end
+                        else
+                          begin
+                             { member call, A5 isn't modified }
+                             loada5:=false;
+                          end;
+                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
+            { but a con- or destructor here would probably almost }
+                        { always be placed wrong }
+                        if is_con_or_destructor then
+                          begin
+                             Message(cg_w_member_cd_call_from_method);
+                             { not insert VMT pointer }                             { VMT-Zeiger nicht eintragen }
+                             push_int(0);
+                          end;
+                     end;
+                end;
+
+              { push base pointer ?}
+              if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
+            ((p^.procdefinition^.parast^.symtablelevel)>2) then
+                    begin
+                   { if we call a nested function in a method, we must      }
+                   { push also SELF!                                        }
+                   { THAT'S NOT TRUE, we have to load ESI via frame pointer }
+                   { access                                                 }
+                   {
+                     begin
+                        loadesi:=false;
+                        exprasmlist^.concat(new(pai68k,op_reg(A_PUSH,S_L,R_ESI)));
+                     end;
+                   }
+                   if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
+                     begin
+                        new(r);
+                        reset_reference(r^);
+                        r^.offset:=procinfo.framepointer_offset;
+                        r^.base:=procinfo.framepointer;
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)))
+                     end
+                     { this is only true if the difference is one !!
+                       but it cannot be more !! }
+                   else if lexlevel=(p^.procdefinition^.parast^.symtablelevel)-1 then
+                     begin
+                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,procinfo.framepointer,R_SPPUSH)))
+                     end
+                   else if lexlevel>(p^.procdefinition^.parast^.symtablelevel) then
+                     begin
+                        hregister:=getaddressreg;
+                        new(r);
+                        reset_reference(r^);
+                        r^.offset:=procinfo.framepointer_offset;
+                        r^.base:=procinfo.framepointer;
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
+                        for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
+                          begin
+                             new(r);
+                             reset_reference(r^);
+                             {we should get the correct frame_pointer_offset at each level
+                             how can we do this !!! }
+                             r^.offset:=procinfo.framepointer_offset;
+                             r^.base:=hregister;
+                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
+                          end;
+                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH)));
+                        ungetregister32(hregister);
+                     end
+                   else
+                     internalerror(25000);
+                end;
+
+              { exported methods should be never called direct }
+              if (p^.procdefinition^.options and poexports)<>0 then
+               Message(cg_e_dont_call_exported_direct);
+
+              if ((p^.procdefinition^.options and povirtualmethod)<>0) and
+                 not(no_virtual_call) then
+                begin
+                   { static functions contain the vmt_address in ESI }
+                   { also class methods                              }
+                   if assigned(aktprocsym) then
+                     begin
+                       if ((aktprocsym^.properties and sp_static)<>0) or
+                        ((aktprocsym^.definition^.options and poclassmethod)<>0) or
+                        ((p^.procdefinition^.options and postaticmethod)<>0) or
+                        { A5 is already loaded  }
+                        ((p^.procdefinition^.options and poclassmethod)<>0)then
+                         begin
+                            new(r);
+                            reset_reference(r^);
+                            r^.base:=R_a5;
+                         end
+                       else
+                         begin
+                            new(r);
+                            reset_reference(r^);
+                            r^.base:=R_a5;
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
+                            new(r);
+                            reset_reference(r^);
+                            r^.base:=R_a0;
+                         end;
+                     end
+                   else
+                     begin
+                       new(r);
+                       reset_reference(r^);
+                         r^.base:=R_a5;
+                       exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
+                       new(r);
+                       reset_reference(r^);
+                       r^.base:=R_a0;
+                     end;
+                  if p^.procdefinition^.extnumber=-1 then
+                        internalerror($Da);
+                  r^.offset:=p^.procdefinition^.extnumber*4+12;
+                  if (cs_check_range in aktlocalswitches) then
+                    begin
+                     { If the base is already A0, the no instruction will }
+                     { be emitted!                                        }
+                     emit_reg_reg(A_MOVE,S_L,r^.base,R_A0);
+                        emitcall('CHECK_OBJECT',true);
+                    end;
+                   { This was wrong we must then load the address into the }
+                   { register a0 and/or a5                                 }
+                   { Because doing an indirect call with offset is NOT     }
+                   { allowed on the m68k!                                  }
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r^),R_A0)));
+                   { clear the reference }
+                   reset_reference(r^);
+                   r^.base := R_A0;
+                  exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,r)));
+                end
+              else if (p^.procdefinition^.options and popalmossyscall)<>0 then
+                begin
+                   exprasmlist^.concat(new(pai68k,op_const(A_TRAP,S_NO,15)));
+                   exprasmlist^.concat(new(pai_const,init_16bit(p^.procdefinition^.extnumber)));
+                end
+              else
+                emitcall(p^.procdefinition^.mangledname,
+                  p^.symtableproc^.symtabletype=unitsymtable);
+              if ((p^.procdefinition^.options and poclearstack)<>0) then
+                begin
+                   if (pushedparasize > 0) and (pushedparasize < 9) then
+                     { restore the stack, to its initial value }
+                     exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,pushedparasize,R_SP)))
+                   else
+                     { restore the stack, to its initial value }
+                     exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDA,S_L,pushedparasize,R_SP)));
+                end;
+           end
+         else
+           begin
+              secondpass(p^.right);
+              case p^.right^.location.loc of
+                 LOC_REGISTER,
+                 LOC_CREGISTER : begin
+                                   if p^.right^.location.register in [R_D0..R_D7] then
+                                    begin
+                                       reg := getaddressreg;
+                                       emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,reg);
+                                       new(ref);
+                                       reset_reference(ref^);
+                                       ref^.base := reg;
+                                       exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
+                                       ungetregister(reg);
+                                    end
+                                   else
+                                    begin
+                                        new(ref);
+                                        reset_reference(ref^);
+                                        ref^.base := p^.right^.location.register;
+                                        exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
+                                    end;
+                                   ungetregister32(p^.right^.location.register);
+                                end
+                 else
+                    begin
+                      if assigned(p^.right^.location.reference.symbol) then
+                      { Here we have a symbolic name to the routine, so solve  }
+                      { problem by loading the address first, and then emitting }
+                      { the call.                                              }
+                       begin
+                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                           newreference(p^.right^.location.reference),R_A1)));
+                         new(ref);
+                         reset_reference(ref^);
+                         ref^.base := R_A1;
+                         exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
+                       end
+                       else
+                       begin
+                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                           newreference(p^.right^.location.reference),R_A1)));
+                         new(ref);
+                         reset_reference(ref^);
+                         ref^.base := R_A1;
+                         exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
+                       end;
+                       del_reference(p^.right^.location.reference);
+                    end;
+              end;
+           end;
+      dont_call:
+         pushedparasize:=oldpushedparasize;
+         unused:=unusedregisters;
+
+         { handle function results }
+         if p^.resulttype<>pdef(voiddef) then
+           begin
+
+              { a contructor could be a function with boolean result }
+              if (p^.right=nil) and
+                 ((p^.procdefinition^.options and poconstructor)<>0) and
+                 { quick'n'dirty check if it is a class or an object }
+                 (p^.resulttype^.deftype=orddef) then
+                begin
+                   p^.location.loc:=LOC_FLAGS;
+                   p^.location.resflags:=F_NE;
+                   if extended_new then
+                     begin
+{$ifdef test_dest_loc}
+                        if dest_loc_known and (dest_loc_tree=p) then
+                          mov_reg_to_dest(p,S_L,R_EAX)
+                        else
+{$endif test_dest_loc}
+                               hregister:=getregister32;
+                               emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
+                               p^.location.register:=hregister;
+                     end;
+                end
+              { structed results are easy to handle.... }
+              else if ret_in_param(p^.resulttype) then
+                begin
+                   p^.location.loc:=LOC_MEM;
+                   stringdispose(p^.location.reference.symbol);
+                   p^.location.reference:=funcretref;
+                end
+              else
+                begin
+                   if (p^.resulttype^.deftype=orddef) then
+                     begin
+                        p^.location.loc:=LOC_REGISTER;
+                  case porddef(p^.resulttype)^.typ of
+                     s32bit,u32bit :
+                        begin
+                             hregister:=getregister32;
+                             emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
+                             p^.location.register:=hregister;
+                        end;
+                     uchar,u8bit,bool8bit,s8bit :
+                        begin
+                            hregister:=getregister32;
+                            emit_reg_reg(A_MOVE,S_B,R_D0,hregister);
+                            p^.location.register:=hregister;
+                        end;
+                     s16bit,u16bit :
+                       begin
+                           hregister:=getregister32;
+                           emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
+                           p^.location.register:=hregister;
+                       end;
+                           else internalerror(7);
+                        end
+                     end
+                   else if (p^.resulttype^.deftype=floatdef) then
+                      case pfloatdef(p^.resulttype)^.typ of
+                           f32bit :
+                              begin
+                                p^.location.loc:=LOC_REGISTER;
+                                hregister:=getregister32;
+                                emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
+                                p^.location.register:=hregister;
+                      end;
+                     s32real :  Begin
+                                   p^.location.loc:=LOC_FPU;
+                                   hregister:=getregister32;
+                                   emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
+                                   p^.location.fpureg:=hregister;
+                                end;
+                     s64bit,s64real,s80real: begin
+                                              if cs_fp_emulation in aktmoduleswitches then
+                                              begin
+                                                p^.location.loc:=LOC_FPU;
+                                                hregister:=getregister32;
+                                                emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
+                                                p^.location.fpureg:=hregister;
+                                              end
+                                              else
+                                              begin
+                                                { TRUE FPU mode }
+                                                p^.location.loc:=LOC_FPU;
+                                                { on exit of function result in R_FP0 }
+                                                p^.location.fpureg:=R_FP0;
+                                              end;
+                                             end;
+                           else
+                      begin
+                              p^.location.loc:=LOC_FPU;
+                              p^.location.fpureg:=R_FP0;
+                      end;
+             end {end case }
+       else
+        begin
+            p^.location.loc:=LOC_REGISTER;
+            hregister:=getregister32;
+            emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
+            p^.location.register:=hregister;
+                end;
+           end;
+         end;
+         { perhaps i/o check ? }
+         if iolabel<>nil then
+           begin
+              exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
+              { this was wrong, probably an error due to diff3
+              emitcall(p^.procdefinition^.mangledname);}
+              emitcall('IOCHECK',true);
+           end;
+
+         { restore registers }
+         popusedregisters(pushed);
+
+         { at last, restore instance pointer (SELF) }
+         if loada5 then
+           maybe_loada5;
+         pp:=params;
+         while assigned(pp) do
+           begin
+             if assigned(pp^.left) then
+               if (pp^.left^.location.loc=LOC_REFERENCE) or
+                 (pp^.left^.location.loc=LOC_MEM) then
+                 ungetiftemp(pp^.left^.location.reference);
+               pp:=pp^.right;
+           end;
+         disposetree(params);
+      end;
+
+
+{*****************************************************************************
+                             SecondProcInlineN
+*****************************************************************************}
+
+    procedure secondprocinline(var p : ptree);
+       begin
+         InternalError(132421);
+       end;
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}
+

compiler/cg68kcnv.pas

@@ -0,0 +1,1382 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for type converting nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{$ifdef TP}
+  {$E+,F+,N+}
+{$endif}
+unit cg68kcnv;
+interface
+
+    uses
+      tree;
+
+    procedure secondtypeconv(var p : ptree);
+    procedure secondas(var p : ptree);
+    procedure secondis(var p : ptree);
+
+
+implementation
+
+   uses
+     cobjects,verbose,globals,systems,
+     symtable,aasm,types,
+     hcodegen,temp_gen,pass_2,
+     m68k,cga68k,tgen68k;
+
+{*****************************************************************************
+                             SecondTypeConv
+*****************************************************************************}
+
+    procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
+
+      var
+         hp : preference;
+       hregister : tregister;
+       neglabel,poslabel : plabel;
+
+      begin
+         { convert from p2 to p1 }
+         { range check from enums is not made yet !!}
+         { and its probably not easy }
+         if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
+           exit;
+           { range checking is different for u32bit }
+           { lets try to generate it allways }
+           if (cs_check_range in aktlocalswitches)  and
+             { with $R+ explicit type conversations in TP aren't range checked! }
+             (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) and
+             ((porddef(p1)^.low>porddef(p2)^.low) or
+             (porddef(p1)^.high<porddef(p2)^.high) or
+             (porddef(p1)^.typ=u32bit) or
+             (porddef(p2)^.typ=u32bit)) then
+           begin
+              porddef(p1)^.genrangecheck;
+              if porddef(p2)^.typ=u8bit then
+                begin
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     begin
+                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
+                         exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
+                     end
+                   else
+                     begin
+                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
+                         exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
+                     end;
+                   hregister:=R_D6;
+                end
+              else if porddef(p2)^.typ=s8bit then
+                begin
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     begin
+                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
+                         { byte to long }
+                         if aktoptprocessor = MC68020 then
+                             exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
+                         else
+                           begin
+                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
+                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
+                           end;
+                     end
+                   else
+                     begin
+                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
+                         { byte to long }
+                         if aktoptprocessor = MC68020 then
+                             exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
+                         else
+                           begin
+                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
+                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
+                           end;
+                     end; { end outermost else }
+                   hregister:=R_D6;
+                end
+               { rangechecking for u32bit ?? !!!!!!}
+               { lets try }
+               else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit)  then
+                begin
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     hregister:=p^.location.register
+                   else
+                     begin
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),R_D6)));
+                        hregister:=R_D6;
+                     end;
+                end
+              { rangechecking for u32bit ?? !!!!!!}
+              else if porddef(p2)^.typ=u16bit then
+                begin
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
+                   else
+                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
+                   { unisgned extend }
+                   exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FFFF,R_D6)));
+                   hregister:=R_D6;
+                end
+              else if porddef(p2)^.typ=s16bit then
+                begin
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
+                   else
+                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
+                   { sign extend }
+                   exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
+                   hregister:=R_D6;
+                end
+              else internalerror(6);
+              new(hp);
+              reset_reference(hp^);
+              hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
+              if porddef(p1)^.low>porddef(p1)^.high then
+                begin
+                   getlabel(neglabel);
+                   getlabel(poslabel);
+                   exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hregister)));
+                   emitl(A_BLT,neglabel);
+                end;
+              emit_bounds_check(hp^,hregister);
+              if porddef(p1)^.low>porddef(p1)^.high then
+                begin
+                   new(hp);
+                   reset_reference(hp^);
+                   hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr+1));
+                   emitl(A_JMP,poslabel);
+                   emitl(A_LABEL,neglabel);
+                   emit_bounds_check(hp^,hregister);
+                   emitl(A_LABEL,poslabel);
+                end;
+           end;
+      end;
+
+
+     type
+        tsecondconvproc = procedure(p,hp : ptree;convtyp : tconverttype);
+
+    procedure second_only_rangecheck(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         maybe_rangechecking(p,hp^.resulttype,p^.resulttype);
+      end;
+
+
+    procedure second_smaller(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         hregister,destregister : tregister;
+         {opsize : topsize;}
+         ref : boolean;
+         hpp : preference;
+
+      begin
+         { !!!!!!!! Rangechecking }
+         ref:=false;
+         { problems with enums !! }
+           { with $R+ explicit type conversations in TP aren't range checked! }
+         if (p^.resulttype^.deftype=orddef) and
+           (hp^.resulttype^.deftype=orddef) and
+           ((porddef(p^.resulttype)^.low>porddef(hp^.resulttype)^.low) or
+           (porddef(p^.resulttype)^.high<porddef(hp^.resulttype)^.high)) then
+           begin
+              if (cs_check_range in aktlocalswitches) and
+                 (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) then
+              porddef(p^.resulttype)^.genrangecheck;
+              if porddef(hp^.resulttype)^.typ=s32bit then
+                begin
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     hregister:=p^.location.register
+                   else
+                     begin
+                        hregister:=getregister32;
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),hregister)));
+                     end;
+                end
+              { rangechecking for u32bit ?? !!!!!!}
+              else if porddef(hp^.resulttype)^.typ=u16bit then
+                begin
+                   hregister:=getregister32;
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                   begin
+                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)));
+                   end
+                   else
+                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
+                   { clear unused bits  i.e unsigned extend}
+                   exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L, $FFFF, hregister)));
+                end
+              else if porddef(hp^.resulttype)^.typ=s16bit then
+                begin
+                   hregister:=getregister32;
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)))
+                   else
+                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
+                   { sign extend }
+                   exprasmlist^.concat(new(pai68k,op_reg(A_EXT, S_L, hregister)));
+                end
+              else internalerror(6);
+
+              if (cs_check_range in aktlocalswitches) and
+                 (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) then
+              Begin
+              new(hpp);
+              reset_reference(hpp^);
+              hpp^.symbol:=stringdup('R_'+tostr(porddef(p^.resulttype)^.rangenr));
+
+
+              emit_bounds_check(hpp^, hregister);
+              end;
+               p^.location.loc:=LOC_REGISTER;
+              p^.location.register:=hregister;
+              exit;
+           end
+         { -------------- endian problems once again --------------------}
+         { If RIGHT   enumdef (32-bit) and we do a typecase to a smaller }
+         { type we must absolutely load it into a register first.        }
+         { --------------------------------------------------------------}
+         { ------------ supposing enumdef is always 32-bit --------------}
+         { --------------------------------------------------------------}
+         else
+         if (hp^.resulttype^.deftype = enumdef) and (p^.resulttype^.deftype = orddef) then
+           begin
+              if (hp^.location.loc=LOC_REGISTER) or (hp^.location.loc=LOC_CREGISTER) then
+                 hregister:=hp^.location.register
+              else
+                 begin
+                     hregister:=getregister32;
+                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(hp^.location.reference),hregister)));
+                 end;
+              p^.location.loc:=LOC_REGISTER;
+              p^.location.register:=hregister;
+              exit;
+           end;
+         if (p^.left^.location.loc=LOC_REGISTER) or
+           (p^.left^.location.loc=LOC_CREGISTER) then
+           begin
+              { handled by secondpas by called routine ??? }
+              p^.location.register:=p^.left^.location.register;
+           end;
+      end;
+
+
+    procedure second_bigger(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         hregister : tregister;
+         opsize : topsize;
+         op : tasmop;
+         is_register : boolean;
+
+      begin
+         is_register:=p^.left^.location.loc=LOC_REGISTER;
+           if not(is_register) and (p^.left^.location.loc<>LOC_CREGISTER) then
+             begin
+                del_reference(p^.left^.location.reference);
+                { we can do this here as we need no temp inside second_bigger }
+                ungetiftemp(p^.left^.location.reference);
+             end;
+         { this is wrong !!!
+         gives me movl (%eax),%eax
+         for the length(string !!!
+         use only for constant values }
+         {Constanst cannot be loaded into registers using MOVZX!}
+         if (p^.left^.location.loc<>LOC_MEM) or (not p^.left^.location.reference.isintvalue) then
+             case convtyp of
+                     tc_u8bit_2_s32bit,
+                tc_u8bit_2_u32bit,
+                tc_s8bit_2_u32bit,
+                tc_s8bit_2_s16bit,
+                tc_s8bit_2_s32bit,
+                tc_u8bit_2_u16bit,
+                tc_s8bit_2_u16bit,
+                tc_u8bit_2_s16bit: begin
+                                    if is_register then
+                                      hregister := p^.left^.location.register
+                                    else
+                                      hregister := getregister32;
+                                    if is_register then
+                                      emit_reg_reg(A_MOVE,S_B,p^.left^.location.register, hregister)
+                                    else
+                                    begin
+                                      if p^.left^.location.loc = LOC_CREGISTER then
+                                        emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,hregister)
+                                      else
+                                        exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
+                                         newreference(P^.left^.location.reference), hregister)));
+                                    end;
+
+                                    case convtyp of
+                                      tc_u8bit_2_s32bit,
+                                      tc_u8bit_2_u32bit:
+                                                   exprasmlist^.concat(new(pai68k, op_const_reg(
+                                                   A_AND,S_L,$FF,hregister)));
+                                      tc_s8bit_2_u32bit,
+                                      tc_s8bit_2_s32bit:
+                                                  begin
+                                                    if aktoptprocessor = MC68020 then
+                                                      exprasmlist^.concat(new(pai68k,op_reg
+                                                        (A_EXTB,S_L,hregister)))
+                                                    else { else if aktoptprocessor }
+                                                    begin
+                                                    { byte to word }
+                                                      exprasmlist^.concat(new(pai68k,op_reg
+                                                        (A_EXT,S_W,hregister)));
+                                                    { word to long }
+                                                      exprasmlist^.concat(new(pai68k,op_reg
+                                                        (A_EXT,S_L,hregister)));
+                                                    end;
+                                                  end;
+                                      tc_s8bit_2_u16bit,
+                                      tc_u8bit_2_s16bit,
+                                      tc_u8bit_2_u16bit:
+                                                  exprasmlist^.concat(new(pai68k, op_const_reg(
+                                                                A_AND,S_W,$FF,hregister)));
+
+                                      tc_s8bit_2_s16bit:
+                                                  exprasmlist^.concat(new(pai68k, op_reg(
+                                                                A_EXT, S_W, hregister)));
+
+                                    end; { inner case }
+                                   end;
+                tc_u16bit_2_u32bit,
+                tc_u16bit_2_s32bit,
+                tc_s16bit_2_u32bit,
+                tc_s16bit_2_s32bit: begin
+                                     if is_register then
+                                       hregister := p^.left^.location.register
+                                     else
+                                       hregister := getregister32;
+                                     if is_register then
+                                       emit_reg_reg(A_MOVE,S_W,p^.left^.location.register, hregister)
+                                     else
+                                     begin
+                                       if p^.left^.location.loc = LOC_CREGISTER then
+                                         emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,hregister)
+                                       else
+                                         exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_W,
+                                           newreference(P^.left^.location.reference), hregister)));
+                                     end;
+                                     if (convtyp = tc_u16bit_2_s32bit) or
+                                        (convtyp = tc_u16bit_2_u32bit) then
+                                         exprasmlist^.concat(new(pai68k, op_const_reg(
+                                           A_AND, S_L, $ffff, hregister)))
+                                     else { tc_s16bit_2_s32bit }
+                                          { tc_s16bit_2_u32bit }
+                                         exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_L,
+                                           hregister)));
+                                    end;
+             end { end case }
+         else
+         begin
+             case convtyp of
+                tc_u8bit_2_s32bit,
+                tc_s8bit_2_s32bit,
+                tc_u16bit_2_s32bit,
+                tc_s16bit_2_s32bit,
+            tc_u8bit_2_u32bit,
+            tc_s8bit_2_u32bit,
+            tc_u16bit_2_u32bit,
+            tc_s16bit_2_u32bit:
+
+                    begin
+                        hregister:=getregister32;
+                        op:=A_MOVE;
+                        opsize:=S_L;
+                    end;
+                tc_s8bit_2_u16bit,
+                tc_s8bit_2_s16bit,
+                tc_u8bit_2_s16bit,
+                tc_u8bit_2_u16bit:
+                    begin
+                        hregister:=getregister32;
+                        op:=A_MOVE;
+                        opsize:=S_W;
+                    end;
+             end;
+            if is_register then
+              begin
+                emit_reg_reg(op,opsize,p^.left^.location.register,hregister);
+              end
+            else
+              begin
+                 if p^.left^.location.loc=LOC_CREGISTER then
+                     emit_reg_reg(op,opsize,p^.left^.location.register,hregister)
+                 else exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,
+                     newreference(p^.left^.location.reference),hregister)));
+              end;
+         end; { end elseif }
+
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=hregister;
+         maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
+      end;
+
+
+    procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
+
+{$ifdef UseAnsiString}
+      var
+         pushed : tpushed;
+{$endif UseAnsiString}
+
+      begin
+{$ifdef UseAnsiString}
+         { does anybody know a better solution than this big case statement ? }
+         { ok, a proc table would do the job                                  }
+         case pstringdef(p)^.string_typ of
+
+            st_shortstring:
+              case pstringdef(p^.left)^.string_typ of
+                 st_shortstring:
+                   begin
+                      stringdispose(p^.location.reference.symbol);
+                      gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+                      del_reference(p^.left^.location.reference);
+                      copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+                      ungetiftemp(p^.left^.location.reference);
+                   end;
+                 st_longstring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_ansistring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_widestring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+              end;
+
+            st_longstring:
+              case pstringdef(p^.left)^.string_typ of
+                 st_shortstring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_ansistring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_widestring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+              end;
+
+            st_ansistring:
+              case pstringdef(p^.left)^.string_typ of
+                 st_shortstring:
+                   begin
+                      pushusedregisters(pushed,$ff);
+                      push_int(p^.resulttype^.size-1);
+                      gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+                      emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                      case p^.right^.location.loc of
+                         LOC_REGISTER,LOC_CREGISTER:
+                           begin
+                              exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.right^.location.register)));
+                              ungetregister32(p^.left^.location.register);
+                           end;
+                         LOC_REFERENCE,LOC_MEM:
+                           begin
+                              emit_push_mem(p^.left^.location.reference);
+                              del_reference(p^.left^.location.reference);
+                           end;
+                      end;
+                      emitcall('FPC_ANSI_TO_SHORTSTRING',true);
+                      maybe_loadesi;
+                      popusedregisters(pushed);
+                   end;
+                 st_longstring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_widestring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+              end;
+
+            st_widestring:
+              case pstringdef(p^.left)^.string_typ of
+                 st_shortstring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_longstring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_ansistring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+                 st_widestring:
+                   begin
+                      {!!!!!!!}
+                      internalerror(8888);
+                   end;
+              end;
+         end;
+{$ifdef dummy}
+         if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
+           begin
+              { call shortstring to ansistring conversion }
+              { result is in register }
+              del_reference(p^.left^.location.reference);
+              {!!!!
+              copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+              }
+              ungetiftemp(p^.left^.location.reference);
+           end
+         else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
+           begin
+              { call ansistring to shortstring conversion }
+              { result is in mem }
+              stringdispose(p^.location.reference.symbol);
+              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+              if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+                del_reference(p^.left^.location.reference);
+              copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+              ungetiftemp(p^.left^.location.reference);
+           end
+         else
+{$endif dummy}
+{$else UseAnsiString}
+           begin
+              stringdispose(p^.location.reference.symbol);
+              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+              del_reference(p^.left^.location.reference);
+              copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+              ungetiftemp(p^.left^.location.reference);
+           end;
+{$endif UseAnsiString}
+      end;
+
+    procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=getregister32;
+         inc(p^.left^.location.reference.offset);
+         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
+           R_A0)));
+         emit_reg_reg(A_MOVE, S_L, R_A0, p^.location.register);
+      end;
+
+    procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         inc(p^.location.reference.offset);
+      end;
+
+    procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         del_reference(p^.left^.location.reference);
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=getregister32;
+         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
+           R_A0)));
+         emit_reg_reg(A_MOVE,S_L,R_A0, P^.location.register);
+      end;
+
+    procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
+      var
+       reg: tregister;
+      begin
+         p^.location.loc:=LOC_REFERENCE;
+         clear_reference(p^.location.reference);
+         { here, after doing some arithmetic on the pointer }
+         { we put it back in an address register            }
+         if p^.left^.location.loc=LOC_REGISTER then
+         begin
+           reg := getaddressreg;
+           { move the pointer in a data register back into }
+           { an address register.                          }
+           emit_reg_reg(A_MOVE, S_L, p^.left^.location.register,reg);
+
+           p^.location.reference.base:=reg;
+           ungetregister32(p^.left^.location.register);
+         end
+         else
+           begin
+              if p^.left^.location.loc=LOC_CREGISTER then
+                begin
+                   p^.location.reference.base:=getaddressreg;
+                   emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
+                     p^.location.reference.base);
+                end
+              else
+                begin
+                   del_reference(p^.left^.location.reference);
+                   p^.location.reference.base:=getaddressreg;
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
+                     p^.location.reference.base)));
+                end;
+           end;
+      end;
+
+    { generates the code for the type conversion from an array of char }
+    { to a string                                                        }
+    procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         l : longint;
+
+      begin
+         { this is a type conversion which copies the data, so we can't }
+         { return a reference                                             }
+         p^.location.loc:=LOC_MEM;
+
+         { first get the memory for the string }
+         stringdispose(p^.location.reference.symbol);
+         gettempofsizereference(256,p^.location.reference);
+
+         { calc the length of the array }
+         l:=parraydef(p^.left^.resulttype)^.highrange-
+           parraydef(p^.left^.resulttype)^.lowrange+1;
+
+         if l>255 then
+           Message(sym_e_type_mismatch);
+
+         { write the length }
+           exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,l,
+             newreference(p^.location.reference))));
+
+         { copy to first char of string }
+         inc(p^.location.reference.offset);
+
+         { generates the copy code      }
+         { and we need the source never }
+         concatcopy(p^.left^.location.reference,p^.location.reference,l,true);
+
+         { correct the string location }
+         dec(p^.location.reference.offset);
+      end;
+
+    procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         stringdispose(p^.location.reference.symbol);
+         gettempofsizereference(256,p^.location.reference);
+      { call loadstring with correct left and right }
+         p^.right:=p^.left;
+         p^.left:=p;
+         loadstring(p);
+         p^.left:=nil; { reset left tree, which is empty }
+      end;
+
+    procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         r : preference;
+
+      begin
+        emitloadord2reg(p^.left^.location, porddef(p^.left^.resulttype), R_D6, true);
+        ungetiftemp(p^.left^.location.reference);
+        if porddef(p^.left^.resulttype)^.typ=u32bit then
+           push_int(0);
+
+        emit_reg_reg(A_MOVE, S_L, R_D6, R_SPPUSH);
+        new(r);
+        reset_reference(r^);
+        r^.base := R_SP;
+        { no emulation }
+{           for u32bit a solution would be to push $0 and to load a
++          comp
++           if porddef(p^.left^.resulttype)^.typ=u32bit then
++             exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)))
++           else}
+          p^.location.loc := LOC_FPU;
+          { get floating point register. }
+          if (cs_fp_emulation in aktmoduleswitches) then
+          begin
+            p^.location.fpureg := getregister32;
+            exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L, r, R_D0)));
+            emitcall('LONG2SINGLE',true);
+            emit_reg_reg(A_MOVE,S_L,R_D0,p^.location.fpureg);
+          end
+          else
+          begin
+            p^.location.fpureg := getfloatreg;
+            exprasmlist^.concat(new(pai68k, op_ref_reg(A_FMOVE, S_L, r, p^.location.fpureg)))
+          end;
+        if porddef(p^.left^.resulttype)^.typ=u32bit then
+           exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,8,R_SP)))
+        else
+        { restore the stack to the previous address }
+           exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L, 4, R_SP)));
+      end;
+
+    procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
+      var
+         rreg : tregister;
+         ref : treference;
+      begin
+         rreg:=getregister32;
+         { Are we in a LOC_FPU, if not then use scratch registers }
+         { instead of allocating reserved registers.              }
+         if (p^.left^.location.loc<>LOC_FPU) then
+         begin
+           if (cs_fp_emulation in aktmoduleswitches) then
+           begin
+             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),R_D0)));
+             exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
+             emitcall('LONGMUL',true);
+             emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
+           end
+           else
+           begin
+             exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(p^.left^.location.reference),R_FP0)));
+             exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,R_FP0)));
+             exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,R_FP0,rreg)));
+           end;
+         end
+         else
+         begin
+           if (cs_fp_emulation in aktmoduleswitches) then
+           begin
+             exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));
+             exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
+             emitcall('LONGMUL',true);
+             emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
+           end
+           else
+           begin
+             exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,p^.left^.location.fpureg)));
+             exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,p^.left^.location.fpureg,rreg)));
+           end;
+         end;
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=rreg;
+      end;
+
+
+    procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         case p^.left^.location.loc of
+            LOC_FPU :  begin
+                         { reload }
+                         p^.location.loc := LOC_FPU;
+                         p^.location.fpureg := p^.left^.location.fpureg;
+                       end;
+            LOC_MEM,
+            LOC_REFERENCE : floatload(pfloatdef(p^.left^.resulttype)^.typ,
+                              p^.left^.location.reference,p^.location);
+         end;
+{ ALREADY HANDLED BY FLOATLOAD      }
+{         p^.location.loc:=LOC_FPU; }
+      end;
+
+    procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
+    var
+        startreg : tregister;
+        hl : plabel;
+        r : treference;
+        reg1: tregister;
+        hl1,hl2,hl3,hl4,hl5,hl6,hl7,hl8,hl9: plabel;
+      begin
+         if (p^.left^.location.loc=LOC_REGISTER) or
+            (p^.left^.location.loc=LOC_CREGISTER) then
+           begin
+              startreg:=p^.left^.location.register;
+              ungetregister(startreg);
+              { move d0,d0 is removed by emit_reg_reg }
+              emit_reg_reg(A_MOVE,S_L,startreg,R_D0);
+           end
+         else
+           begin
+              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
+                p^.left^.location.reference),R_D0)));
+              del_reference(p^.left^.location.reference);
+              startreg:=R_NO;
+           end;
+
+         reg1 := getregister32;
+
+         { Motorola 68000 equivalent of CDQ     }
+         { we choose d1:d0 pair for quad word   }
+         exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D0)));
+         getlabel(hl1);
+         emitl(A_BPL,hl1);
+         { we copy all bits (-ve number) }
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,$ffffffff,R_D1)));
+         getlabel(hl2);
+         emitl(A_BRA,hl2);
+         emitl(A_LABEL,hl1);
+         exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_D0)));
+         emitl(A_LABEL,hl2);
+         { end CDQ }
+
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_EOR,S_L,R_D1,R_D0)));
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,reg1)));
+         getlabel(hl3);
+         emitl(A_BEQ,hl3);
+
+         { Motorola 68000 equivalent of RCL    }
+         getlabel(hl4);
+         emitl(A_BCC,hl4);
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_L,1,reg1)));
+         getlabel(hl5);
+         emitl(A_BRA,hl5);
+         emitl(A_LABEL,hl4);
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
+         emitl(A_LABEL,hl5);
+         { end RCL }
+
+         { Motorola 68000 equivalent of BSR }
+         { save register }
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_D6)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,31,R_D0)));
+         getlabel(hl6);
+         emitl(A_LABEL,hl6);
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,R_D0,R_D1)));
+         getlabel(hl7);
+         emitl(A_BNE,hl7);
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D0)));
+         emitl(A_BPL,hl6);
+         { restore register }
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D6,R_D0)));
+         emitl(A_LABEL,hl7);
+         { end BSR }
+
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,32,R_D6)));
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_B,R_D1,R_D6)));
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D6,R_D0)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_W,1007,R_D1)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,5,R_D1)));
+
+         { Motorola 68000 equivalent of SHLD }
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,11,R_D6)));
+         { save register }
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D1,R_A0)));
+         getlabel(hl8);
+         emitl(A_LABEL,hl8);
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D1)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
+         emitl(A_BNE,hl8);
+         { restore register }
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D1)));
+         { end Motorola equivalent of SHLD }
+
+         { Motorola 68000 equivalent of SHLD }
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,20,R_D6)));
+         { save register }
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_A0)));
+         getlabel(hl9);
+         emitl(A_LABEL,hl9);
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D0)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
+         emitl(A_BNE,hl9);
+         { restore register }
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D0)));
+         { end Motorola equivalent of SHLD }
+
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,20,R_D6)));
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_L,R_D6,R_D0)));
+         emitl(A_LABEL, hl3);
+
+         { create temp values and put on stack }
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg1,R_SPPUSH)));
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_SPPUSH)));
+
+
+         reset_reference(r);
+         r.base:=R_SP;
+
+         if (cs_fp_emulation in aktmoduleswitches) then
+         begin
+           p^.location.loc:=LOC_FPU;
+           p^.location.fpureg := getregister32;
+           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r),
+             p^.left^.location.fpureg)))
+         end
+         else
+         begin
+           p^.location.loc:=LOC_FPU;
+           p^.location.fpureg := getfloatreg;
+           exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(r),
+               p^.left^.location.fpureg)))
+         end;
+         { clear temporary space }
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,8,R_SP)));
+         ungetregister32(reg1);
+{ Alreadu handled above...          }
+{         p^.location.loc:=LOC_FPU; }
+      end;
+
+    procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         {hs : string;}
+         hregister : tregister;
+
+      begin
+         if (p^.left^.location.loc=LOC_REGISTER) then
+           hregister:=p^.left^.location.register
+         else if (p^.left^.location.loc=LOC_CREGISTER) then
+           hregister:=getregister32
+         else
+           begin
+              del_reference(p^.left^.location.reference);
+              hregister:=getregister32;
+              case porddef(p^.left^.resulttype)^.typ of
+                s8bit : begin
+                           exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
+                              newreference(p^.left^.location.reference),hregister)));
+                           if aktoptprocessor = MC68020 then
+                              exprasmlist^.concat(new(pai68k, op_reg(A_EXTB,S_L,hregister)))
+                           else
+                            begin
+                              exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_W,hregister)));
+                              exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_L,hregister)));
+                            end;
+                        end;
+                u8bit : begin
+                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.left^.location.reference),
+                            hregister)));
+                          exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
+                        end;
+                s16bit :begin
+                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
+                           hregister)));
+                          exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,hregister)));
+                        end;
+                u16bit : begin
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
+                               hregister)));
+                            exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
+                         end;
+                s32bit,u32bit : exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
+                  hregister)));
+                {!!!! u32bit }
+              end;
+           end;
+         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ,S_L,16,R_D1)));
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D1,hregister)));
+
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=hregister;
+      end;
+
+
+     procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
+
+     begin
+        secondpass(hp);
+        p^.location.loc:=LOC_REGISTER;
+        del_reference(hp^.location.reference);
+        p^.location.register:=getregister32;
+        exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+         newreference(hp^.location.reference),R_A0)));
+
+        emit_reg_reg(A_MOVE, S_L, R_A0, P^.location.register);
+     end;
+
+      procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         oldtruelabel,oldfalselabel,hlabel : plabel;
+         hregister : tregister;
+         newsize,
+         opsize : topsize;
+         op     : tasmop;
+     begin
+         oldtruelabel:=truelabel;
+         oldfalselabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         secondpass(hp);
+         p^.location.loc:=LOC_REGISTER;
+         del_reference(hp^.location.reference);
+         hregister:=getregister32;
+         case porddef(hp^.resulttype)^.typ of
+          bool8bit : begin
+                       case porddef(p^.resulttype)^.typ of
+                     u8bit,s8bit,
+                        bool8bit : opsize:=S_B;
+                   u16bit,s16bit,
+                       bool16bit : opsize:=S_BW;
+                   u32bit,s32bit,
+                       bool32bit : opsize:=S_BL;
+                       end;
+                     end;
+         bool16bit : begin
+                       case porddef(p^.resulttype)^.typ of
+                     u8bit,s8bit,
+                        bool8bit : opsize:=S_B;
+                   u16bit,s16bit,
+                       bool16bit : opsize:=S_W;
+                   u32bit,s32bit,
+                       bool32bit : opsize:=S_WL;
+                       end;
+                     end;
+         bool32bit : begin
+                       case porddef(p^.resulttype)^.typ of
+                     u8bit,s8bit,
+                        bool8bit : opsize:=S_B;
+                   u16bit,s16bit,
+                       bool16bit : opsize:=S_W;
+                   u32bit,s32bit,
+                       bool32bit : opsize:=S_L;
+                       end;
+                     end;
+         end;
+         op:=A_MOVE;
+{         if opsize in [S_B,S_W,S_L] then
+          op:=A_MOVE
+         else
+          if (porddef(p^.resulttype)^.typ in [s8bit,s16bit,s32bit]) then
+           op:=A_MOVSX
+          else
+           op:=A_MOVZX; }
+         case porddef(p^.resulttype)^.typ of
+          bool8bit,u8bit,s8bit : begin
+                                   p^.location.register:=hregister;
+                                   newsize:=S_B;
+                                 end;
+       bool16bit,u16bit,s16bit : begin
+                                   p^.location.register:=hregister;
+                                   newsize:=S_W;
+                                 end;
+       bool32bit,u32bit,s32bit : begin
+                                   p^.location.register:=hregister;
+                                   newsize:=S_L;
+                                 end;
+         else
+          internalerror(10060);
+         end;
+
+         case hp^.location.loc of
+            LOC_MEM,
+      LOC_REFERENCE : exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,
+                        newreference(hp^.location.reference),p^.location.register)));
+       LOC_REGISTER,
+      LOC_CREGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
+                        hp^.location.register,p^.location.register)));
+          LOC_FLAGS : begin
+{                       hregister:=reg32toreg8(hregister); }
+                        exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
+{ !!!!!!!!
+                        case porddef(p^.resulttype)^.typ of
+                  bool16bit,
+              u16bit,s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
+                  bool32bit,
+              u32bit,s32bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
+                        end; }
+                      end;
+           LOC_JUMP : begin
+                        getlabel(hlabel);
+                        emitl(A_LABEL,truelabel);
+                        exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,newsize,1,hregister)));
+                        emitl(A_JMP,hlabel);
+                        emitl(A_LABEL,falselabel);
+                        exprasmlist^.concat(new(pai68k,op_reg(A_CLR,newsize,hregister)));
+                        emitl(A_LABEL,hlabel);
+                      end;
+         else
+           internalerror(10061);
+         end;
+         truelabel:=oldtruelabel;
+         falselabel:=oldfalselabel;
+     end;
+
+
+     procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
+     var
+        hregister : tregister;
+     begin
+         p^.location.loc:=LOC_REGISTER;
+         del_reference(hp^.location.reference);
+         case hp^.location.loc of
+            LOC_MEM,LOC_REFERENCE :
+              begin
+                hregister:=getregister32;
+                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                  newreference(hp^.location.reference),hregister)));
+              end;
+            LOC_REGISTER,LOC_CREGISTER :
+              begin
+                hregister:=hp^.location.register;
+              end;
+          else
+            internalerror(10062);
+          end;
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_OR,S_L,hregister,hregister)));
+{        hregister:=reg32toreg8(hregister); }
+         exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
+         case porddef(p^.resulttype)^.typ of
+           bool8bit : p^.location.register:=hregister;
+{ !!!!!!!!!!!
+
+          bool16bit : begin
+                        p^.location.register:=reg8toreg16(hregister);
+                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
+                      end;
+          bool32bit : begin
+                        p^.location.register:=reg16toreg32(hregister);
+                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
+                      end; }
+         else
+          internalerror(10064);
+         end;
+     end;
+
+    procedure second_load_smallset(p,hp : ptree;convtyp : tconverttype);
+      var
+        href : treference;
+        pushedregs : tpushed;
+      begin
+        href.symbol:=nil;
+        pushusedregisters(pushedregs,$ff);
+        gettempofsizereference(32,href);
+        emitpushreferenceaddr(p^.left^.location.reference);
+        emitpushreferenceaddr(href);
+        emitcall('SET_LOAD_SMALL',true);
+        maybe_loada5;
+        popusedregisters(pushedregs);
+        p^.location.loc:=LOC_MEM;
+        stringdispose(p^.location.reference.symbol);
+        p^.location.reference:=href;
+      end;
+
+    procedure second_ansistring_to_pchar(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         l1,l2 : plabel;
+         hr : preference;
+
+      begin
+        InternalError(342132);
+{!!!!!!!!!!!    
+
+         p^.location.loc:=LOC_REGISTER;
+         getlabel(l1);
+         getlabel(l2);
+         case hp^.location.loc of
+            LOC_CREGISTER,LOC_REGISTER:
+              exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_L,0,
+                hp^.location.register)));
+            LOC_MEM,LOC_REFERENCE:
+              begin
+                 exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
+                   newreference(hp^.location.reference))));
+                  del_reference(hp^.location.reference);
+                  p^.location.register:=getregister32;
+               end;
+         end;
+         emitl(A_JZ,l1);
+         if hp^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
+             hp^.location.reference),
+             p^.location.register)));
+         emitl(A_JMP,l2);
+         emitl(A_LABEL,l1);
+         new(hr);
+         reset_reference(hr^);
+         hr^.symbol:=stringdup('FPC_EMPTYCHAR');
+         exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,hr,
+           p^.location.register)));
+         emitl(A_LABEL,l2); }
+      end;
+
+    procedure second_pchar_to_ansistring(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         p^.location.loc:=LOC_REGISTER;
+         internalerror(12121);
+      end;
+
+    procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
+      begin
+      end;
+
+{****************************************************************************
+                             SecondTypeConv
+****************************************************************************}
+
+    procedure secondtypeconv(var p : ptree);
+
+      const
+         secondconvert : array[tconverttype] of
+           tsecondconvproc = (second_nothing,second_nothing,
+           second_bigger,second_only_rangecheck,
+           second_bigger,second_bigger,second_bigger,
+           second_smaller,second_smaller,
+           second_smaller,second_string_string,
+           second_cstring_charpointer,second_string_chararray,
+           second_array_to_pointer,second_pointer_to_array,
+           second_char_to_string,second_bigger,
+           second_bigger,second_bigger,
+           second_smaller,second_smaller,
+           second_smaller,second_smaller,
+           second_bigger,second_smaller,
+           second_only_rangecheck,second_bigger,
+           second_bigger,second_bigger,
+           second_bigger,second_only_rangecheck,
+           second_smaller,second_smaller,
+           second_smaller,second_smaller,
+           second_bool_to_int,second_int_to_bool,
+           second_int_real,second_real_fix,
+           second_fix_real,second_int_fix,second_float_float,
+           second_chararray_to_string,
+           second_proc_to_procvar,
+           { is constant char to pchar, is done by firstpass }
+           second_nothing,
+           second_load_smallset,
+           second_ansistring_to_pchar,
+           second_pchar_to_ansistring);
+
+      begin
+         { this isn't good coding, I think tc_bool_2_int, shouldn't be }
+         { type conversion (FK)                                        }
+
+         { this is necessary, because second_bool_byte, have to change   }
+         { true- and false label before calling secondpass               }
+         if p^.convtyp<>tc_bool_2_int then
+           begin
+              secondpass(p^.left);
+              set_location(p^.location,p^.left^.location);
+              if codegenerror then
+               exit;
+           end;
+
+         if not(p^.convtyp in [tc_equal,tc_not_possible]) then
+           {the second argument only is for maybe_range_checking !}
+           secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
+      end;
+
+
+{*****************************************************************************
+                             SecondIs
+*****************************************************************************}
+
+    procedure secondis(var p : ptree);
+
+      var
+         pushed : tpushed;
+
+      begin
+         { save all used registers }
+         pushusedregisters(pushed,$ffff);
+         secondpass(p^.left);
+         p^.location.loc:=LOC_FLAGS;
+         p^.location.resflags:=F_NE;
+
+         { push instance to check: }
+         case p^.left^.location.loc of
+            LOC_REGISTER,LOC_CREGISTER:
+              begin
+                 exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
+                   S_L,p^.left^.location.register,R_SPPUSH)));
+                 ungetregister32(p^.left^.location.register);
+              end;
+            LOC_MEM,LOC_REFERENCE:
+              begin
+                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
+                   S_L,newreference(p^.left^.location.reference),R_SPPUSH)));
+                 del_reference(p^.left^.location.reference);
+              end;
+            else internalerror(100);
+         end;
+
+         { generate type checking }
+         secondpass(p^.right);
+         case p^.right^.location.loc of
+            LOC_REGISTER,LOC_CREGISTER:
+              begin
+                 exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
+                   S_L,p^.right^.location.register,R_SPPUSH)));
+                 ungetregister32(p^.right^.location.register);
+              end;
+            LOC_MEM,LOC_REFERENCE:
+              begin
+                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
+                   S_L,newreference(p^.right^.location.reference),R_SPPUSH)));
+                 del_reference(p^.right^.location.reference);
+              end;
+            else internalerror(100);
+         end;
+         emitcall('DO_IS',true);
+         exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
+         popusedregisters(pushed);
+      end;
+
+
+{*****************************************************************************
+                             SecondAs
+*****************************************************************************}
+
+    procedure secondas(var p : ptree);
+
+      var
+         pushed : tpushed;
+
+      begin
+         set_location(p^.location,p^.left^.location);
+         { save all used registers }
+         pushusedregisters(pushed,$ffff);
+         { push the vmt of the class }
+         exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
+           S_L,newcsymbol(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,0),R_SPPUSH)));
+         concat_external(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,EXT_NEAR);
+         emitpushreferenceaddr(p^.location.reference);
+          emitcall('DO_AS',true);
+         popusedregisters(pushed);
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}

compiler/cg68kcon.pas

@@ -0,0 +1,336 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for constants
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kcon;
+interface
+
+    uses
+      tree;
+
+{.$define SMALLSETORD}
+
+
+    procedure secondrealconst(var p : ptree);
+    procedure secondfixconst(var p : ptree);
+    procedure secondordconst(var p : ptree);
+    procedure secondstringconst(var p : ptree);
+    procedure secondsetcons(var p : ptree);
+    procedure secondniln(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      m68k,cga68k,tgen68k;
+
+{*****************************************************************************
+                             SecondRealConst
+*****************************************************************************}
+
+    procedure secondrealconst(var p : ptree);
+      var
+         hp1 : pai;
+         lastlabel : plabel;
+         found : boolean;
+      begin
+         clear_reference(p^.location.reference);
+         lastlabel:=nil;
+         found:=false;
+         { const already used ? }
+         if p^.labnumber=-1 then
+           begin
+              { tries to found an old entry }
+              hp1:=pai(consts^.first);
+              while assigned(hp1) do
+                begin
+                   if hp1^.typ=ait_label then
+                     lastlabel:=pai_label(hp1)^.l
+                   else
+                     begin
+                        if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
+                          begin
+                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
+                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) or
+                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
+                               begin
+                                  { found! }
+                                  p^.labnumber:=lastlabel^.nb;
+                                  break;
+                               end;
+                          end;
+                        lastlabel:=nil;
+                     end;
+                   hp1:=pai(hp1^.next);
+                end;
+              { :-(, we must generate a new entry }
+              if p^.labnumber=-1 then
+                begin
+                   getlabel(lastlabel);
+                   p^.labnumber:=lastlabel^.nb;
+                   concat_constlabel(lastlabel,constreal);
+                   case p^.realtyp of
+                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.valued)));
+                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.valued)));
+                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.valued)));
+                   else
+                     internalerror(10120);
+                   end;
+                end;
+           end;
+         stringdispose(p^.location.reference.symbol);
+         if assigned(lastlabel) then
+           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,constreal))
+         else
+           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labnumber,constreal));
+      end;
+
+
+{*****************************************************************************
+                             SecondFixConst
+*****************************************************************************}
+
+    procedure secondfixconst(var p : ptree);
+      begin
+         { an fix comma const. behaves as a memory reference }
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.isintvalue:=true;
+         p^.location.reference.offset:=p^.valuef;
+      end;
+
+
+{*****************************************************************************
+                             SecondOrdConst
+*****************************************************************************}
+
+    procedure secondordconst(var p : ptree);
+      begin
+         { an integer const. behaves as a memory reference }
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.isintvalue:=true;
+         p^.location.reference.offset:=p^.value;
+      end;
+
+
+{*****************************************************************************
+                             SecondStringConst
+*****************************************************************************}
+
+    procedure secondstringconst(var p : ptree);
+      var
+         hp1 : pai;
+{$ifdef UseAnsiString}
+         l1,
+{$endif}
+
+
+         lastlabel : plabel;
+         pc : pchar;
+         same_string : boolean;
+         i : word;
+
+      begin
+         clear_reference(p^.location.reference);
+         lastlabel:=nil;
+         { const already used ? }
+         if p^.labstrnumber=-1 then
+           begin
+              { tries to found an old entry }
+              hp1:=pai(consts^.first);
+              while assigned(hp1) do
+                begin
+                   if hp1^.typ=ait_label then
+                     lastlabel:=pai_label(hp1)^.l
+                   else
+                     begin
+                        { when changing that code, be careful that }
+                        { you don't use typed consts, which are    }
+                        { are also written to consts               }
+                        { currently, this is no problem, because   }
+                        { typed consts have no leading length or   }
+                        { they have no trailing zero               }
+{$ifdef UseAnsiString}
+                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
+                          (pai_string(hp1)^.len=p^.length+2) then
+{$else UseAnsiString}
+                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
+                          (pai_string(hp1)^.len=length(p^.values^)+2) then
+{$endif UseAnsiString}
+
+                          begin
+                             same_string:=true;
+{$ifndef UseAnsiString}
+                             { weird error here !!!   }
+                             { pchar ' ' was found equal to string '' !!!! }
+                             { gave strange output in exceptions !! PM }
+                             for i:=0 to length(p^.values^) do
+                               if pai_string(hp1)^.str[i]<>p^.values^[i] then
+{$else}
+                             for i:=0 to p^.length do
+                               if pai_string(hp1)^.str[i]<>p^.values[i] then
+{$endif}
+                                 begin
+                                    same_string:=false;
+                                    break;
+                                 end;
+                             if same_string then
+                               begin
+                                  { found! }
+                                  p^.labstrnumber:=lastlabel^.nb;
+                                  break;
+                               end;
+                          end;
+                        lastlabel:=nil;
+                     end;
+                   hp1:=pai(hp1^.next);
+                end;
+              { :-(, we must generate a new entry }
+              if p^.labstrnumber=-1 then
+                begin
+                   getlabel(lastlabel);
+                   p^.labstrnumber:=lastlabel^.nb;
+{$ifndef UseAnsiString}
+                   getmem(pc,length(p^.values^)+3);
+                   move(p^.values^,pc^,length(p^.values^)+1);
+                   pc[length(p^.values^)+1]:=#0;
+                   concat_constlabel(lastlabel,conststring);
+                   { we still will have a problem if there is a #0 inside the pchar }
+                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
+{$else UseAnsiString}
+
+                   { generate an ansi string ? }
+                   case p^.stringtype of
+                      st_ansistring:
+                        begin
+                           { an empty ansi string is nil! }
+                           concat_constlabel(lastlabel,conststring);
+                           if p^.length=0 then
+                             consts^.concat(new(pai_const,init_32bit(0)))
+                           else
+                             begin
+                                getlabel(l1);
+                                consts^.concat(new(pai_const,init_symbol(strpnew(lab2str(l1)))));
+
+                                consts^.concat(new(pai_const,init_32bit(p^.length)));
+                                consts^.concat(new(pai_const,init_32bit(p^.length)));
+                                consts^.concat(new(pai_const,init_32bit(-1)));
+                                consts^.concat(new(pai_label,init(l1)));
+                                getmem(pc,p^.length+1);
+                                move(p^.values^,pc^,p^.length+1);
+                                { to overcome this problem we set the length explicitly }
+                                { with the ending null char }
+                                consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
+                             end;
+                        end;
+                      st_shortstring:
+                        begin
+                           getmem(pc,p^.length+3);
+                           move(p^.values^,pc[1],p^.length+1);
+                           pc[0]:=chr(p^.length);
+                           concat_constlabel(lastlabel,conststring);
+                           { to overcome this problem we set the length explicitly }
+                           { with the ending null char }
+                           consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+2)));
+                        end;
+                   end;
+{$endif UseAnsiString}
+                end;
+           end;
+         stringdispose(p^.location.reference.symbol);
+         if assigned(lastlabel) then
+           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,conststring))
+         else
+           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labstrnumber,conststring));
+         p^.location.loc := LOC_MEM;
+      end;
+
+
+{*****************************************************************************
+                             SecondSetCons
+*****************************************************************************}
+
+    procedure secondsetcons(var p : ptree);
+      var
+         l    : plabel;
+         i    : longint;
+         href : treference;
+      begin
+{$ifdef SMALLSETORD}
+        if psetdef(p^.resulttype)^.settype=smallset then
+         begin
+           p^.location.loc:=LOC_MEM;
+           p^.location.reference.isintvalue:=true;
+           p^.location.reference.offset:=p^.constset^[0];
+         end
+        else
+         begin
+           reset_reference(href);
+           getlabel(l);
+           stringdispose(p^.location.reference.symbol);
+           href.symbol:=stringdup(constlabel2str(l,constseta));
+           concat_constlabel(l,constseta);
+           for i:=0 to 31 do
+             consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
+           p^.location.reference:=href;
+         end;
+{$else}
+        reset_reference(href);
+        getlabel(l);
+        stringdispose(p^.location.reference.symbol);
+        href.symbol:=stringdup(constlabel2str(l,constseta));
+        concat_constlabel(l,constseta);
+        if psetdef(p^.resulttype)^.settype=smallset then
+         begin
+           move(p^.constset^,i,sizeof(longint));
+           consts^.concat(new(pai_const,init_32bit(i)));
+         end
+        else
+         begin
+           for i:=0 to 31 do
+             consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
+         end;
+        p^.location.reference:=href;
+{$endif SMALLSETORD}
+      end;
+
+
+{*****************************************************************************
+                             SecondNilN
+*****************************************************************************}
+
+    procedure secondniln(var p : ptree);
+      begin
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.isintvalue:=true;
+         p^.location.reference.offset:=0;
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}

compiler/cg68kflw.pas

@@ -0,0 +1,789 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for nodes that influence the flow
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kflw;
+interface
+
+    uses
+      tree;
+
+    procedure second_while_repeatn(var p : ptree);
+    procedure secondifn(var p : ptree);
+    procedure secondfor(var p : ptree);
+    procedure secondexitn(var p : ptree);
+    procedure secondbreakn(var p : ptree);
+    procedure secondcontinuen(var p : ptree);
+    procedure secondgoto(var p : ptree);
+    procedure secondlabel(var p : ptree);
+    procedure secondraise(var p : ptree);
+    procedure secondtryexcept(var p : ptree);
+    procedure secondtryfinally(var p : ptree);
+    procedure secondon(var p : ptree);
+    procedure secondfail(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      m68k,cga68k,tgen68k;
+
+{*****************************************************************************
+                         Second_While_RepeatN
+*****************************************************************************}
+
+    procedure second_while_repeatn(var p : ptree);
+
+      var
+         l1,l2,l3,oldclabel,oldblabel : plabel;
+         otlabel,oflabel : plabel;
+      begin
+         getlabel(l1);
+         getlabel(l2);
+         { arrange continue and breaklabels: }
+         oldclabel:=aktcontinuelabel;
+         oldblabel:=aktbreaklabel;
+         if p^.treetype=repeatn then
+           begin
+              emitl(A_LABEL,l1);
+              aktcontinuelabel:=l1;
+              aktbreaklabel:=l2;
+              cleartempgen;
+              if assigned(p^.right) then
+               secondpass(p^.right);
+
+              otlabel:=truelabel;
+              oflabel:=falselabel;
+              truelabel:=l2;
+              falselabel:=l1;
+              cleartempgen;
+              secondpass(p^.left);
+              maketojumpbool(p^.left);
+              emitl(A_LABEL,l2);
+              truelabel:=otlabel;
+              falselabel:=oflabel;
+           end
+         else { //// NOT a small set  //// }
+           begin
+              { handling code at the end as it is much more efficient }
+              emitl(A_JMP,l2);
+
+              emitl(A_LABEL,l1);
+              cleartempgen;
+
+              getlabel(l3);
+              aktcontinuelabel:=l2;
+              aktbreaklabel:=l3;
+
+              if assigned(p^.right) then
+               secondpass(p^.right);
+
+              emitl(A_LABEL,l2);
+              otlabel:=truelabel;
+              oflabel:=falselabel;
+              truelabel:=l1;
+              falselabel:=l3;
+              cleartempgen;
+              secondpass(p^.left);
+              maketojumpbool(p^.left);
+
+              emitl(A_LABEL,l3);
+              truelabel:=otlabel;
+              falselabel:=oflabel;
+           end;
+         aktcontinuelabel:=oldclabel;
+         aktbreaklabel:=oldblabel;
+      end;
+
+
+{*****************************************************************************
+                               SecondIfN
+*****************************************************************************}
+
+    procedure secondifn(var p : ptree);
+
+      var
+         hl,otlabel,oflabel : plabel;
+
+      begin
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         cleartempgen;
+         secondpass(p^.left);
+         maketojumpbool(p^.left);
+         if assigned(p^.right) then
+           begin
+              emitl(A_LABEL,truelabel);
+              cleartempgen;
+              secondpass(p^.right);
+           end;
+         if assigned(p^.t1) then
+           begin
+              if assigned(p^.right) then
+                begin
+                   getlabel(hl);
+                   emitl(A_JMP,hl);
+                end;
+              emitl(A_LABEL,falselabel);
+              cleartempgen;
+              secondpass(p^.t1);
+              if assigned(p^.right) then
+                emitl(A_LABEL,hl);
+           end
+         else
+           emitl(A_LABEL,falselabel);
+         if not(assigned(p^.right)) then
+           emitl(A_LABEL,truelabel);
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+      end;
+
+{*****************************************************************************
+                              SecondFor
+*****************************************************************************}
+
+    procedure secondfor(var p : ptree);
+
+      var
+         l1,l3,oldclabel,oldblabel : plabel;
+         omitfirstcomp,temptovalue : boolean;
+         hs : byte;
+         temp1 : treference;
+         hop : tasmop;
+         cmpreg,cmp32 : tregister;
+         opsize : topsize;
+         count_var_is_signed : boolean;
+
+      begin
+         oldclabel:=aktcontinuelabel;
+         oldblabel:=aktbreaklabel;
+         getlabel(aktcontinuelabel);
+         getlabel(aktbreaklabel);
+         getlabel(l3);
+
+         { could we spare the first comparison ? }
+         omitfirstcomp:=false;
+         if p^.right^.treetype=ordconstn then
+           if p^.left^.right^.treetype=ordconstn then
+             omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
+               or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
+
+         { only calculate reference }
+         cleartempgen;
+         secondpass(p^.t2);
+         if not(simple_loadn) then
+          Message(cg_e_illegal_count_var);
+
+         { produce start assignment }
+         cleartempgen;
+         secondpass(p^.left);
+         count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
+         hs:=p^.t2^.resulttype^.size;
+         cmp32:=getregister32;
+         cmpreg:=cmp32;
+         case hs of
+            1 : begin
+                   opsize:=S_B;
+                end;
+            2 : begin
+                   opsize:=S_W;
+                end;
+            4 : begin
+                   opsize:=S_L;
+                end;
+         end;
+         cleartempgen;
+         secondpass(p^.right);
+         { calculate pointer value and check if changeable and if so }
+         { load into temporary variable                              }
+         if p^.right^.treetype<>ordconstn then
+           begin
+              temp1.symbol:=nil;
+              gettempofsizereference(hs,temp1);
+              temptovalue:=true;
+              if (p^.right^.location.loc=LOC_REGISTER) or
+                 (p^.right^.location.loc=LOC_CREGISTER) then
+                begin
+                   exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,p^.right^.location.register,
+                      newreference(temp1))));
+                 end
+              else
+                 concatcopy(p^.right^.location.reference,temp1,hs,false);
+           end
+         else temptovalue:=false;
+
+         if temptovalue then
+           begin
+              if p^.t2^.location.loc=LOC_CREGISTER then
+               begin
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     p^.t2^.location.register)));
+                end
+              else
+                begin
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
+                     cmpreg)));
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     cmpreg)));
+                end;
+           end
+         else
+           begin
+              if not(omitfirstcomp) then
+                begin
+                   if p^.t2^.location.loc=LOC_CREGISTER then
+                     exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
+                       p^.t2^.location.register)))
+                   else
+                     exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
+               newreference(p^.t2^.location.reference))));
+                end;
+           end;
+         if p^.backward then
+          begin
+           if count_var_is_signed then
+              hop:=A_BLT
+           else
+              hop:=A_BCS;
+          end
+         else
+           if count_var_is_signed then
+             hop:=A_BGT
+           else hop:=A_BHI;
+
+         if not(omitfirstcomp) or temptovalue then
+          emitl(hop,aktbreaklabel);
+
+         emitl(A_LABEL,l3);
+
+         { help register must not be in instruction block }
+         cleartempgen;
+         if assigned(p^.t1) then
+           secondpass(p^.t1);
+
+         emitl(A_LABEL,aktcontinuelabel);
+
+         { makes no problems there }
+         cleartempgen;
+
+         { demand help register again }
+         cmp32:=getregister32;
+         case hs of
+            1 : begin
+                   opsize:=S_B;
+                end;
+            2 : begin
+                   opsize:=S_W;
+                end;
+            4 : opsize:=S_L;
+         end;
+
+     { produce comparison and the corresponding }
+     { jump                                     }
+         if temptovalue then
+           begin
+              if p^.t2^.location.loc=LOC_CREGISTER then
+                begin
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     p^.t2^.location.register)));
+                end
+              else
+                begin
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
+                     cmpreg)));
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     cmpreg)));
+                end;
+           end
+         else
+           begin
+              if p^.t2^.location.loc=LOC_CREGISTER then
+                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
+                  p^.t2^.location.register)))
+              else
+                exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
+                  newreference(p^.t2^.location.reference))));
+           end;
+         if p^.backward then
+           if count_var_is_signed then
+             hop:=A_BLE
+           else
+             hop :=A_BLS
+          else
+            if count_var_is_signed then
+              hop:=A_BGE
+            else
+               hop:=A_BCC;
+         emitl(hop,aktbreaklabel);
+         { according to count direction DEC or INC... }
+         { must be after the test because of 0to 255 for bytes !! }
+         if p^.backward then
+           hop:=A_SUB
+         else hop:=A_ADD;
+
+         if p^.t2^.location.loc=LOC_CREGISTER then
+           exprasmlist^.concat(new(pai68k,op_const_reg(hop,opsize,1,p^.t2^.location.register)))
+         else
+            exprasmlist^.concat(new(pai68k,op_const_ref(hop,opsize,1,newreference(p^.t2^.location.reference))));
+         emitl(A_JMP,l3);
+
+     { this is the break label: }
+         emitl(A_LABEL,aktbreaklabel);
+         ungetregister32(cmp32);
+
+         if temptovalue then
+           ungetiftemp(temp1);
+
+         aktcontinuelabel:=oldclabel;
+         aktbreaklabel:=oldblabel;
+      end;
+
+
+{*****************************************************************************
+                              SecondExitN
+*****************************************************************************}
+
+    procedure secondexitn(var p : ptree);
+
+      var
+         is_mem : boolean;
+         {op : tasmop;
+         s : topsize;}
+         otlabel,oflabel : plabel;
+
+      label
+         do_jmp;
+
+      begin
+         if assigned(p^.left) then
+           begin
+              otlabel:=truelabel;
+              oflabel:=falselabel;
+              getlabel(truelabel);
+              getlabel(falselabel);
+              secondpass(p^.left);
+              case p^.left^.location.loc of
+                 LOC_FPU : goto do_jmp;
+                 LOC_MEM,LOC_REFERENCE : is_mem:=true;
+                 LOC_CREGISTER,
+                 LOC_REGISTER : is_mem:=false;
+                 LOC_FLAGS : begin
+                                exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,R_D0)));
+                                exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
+                                goto do_jmp;
+                             end;
+                 LOC_JUMP : begin
+                               emitl(A_LABEL,truelabel);
+                               exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,1,R_D0)));
+                               emitl(A_JMP,aktexit2label);
+                               exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,R_D0)));
+                               goto do_jmp;
+                            end;
+                 else internalerror(2001);
+              end;
+              if (procinfo.retdef^.deftype=orddef) then
+                begin
+                   case porddef(procinfo.retdef)^.typ of
+                      s32bit,u32bit,bool32bit : if is_mem then
+                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                          newreference(p^.left^.location.reference),R_D0)))
+                                      else
+                                        emit_reg_reg(A_MOVE,S_L,
+                                          p^.left^.location.register,R_D0);
+                      u8bit,s8bit,uchar,bool8bit : if is_mem then
+                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
+                                          newreference(p^.left^.location.reference),R_D0)))
+                                      else
+                                        emit_reg_reg(A_MOVE,S_B,
+                                          p^.left^.location.register,R_D0);
+                      s16bit,u16bit,bool16bit : if is_mem then
+                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
+                                          newreference(p^.left^.location.reference),R_D0)))
+                                      else
+                                        emit_reg_reg(A_MOVE,S_W,
+                                          p^.left^.location.register,R_D0);
+                   end;
+                end
+               else
+                 if (procinfo.retdef^.deftype in
+                     [pointerdef,enumdef,procvardef]) then
+                   begin
+                      if is_mem then
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                          newreference(p^.left^.location.reference),R_D0)))
+                      else
+                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+                          p^.left^.location.register,R_D0)));
+                   end
+              else
+                if (procinfo.retdef^.deftype=floatdef) then
+            { floating point return values .... }
+            { single are returned in d0         }
+                  begin
+                     if (pfloatdef(procinfo.retdef)^.typ=f32bit) or
+                   (pfloatdef(procinfo.retdef)^.typ=s32real) then
+                       begin
+                          if is_mem then
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                              newreference(p^.left^.location.reference),R_D0)))
+                          else
+                            begin
+                               if pfloatdef(procinfo.retdef)^.typ=f32bit then
+                                  emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0)
+                               else
+                                  begin
+                                     { single values are in the floating point registers }
+                                     if cs_fp_emulation in aktmoduleswitches then
+                                        emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)
+                                     else
+                                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_FS,
+                                           p^.left^.location.fpureg,R_D0)));
+                                  end;
+                            end;
+                       end
+                     else
+                       Begin
+                         { this is only possible in real non emulation mode }
+                         { LOC_MEM,LOC_REFERENCE }
+                         if is_mem then
+                           begin
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
+                                  getfloatsize(pfloatdef(procinfo.retdef)^.typ),
+                                    newreference(p^.left^.location.reference),R_FP0)));
+                           end
+                         else
+                          { LOC_FPU }
+                            begin
+                               { convert from extended to correct type }
+                               { when storing                          }
+                               exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
+                                 getfloatsize(pfloatdef(procinfo.retdef)^.typ),p^.left^.location.fpureg,R_FP0)));
+                            end;
+                       end;
+              end;
+do_jmp:
+              truelabel:=otlabel;
+              falselabel:=oflabel;
+              emitl(A_JMP,aktexit2label);
+           end
+         else
+           begin
+              emitl(A_JMP,aktexitlabel);
+           end;
+      end;
+
+
+{*****************************************************************************
+                              SecondBreakN
+*****************************************************************************}
+
+    procedure secondbreakn(var p : ptree);
+      begin
+         if aktbreaklabel<>nil then
+           emitl(A_JMP,aktbreaklabel)
+         else
+           Message(cg_e_break_not_allowed);
+      end;
+
+
+{*****************************************************************************
+                              SecondContinueN
+*****************************************************************************}
+
+    procedure secondcontinuen(var p : ptree);
+      begin
+         if aktcontinuelabel<>nil then
+           emitl(A_JMP,aktcontinuelabel)
+         else
+           Message(cg_e_continue_not_allowed);
+      end;
+
+
+{*****************************************************************************
+                             SecondGoto
+*****************************************************************************}
+
+    procedure secondgoto(var p : ptree);
+
+       begin
+         emitl(A_JMP,p^.labelnr);
+       end;
+
+
+{*****************************************************************************
+                             SecondLabel
+*****************************************************************************}
+
+    procedure secondlabel(var p : ptree);
+      begin
+         emitl(A_LABEL,p^.labelnr);
+         cleartempgen;
+         secondpass(p^.left);
+      end;
+
+
+{*****************************************************************************
+                             SecondRaise
+*****************************************************************************}
+
+    { generates the code for a raise statement }
+    procedure secondraise(var p : ptree);
+
+      var
+         a : plabel;
+
+      begin
+         if assigned(p^.left) then
+           begin
+              { generate the address }
+              if assigned(p^.right) then
+                begin
+                   secondpass(p^.right);
+                   if codegenerror then
+                     exit;
+                end
+              else
+                begin
+                   getlabel(a);
+                   emitl(A_LABEL,a);
+                   exprasmlist^.concat(new(pai68k,
+                     op_csymbol_reg(A_MOVE,S_L,newcsymbol(lab2str(a),0),R_SPPUSH)));
+                end;
+              secondpass(p^.left);
+              if codegenerror then
+                exit;
+
+              case p^.left^.location.loc of
+                 LOC_MEM,LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
+                 LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+                   p^.left^.location.register,R_SPPUSH)));
+                 else Message(sym_e_type_mismatch);
+              end;
+              emitcall('FPC_RAISEEXCEPTION',true);
+             end
+           else
+            emitcall('FPC_RERAISE',true);
+      end;
+
+
+{*****************************************************************************
+                             SecondTryExcept
+*****************************************************************************}
+
+    var
+       endexceptlabel : plabel;
+
+    procedure secondtryexcept(var p : ptree);
+
+      var
+         exceptlabel,doexceptlabel,oldendexceptlabel,
+         lastonlabel : plabel;
+
+      begin
+        InternalError(3431243);
+(*      
+         { this can be called recursivly }
+         oldendexceptlabel:=endexceptlabel;
+         { we modify EAX }
+         usedinproc:=usedinproc or ($80 shr byte(R_EAX));
+
+         getlabel(exceptlabel);
+         getlabel(doexceptlabel);
+         getlabel(endexceptlabel);
+         getlabel(lastonlabel);
+         push_int (1); { push type of exceptionframe }
+         emitcall('FPC_PUSHEXCEPTADDR',true);
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         emitcall('FPC_SETJMP',true);
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitl(A_JNE,exceptlabel);
+
+         { try code }
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+
+         emitl(A_LABEL,exceptlabel);
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_POP,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitl(A_JNE,doexceptlabel);
+         emitcall('FPC_POPADDRSTACK',true);
+         emitl(A_JMP,endexceptlabel);
+         emitl(A_LABEL,doexceptlabel);
+
+         if assigned(p^.right) then
+           secondpass(p^.right);
+
+         emitl(A_LABEL,lastonlabel);
+         { default handling }
+         if assigned(p^.t1) then
+           begin
+              { FPC_CATCHES must be called with
+                'default handler' flag (=-1)
+              }
+              push_int (-1);
+              emitcall('FPC_CATCHES',true);
+              secondpass(p^.t1);
+           end
+         else
+           emitcall('FPC_RERAISE',true);
+         emitl(A_LABEL,endexceptlabel);
+         endexceptlabel:=oldendexceptlabel; *)
+      end;
+
+
+{*****************************************************************************
+                             SecondOn
+*****************************************************************************}
+
+    procedure secondon(var p : ptree);
+      var
+         nextonlabel,myendexceptlabel : plabel;
+         ref : treference;
+
+      begin
+{ !!!!!!!!!!!!!!! }
+(*         getlabel(nextonlabel);
+         { push the vmt }
+         exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
+           newcsymbol(p^.excepttype^.vmt_mangledname,0))));
+         maybe_concat_external(p^.excepttype^.owner,
+           p^.excepttype^.vmt_mangledname);
+
+         emitcall('FPC_CATCHES',true);
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitl(A_JE,nextonlabel);
+         ref.symbol:=nil;
+         gettempofsizereference(4,ref);
+
+         { what a hack ! }
+         if assigned(p^.exceptsymtable) then
+           pvarsym(p^.exceptsymtable^.root)^.address:=ref.offset;
+
+         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+           R_EAX,newreference(ref))));
+
+         if assigned(p^.right) then
+           secondpass(p^.right);
+         { clear some stuff }
+         ungetiftemp(ref);
+         emitl(A_JMP,endexceptlabel);
+         emitl(A_LABEL,nextonlabel);
+         { next on node }
+         if assigned(p^.left) then
+           secondpass(p^.left); *)
+      end;
+
+{*****************************************************************************
+                             SecondTryFinally
+*****************************************************************************}
+
+    procedure secondtryfinally(var p : ptree);
+
+      var
+         finallylabel,noreraiselabel,endfinallylabel : plabel;
+
+      begin
+(*         { we modify EAX }
+         usedinproc:=usedinproc or ($80 shr byte(R_EAX));
+
+         getlabel(finallylabel);
+         getlabel(noreraiselabel);
+         getlabel(endfinallylabel);
+         push_int(1); { Type of stack-frame must be pushed}
+         emitcall('FPC_PUSHEXCEPTADDR',true);
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         emitcall('FPC_SETJMP',true);
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitl(A_JNE,finallylabel);
+
+         { try code }
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+
+         emitl(A_LABEL,finallylabel);
+
+         { finally code }
+         secondpass(p^.right);
+         if codegenerror then
+           exit;
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_POP,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitl(A_JE,noreraiselabel);
+         emitcall('FPC_RERAISE',true);
+         emitl(A_LABEL,noreraiselabel);
+         emitcall('FPC_POPADDRSTACK',true);
+         emitl(A_LABEL,endfinallylabel); *)
+      end;
+
+
+{*****************************************************************************
+                             SecondFail
+*****************************************************************************}
+
+    procedure secondfail(var p : ptree);
+      var
+        hp : preference;
+      begin
+         {if procinfo.exceptions then
+           aktproccode.concat(gennasmrec(CALL,S_NO,'HELP_DESTRUCTOR_E'))
+         else }
+         { we should know if the constructor is called with a new or not,
+         how can we do that ???
+         exprasmlist^.concat(new(pai68k,op_csymbol(A_CALL,S_NO,newcsymbol('HELP_DESTRUCTOR',0))));
+         }
+         exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_A5)));
+         { also reset to zero in the stack }
+         new(hp);
+         reset_reference(hp^);
+         hp^.offset:=procinfo.ESI_offset;
+         hp^.base:=procinfo.framepointer;
+         exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A5,hp)));
+         exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}
+

compiler/cg68kinl.pas

@@ -0,0 +1,919 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k inline nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kinl;
+interface
+
+    uses
+      tree;
+
+    procedure secondinline(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      aasm,types,symtable,
+      hcodegen,temp_gen,pass_2,
+      m68k,cga68k,tgen68k,cg68kld,cg68kcal;
+
+
+{*****************************************************************************
+                                Helpers
+*****************************************************************************}
+
+    { reverts the parameter list }
+    var nb_para : integer;
+
+    function reversparameter(p : ptree) : ptree;
+
+       var
+         hp1,hp2 : ptree;
+
+      begin
+         hp1:=nil;
+         nb_para := 0;
+         while assigned(p) do
+           begin
+              { pull out }
+              hp2:=p;
+              p:=p^.right;
+              inc(nb_para);
+              { pull in }
+              hp2^.right:=hp1;
+              hp1:=hp2;
+           end;
+         reversparameter:=hp1;
+       end;
+
+
+{*****************************************************************************
+                             SecondInLine
+*****************************************************************************}
+
+    procedure secondinline(var p : ptree);
+       const
+         { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
+         float_name: array[tfloattype] of string[8]=
+           ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
+         addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADDQ,A_SUBQ);
+       var
+         aktfile : treference;
+         ft : tfiletype;
+         opsize : topsize;
+         asmop : tasmop;
+         pushed : tpushed;
+         {inc/dec}
+         addconstant : boolean;
+         addvalue : longint;
+
+
+      procedure handlereadwrite(doread,doln : boolean);
+      { produces code for READ(LN) and WRITE(LN) }
+
+        procedure loadstream;
+          const
+            io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
+          var
+            r : preference;
+          begin
+            new(r);
+            reset_reference(r^);
+            r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
+            concat_external(r^.symbol^,EXT_NEAR);
+            exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,r,R_A0)))
+          end;
+
+        var
+           node,hp    : ptree;
+           typedtyp,
+           pararesult : pdef;
+           has_length : boolean;
+           dummycoll  : tdefcoll;
+           iolabel    : plabel;
+           npara      : longint;
+
+        begin
+           { I/O check }
+           if cs_check_io in aktlocalswitches then
+             begin
+                getlabel(iolabel);
+                emitl(A_LABEL,iolabel);
+             end
+           else
+             iolabel:=nil;
+           { for write of real with the length specified }
+           has_length:=false;
+           hp:=nil;
+           { reserve temporary pointer to data variable }
+           aktfile.symbol:=nil;
+           gettempofsizereference(4,aktfile);
+           { first state text data }
+           ft:=ft_text;
+           { and state a parameter ? }
+           if p^.left=nil then
+             begin
+                { the following instructions are for "writeln;" }
+                loadstream;
+                { save @aktfile in temporary variable }
+                exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
+             end
+           else
+             begin
+                { revers paramters }
+                node:=reversparameter(p^.left);
+
+                p^.left := node;
+                npara := nb_para;
+                { calculate data variable }
+                { is first parameter a file type ? }
+                if node^.left^.resulttype^.deftype=filedef then
+                  begin
+                     ft:=pfiledef(node^.left^.resulttype)^.filetype;
+                     if ft=ft_typed then
+                       typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
+                     secondpass(node^.left);
+                     if codegenerror then
+                       exit;
+
+                     { save reference in temporary variables }
+                     if node^.left^.location.loc<>LOC_REFERENCE then
+                       begin
+                          Message(cg_e_illegal_expression);
+                          exit;
+                       end;
+
+                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_A0)));
+
+                     { skip to the next parameter }
+                     node:=node^.right;
+                  end
+                else
+                  begin
+                  { load stdin/stdout stream }
+                     loadstream;
+                  end;
+
+                { save @aktfile in temporary variable }
+                exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
+                if doread then
+                { parameter by READ gives call by reference }
+                  dummycoll.paratyp:=vs_var
+                { an WRITE Call by "Const" }
+                else
+                  dummycoll.paratyp:=vs_const;
+
+                { because of secondcallparan, which otherwise attaches }
+                if ft=ft_typed then
+                  { this is to avoid copy of simple const parameters }
+                  dummycoll.data:=new(pformaldef,init)
+                else
+                  { I think, this isn't a good solution (FK) }
+                  dummycoll.data:=nil;
+
+                while assigned(node) do
+                  begin
+                     pushusedregisters(pushed,$ff);
+                     hp:=node;
+                     node:=node^.right;
+                     hp^.right:=nil;
+                     if hp^.is_colon_para then
+                       Message(parser_e_illegal_colon_qualifier);
+                     if ft=ft_typed then
+                       never_copy_const_param:=true;
+                     secondcallparan(hp,@dummycoll,false);
+                     if ft=ft_typed then
+                       never_copy_const_param:=false;
+                     hp^.right:=node;
+                     if codegenerror then
+                       exit;
+
+                     emit_push_mem(aktfile);
+                     if (ft=ft_typed) then
+                       begin
+                          { OK let's try this }
+                          { first we must only allow the right type }
+                          { we have to call blockread or blockwrite }
+                          { but the real problem is that            }
+                          { reset and rewrite should have set       }
+                          { the type size                           }
+                          { as recordsize for that file !!!!        }
+                          { how can we make that                    }
+                          { I think that is only possible by adding }
+                          { reset and rewrite to the inline list a call        }
+                          { allways read only one record by element }
+                            push_int(typedtyp^.size);
+                            if doread then
+                              emitcall('TYPED_READ',true)
+                            else
+                              emitcall('TYPED_WRITE',true);
+                       end
+                     else
+                       begin
+                          { save current position }
+                          pararesult:=hp^.left^.resulttype;
+                          { handle possible field width  }
+                          { of course only for write(ln) }
+                          if not doread then
+                            begin
+                               { handle total width parameter }
+                              if assigned(node) and node^.is_colon_para then
+                                begin
+                                   hp:=node;
+                                   node:=node^.right;
+                                   hp^.right:=nil;
+                                   secondcallparan(hp,@dummycoll,false);
+                                   hp^.right:=node;
+                                   if codegenerror then
+                                     exit;
+                                   has_length:=true;
+                                end
+                              else
+                                if pararesult^.deftype<>floatdef then
+                                  push_int(0)
+                                else
+                                  push_int(-32767);
+                            { a second colon para for a float ? }
+                              if assigned(node) and node^.is_colon_para then
+                                begin
+                                   hp:=node;
+                                   node:=node^.right;
+                                   hp^.right:=nil;
+                                   secondcallparan(hp,@dummycoll,false);
+                                   hp^.right:=node;
+                                   if pararesult^.deftype<>floatdef then
+                                     Message(parser_e_illegal_colon_qualifier);
+                                   if codegenerror then
+                                     exit;
+                                end
+                              else
+                                begin
+                                  if pararesult^.deftype=floatdef then
+                                    push_int(-1);
+                                end
+                            end;
+                          case pararesult^.deftype of
+                       stringdef : begin
+                                     if doread then
+                                       begin
+                                       { push maximum string length }
+                                       push_int(pstringdef(pararesult)^.len);
+                                       case pstringdef(pararesult)^.string_typ of
+                                        st_shortstring:
+                                          emitcall ('READ_TEXT_STRING',true);
+                                        st_ansistring:
+                                          emitcall ('READ_TEXT_ANSISTRING',true);
+                                        st_longstring:
+                                          emitcall ('READ_TEXT_LONGSTRING',true);
+                                        st_widestring:
+                                          emitcall ('READ_TEXT_ANSISTRING',true);
+                                        end
+                                       end
+                                     else
+                                       Case pstringdef(Pararesult)^.string_typ of
+                                        st_shortstring:
+                                          emitcall ('WRITE_TEXT_STRING',true);
+                                        st_ansistring:
+                                          emitcall ('WRITE_TEXT_ANSISTRING',true);
+                                        st_longstring:
+                                          emitcall ('WRITE_TEXT_LONGSTRING',true);
+                                        st_widestring:
+                                          emitcall ('WRITE_TEXT_ANSISTRING',true);
+                                        end;
+                                   end;
+                      pointerdef : begin
+                                     if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
+                                       begin
+                                         if doread then
+                                           emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
+                                         else
+                                           emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
+                                       end
+                                     else
+                                      Message(parser_e_illegal_parameter_list);
+                                   end;
+                        arraydef : begin
+                                     if (parraydef(pararesult)^.lowrange=0) and
+                                        is_equal(parraydef(pararesult)^.definition,cchardef) then
+                                       begin
+                                         if doread then
+                                           emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
+                                         else
+                                           emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
+                                       end
+                                     else
+                                      Message(parser_e_illegal_parameter_list);
+                                   end;
+                        floatdef : begin
+                                     if doread then
+                                       emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
+                                     else
+                                       emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
+                                   end;
+                          orddef : begin
+                                     case porddef(pararesult)^.typ of
+                                          u8bit : if doread then
+                                                    emitcall('READ_TEXT_BYTE',true);
+                                          s8bit : if doread then
+                                                    emitcall('READ_TEXT_SHORTINT',true);
+                                         u16bit : if doread then
+                                                    emitcall('READ_TEXT_WORD',true);
+                                         s16bit : if doread then
+                                                    emitcall('READ_TEXT_INTEGER',true);
+                                         s32bit : if doread then
+                                                    emitcall('READ_TEXT_LONGINT',true)
+                                                  else
+                                                    emitcall('WRITE_TEXT_LONGINT',true);
+                                         u32bit : if doread then
+                                                    emitcall('READ_TEXT_CARDINAL',true)
+                                                  else
+                                                    emitcall('WRITE_TEXT_CARDINAL',true);
+                                          uchar : if doread then
+                                                    emitcall('READ_TEXT_CHAR',true)
+                                                  else
+                                                    emitcall('WRITE_TEXT_CHAR',true);
+                                       bool8bit,
+                                      bool16bit,
+                                      bool32bit : if  doread then
+                                                  { emitcall('READ_TEXT_BOOLEAN',true) }
+                                                    Message(parser_e_illegal_parameter_list)
+                                                  else
+                                                    emitcall('WRITE_TEXT_BOOLEAN',true);
+                                     else
+                                       Message(parser_e_illegal_parameter_list);
+                                     end;
+                                   end;
+                          else
+                            Message(parser_e_illegal_parameter_list);
+                          end;
+                       end;
+                   { load ESI in methods again }
+                     popusedregisters(pushed);
+                     maybe_loada5;
+                  end;
+             end;
+         { Insert end of writing for textfiles }
+           if ft=ft_text then
+             begin
+               pushusedregisters(pushed,$ff);
+               emit_push_mem(aktfile);
+               if doread then
+                begin
+                  if doln then
+                    emitcall('READLN_END',true)
+                  else
+                    emitcall('READ_END',true);
+                end
+               else
+                begin
+                  if doln then
+                    emitcall('WRITELN_END',true)
+                  else
+                    emitcall('WRITE_END',true);
+                end;
+               popusedregisters(pushed);
+               maybe_loada5;
+             end;
+         { Insert IOCheck if set }
+           if assigned(iolabel) then
+             begin
+                { registers are saved in the procedure }
+                exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
+                emitcall('IOCHECK',true);
+             end;
+         { Freeup all used temps }
+           ungetiftemp(aktfile);
+           if assigned(p^.left) then
+             begin
+                p^.left:=reversparameter(p^.left);
+                if npara<>nb_para then
+                  Message(cg_f_internal_error_in_secondinline);
+                hp:=p^.left;
+                while assigned(hp) do
+                  begin
+                     if assigned(hp^.left) then
+                       if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+                         ungetiftemp(hp^.left^.location.reference);
+                     hp:=hp^.right;
+                  end;
+             end;
+        end;
+
+      procedure handle_str;
+
+        var
+           hp,node : ptree;
+           dummycoll : tdefcoll;
+           is_real,has_length : boolean;
+
+          begin
+           pushusedregisters(pushed,$ff);
+           node:=p^.left;
+           is_real:=false;
+           has_length:=false;
+           while assigned(node^.right) do node:=node^.right;
+           { if a real parameter somewhere then call REALSTR }
+           if (node^.left^.resulttype^.deftype=floatdef) then
+             is_real:=true;
+
+           node:=p^.left;
+           { we have at least two args }
+           { with at max 2 colon_para in between }
+
+           { first arg longint or float }
+           hp:=node;
+           node:=node^.right;
+           hp^.right:=nil;
+           dummycoll.data:=hp^.resulttype;
+           { string arg }
+
+           dummycoll.paratyp:=vs_var;
+           secondcallparan(hp,@dummycoll,false);
+           if codegenerror then
+             exit;
+
+           dummycoll.paratyp:=vs_const;
+           { second arg }
+           hp:=node;
+           node:=node^.right;
+           hp^.right:=nil;
+           { frac  para }
+           if hp^.is_colon_para and assigned(node) and
+              node^.is_colon_para then
+             begin
+                dummycoll.data:=hp^.resulttype;
+                secondcallparan(hp,@dummycoll,false);
+                if codegenerror then
+                  exit;
+                hp:=node;
+                node:=node^.right;
+                hp^.right:=nil;
+                has_length:=true;
+             end
+           else
+             if is_real then
+             push_int(-1);
+
+           { third arg, length only if is_real }
+           if hp^.is_colon_para then
+             begin
+                dummycoll.data:=hp^.resulttype;
+                secondcallparan(hp,@dummycoll,false);
+                if codegenerror then
+                  exit;
+                hp:=node;
+                node:=node^.right;
+                hp^.right:=nil;
+             end
+           else
+             if is_real then
+               push_int(-32767)
+             else
+               push_int(-1);
+
+           { last arg longint or real }
+           secondcallparan(hp,@dummycoll,false);
+           if codegenerror then
+             exit;
+
+           if is_real then
+             emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
+           else if porddef(hp^.resulttype)^.typ=u32bit then
+             emitcall('STR_CARDINAL',true)
+           else
+             emitcall('STR_LONGINT',true);
+           popusedregisters(pushed);
+        end;
+
+      var
+         r : preference;
+         l : longint;
+         ispushed : boolean;
+         hregister : tregister;
+         otlabel,oflabel,filenamestring : plabel;
+
+      begin
+         case p^.inlinenumber of
+            in_assert_x:
+              begin
+{ !!!!!!!!! }
+(*               otlabel:=truelabel;
+                 oflabel:=falselabel;
+                 getlabel(truelabel);
+                 getlabel(falselabel);
+                 getlabel(filenamestring);
+                 secondpass(p^.left);
+                 if codegenerror then
+                   exit;
+                 if cs_do_assertion in aktlocalswitches then
+                   begin
+                      maketojumpbool(p^.left);
+                      emitl(A_LABEL,falselabel);
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
+                        p^.fileinfo.line)));
+                      { generate string }
+                      { push string
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
+                        p^.fileinfo.line)));
+                      }
+                      emitcall('FPC_DO_ASSERT',true);
+                      emitl(A_LABEL,truelabel);
+
+                   end;
+                 truelabel:=otlabel;
+                 falselabel:=oflabel; *)
+              end;
+            in_lo_word,
+            in_hi_word :
+              begin
+                       secondpass(p^.left);
+                       p^.location.loc:=LOC_REGISTER;
+                       if p^.left^.location.loc<>LOC_REGISTER then
+                         begin
+                            if p^.left^.location.loc=LOC_CREGISTER then
+                              begin
+                                 p^.location.register:=getregister32;
+                                 emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,
+                                   p^.location.register);
+                              end
+                            else
+                              begin
+                                 del_reference(p^.left^.location.reference);
+                                 p^.location.register:=getregister32;
+                                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
+                                  newreference(p^.left^.location.reference),
+                                  p^.location.register)));
+                              end;
+                         end
+                       else p^.location.register:=p^.left^.location.register;
+                       if p^.inlinenumber=in_hi_word then
+                         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSR,S_W,8,p^.location.register)));
+                       p^.location.register:=p^.location.register;
+              end;
+            in_high_x :
+              begin
+                 if is_open_array(p^.left^.resulttype) then
+                   begin
+                      secondpass(p^.left);
+                      del_reference(p^.left^.location.reference);
+                      p^.location.register:=getregister32;
+                      new(r);
+                      reset_reference(r^);
+                      r^.base:=highframepointer;
+                      r^.offset:=highoffset+4;
+                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                        r,p^.location.register)));
+                   end
+              end;
+            in_sizeof_x,
+            in_typeof_x :
+              begin
+               { sizeof(openarray) handling }
+                 if (p^.inlinenumber=in_sizeof_x) and
+                    is_open_array(p^.left^.resulttype) then
+                  begin
+                  { sizeof(openarray)=high(openarray)+1 }
+                    secondpass(p^.left);
+                    del_reference(p^.left^.location.reference);
+                    p^.location.register:=getregister32;
+                    new(r);
+                    reset_reference(r^);
+                    r^.base:=highframepointer;
+                    r^.offset:=highoffset+4;
+                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                      r,p^.location.register)));
+                    exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,
+                      1,p^.location.register)));
+                    if parraydef(p^.left^.resulttype)^.elesize<>1 then
+                      exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,
+                        parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
+                  end
+                 else
+                  begin
+                    { for both cases load vmt }
+                    if p^.left^.treetype=typen then
+                      begin
+                        exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,
+                          S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
+                          R_A0)));
+                        p^.location.register:=getregister32;
+                        emit_reg_reg(A_MOVE,S_L,R_A0,p^.location.register);
+                      end
+                    else
+                      begin
+                        secondpass(p^.left);
+                        del_reference(p^.left^.location.reference);
+                        p^.location.loc:=LOC_REGISTER;
+                        p^.location.register:=getregister32;
+                        { load VMT pointer }
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                          newreference(p^.left^.location.reference),
+                          p^.location.register)));
+                      end;
+                    { in sizeof load size }
+                    if p^.inlinenumber=in_sizeof_x then
+                      begin
+                         new(r);
+                         reset_reference(r^);
+                        { load the address in A0 }
+                        { because now supposedly p^.location.register is an }
+                        { address.                                          }
+                        emit_reg_reg(A_MOVE, S_L, p^.location.register, R_A0);
+                        r^.base:=R_A0;
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,
+                          p^.location.register)));
+                      end;
+                  end;
+              end;
+            in_lo_long,
+            in_hi_long : begin
+                       secondpass(p^.left);
+                       p^.location.loc:=LOC_REGISTER;
+                       if p^.left^.location.loc<>LOC_REGISTER then
+                         begin
+                            if p^.left^.location.loc=LOC_CREGISTER then
+                              begin
+                                 p^.location.register:=getregister32;
+                                 emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
+                                   p^.location.register);
+                              end
+                            else
+                              begin
+                                 del_reference(p^.left^.location.reference);
+                                 p^.location.register:=getregister32;
+                                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                  newreference(p^.left^.location.reference),
+                                  p^.location.register)));
+                              end;
+                         end
+                       else p^.location.register:=p^.left^.location.register;
+                       if p^.inlinenumber=in_hi_long then
+                         begin
+                           exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ, S_L, 16, R_D1)));
+                           exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSR,S_L,R_D1,p^.location.register)));
+                         end;
+                       p^.location.register:=p^.location.register;
+                    end;
+            in_length_string :
+              begin
+                 secondpass(p^.left);
+                 set_location(p^.location,p^.left^.location);
+                 { length in ansi strings is at offset -8 }
+{$ifdef UseAnsiString}
+                 if is_ansistring(p^.left^.resulttype) then
+                   dec(p^.location.reference.offset,8);
+{$endif UseAnsiString}
+              end;
+            in_pred_x,
+            in_succ_x:
+              begin
+                 secondpass(p^.left);
+                 if p^.inlinenumber=in_pred_x then
+                   asmop:=A_SUB
+                 else
+                   asmop:=A_ADD;
+                 case p^.resulttype^.size of
+                   4 : opsize:=S_L;
+                   2 : opsize:=S_W;
+                   1 : opsize:=S_B;
+                 else
+                    internalerror(10080);
+                 end;
+                 p^.location.loc:=LOC_REGISTER;
+                 if p^.left^.location.loc<>LOC_REGISTER then
+                   begin
+                      p^.location.register:=getregister32;
+                      if p^.left^.location.loc=LOC_CREGISTER then
+                        emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
+                          p^.location.register)
+                      else
+                      if p^.left^.location.loc=LOC_FLAGS then
+                        exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
+                                  p^.location.register)))
+                      else
+                        begin
+                           del_reference(p^.left^.location.reference);
+                           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.left^.location.reference),
+                             p^.location.register)));
+                        end;
+                   end
+                 else p^.location.register:=p^.left^.location.register;
+                 exprasmlist^.concat(new(pai68k,op_const_reg(asmop,opsize,1,
+                   p^.location.register)))
+                 { here we should insert bounds check ? }
+                 { and direct call to bounds will crash the program }
+                 { if we are at the limit }
+                 { we could also simply say that pred(first)=first and succ(last)=last }
+                 { could this be usefull I don't think so (PM)
+                 emitoverflowcheck;}
+              end;
+            in_dec_x,
+            in_inc_x :
+              begin
+              { set defaults }
+                addvalue:=1;
+                addconstant:=true;
+              { load first parameter, must be a reference }
+                secondpass(p^.left^.left);
+                case p^.left^.left^.resulttype^.deftype of
+                  orddef,
+                 enumdef : begin
+                             case p^.left^.left^.resulttype^.size of
+                              1 : opsize:=S_B;
+                              2 : opsize:=S_W;
+                              4 : opsize:=S_L;
+                             end;
+                           end;
+              pointerdef : begin
+                             opsize:=S_L;
+                             addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
+                           end;
+                else
+                 internalerror(10081);
+                end;
+              { second argument specified?, must be a s32bit in register }
+                if assigned(p^.left^.right) then
+                 begin
+                   secondpass(p^.left^.right^.left);
+                 { when constant, just multiply the addvalue }
+                   if is_constintnode(p^.left^.right^.left) then
+                    addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
+                   else
+                    begin
+                      case p^.left^.right^.left^.location.loc of
+                   LOC_REGISTER,
+                  LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
+                        LOC_MEM,
+                  LOC_REFERENCE : begin
+                                    hregister:=getregister32;
+                                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                      newreference(p^.left^.right^.left^.location.reference),hregister)));
+                                  end;
+                       else
+                        internalerror(10082);
+                       end;
+                    { insert multiply with addvalue if its >1 }
+                      if addvalue>1 then
+                       exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,opsize,
+                         addvalue,hregister)));
+                      addconstant:=false;
+                    end;
+                 end;
+              { write the add instruction }
+                if addconstant then
+                 begin
+                    exprasmlist^.concat(new(pai68k,op_const_ref(addsubop[p^.inlinenumber],opsize,
+                      addvalue,newreference(p^.left^.left^.location.reference))));
+                 end
+                else
+                 begin
+                   exprasmlist^.concat(new(pai68k,op_reg_ref(addsubop[p^.inlinenumber],opsize,
+                      hregister,newreference(p^.left^.left^.location.reference))));
+                   ungetregister32(hregister);
+                 end;
+                emitoverflowcheck(p^.left^.left);
+              end;
+            in_assigned_x :
+              begin
+                secondpass(p^.left^.left);
+                p^.location.loc:=LOC_FLAGS;
+                if (p^.left^.left^.location.loc=LOC_REGISTER) or
+                   (p^.left^.left^.location.loc=LOC_CREGISTER) then
+                 begin
+                   exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,
+                    p^.left^.left^.location.register)));
+                   ungetregister32(p^.left^.left^.location.register);
+                 end
+                else
+                 begin
+                   exprasmlist^.concat(new(pai68k,op_ref(A_TST,S_L,
+                   newreference(p^.left^.left^.location.reference))));
+                   del_reference(p^.left^.left^.location.reference);
+                 end;
+                p^.location.resflags:=F_NE;
+              end;
+             in_reset_typedfile,in_rewrite_typedfile :
+               begin
+                  pushusedregisters(pushed,$ffff);
+                  exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,
+                    pfiledef(p^.left^.resulttype)^.typed_as^.size,R_SPPUSH)));
+                  secondload(p^.left);
+                  emitpushreferenceaddr(p^.left^.location.reference);
+                  if p^.inlinenumber=in_reset_typedfile then
+                    emitcall('RESET_TYPED',true)
+                  else
+                    emitcall('REWRITE_TYPED',true);
+                  popusedregisters(pushed);
+               end;
+            in_write_x :
+              handlereadwrite(false,false);
+            in_writeln_x :
+              handlereadwrite(false,true);
+            in_read_x :
+              handlereadwrite(true,false);
+            in_readln_x :
+              handlereadwrite(true,true);
+            in_str_x_string :
+              begin
+                 handle_str;
+                 maybe_loada5;
+              end;
+            in_include_x_y,
+            in_exclude_x_y:
+              begin
+{ !!!!!!!  }
+(*               secondpass(p^.left^.left);
+                 if p^.left^.right^.left^.treetype=ordconstn then
+                   begin
+                      { calculate bit position }
+                      l:=1 shl (p^.left^.right^.left^.value mod 32);
+
+                      { determine operator }
+                      if p^.inlinenumber=in_include_x_y then
+                        asmop:=A_OR
+                      else
+                        begin
+                           asmop:=A_AND;
+                           l:=not(l);
+                        end;
+                      if (p^.left^.left^.location.loc=LOC_REFERENCE) then
+                        begin
+                           inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
+                           exprasmlist^.concat(new(pai68k,op_const_ref(asmop,S_L,
+                             l,newreference(p^.left^.left^.location.reference))));
+                           del_reference(p^.left^.left^.location.reference);
+                        end
+                      else
+                        { LOC_CREGISTER }
+                        exprasmlist^.concat(new(pai68k,op_const_reg(asmop,S_L,
+                          l,p^.left^.left^.location.register)));
+                   end
+                 else
+                   begin
+                      { generate code for the element to set }
+                      ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
+                      secondpass(p^.left^.right^.left);
+                      if ispushed then
+                        restore(p^.left^.left);
+                      { determine asm operator }
+                      if p^.inlinenumber=in_include_x_y then
+                        asmop:=A_BTS
+                      else
+                        asmop:=A_BTR;
+                      if psetdef(p^.left^.resulttype)^.settype=smallset then
+                        begin
+                           if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
+                             hregister:=p^.left^.right^.left^.location.register
+                           else
+                             begin
+                                hregister:=R_EDI;
+                                exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                  newreference(p^.left^.right^.left^.location.reference),R_EDI)));
+                             end;
+                          if (p^.left^.left^.location.loc=LOC_REFERENCE) then
+                            exprasmlist^.concat(new(pai386,op_reg_ref(asmop,S_L,R_EDI,
+                              newreference(p^.left^.right^.left^.location.reference))))
+                          else
+                            exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,R_EDI,
+                              p^.left^.right^.left^.location.register)));
+                        end
+                      else
+                        begin
+                        end;
+                   end;
+                   *)
+               end;
+
+         else
+           internalerror(9);
+         end;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}
+

compiler/cg68kld.pas

@@ -0,0 +1,487 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for load/assignment nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kld;
+interface
+
+    uses
+      tree,m68k;
+
+    var
+       { this is for open arrays and strings        }
+       { but be careful, this data is in the        }
+       { generated code destroyed quick, and also   }
+       { the next call of secondload destroys this  }
+       { data                                       }
+       { So be careful using the informations       }
+       { provided by this variables                 }
+       highframepointer : tregister;
+       highoffset : longint;
+
+    procedure secondload(var p : ptree);
+    procedure secondassignment(var p : ptree);
+    procedure secondfuncret(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      cga68k,tgen68k;
+
+
+{*****************************************************************************
+                             SecondLoad
+*****************************************************************************}
+
+    procedure secondload(var p : ptree);
+
+      var
+         hregister : tregister;
+         i : longint;
+         symtabletype: tsymtabletype;
+         hp : preference;
+
+      begin
+         simple_loadn:=true;
+         reset_reference(p^.location.reference);
+         case p^.symtableentry^.typ of
+              { this is only for toasm and toaddr }
+              absolutesym :
+                 begin
+                    stringdispose(p^.location.reference.symbol);
+                    p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
+                    if p^.symtableentry^.owner^.symtabletype=unitsymtable then
+                      concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
+                 end;
+              varsym :
+                 begin
+                    hregister:=R_NO;
+                    symtabletype:=p^.symtable^.symtabletype;
+                    { in case it is a register variable: }
+                    { we simply set the location to the  }
+                    { correct register.                  }
+                    if pvarsym(p^.symtableentry)^.reg<>R_NO then
+                      begin
+                         p^.location.loc:=LOC_CREGISTER;
+                         p^.location.register:=pvarsym(p^.symtableentry)^.reg;
+                         unused:=unused-[pvarsym(p^.symtableentry)^.reg];
+                      end
+                    else
+                      begin
+                         { --------------------- LOCAL AND TEMP VARIABLES ------------- }
+                         if (symtabletype=parasymtable) or (symtabletype=localsymtable) then
+                           begin
+
+                              p^.location.reference.base:=procinfo.framepointer;
+                              p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
+
+                              if (symtabletype=localsymtable) then
+                                p^.location.reference.offset:=-p^.location.reference.offset;
+
+                              if (symtabletype=parasymtable) then
+                                inc(p^.location.reference.offset,p^.symtable^.call_offset);
+
+                              if (lexlevel>(p^.symtable^.symtablelevel)) then
+                                begin
+                                   hregister:=getaddressreg;
+
+                                   { make a reference }
+                                   new(hp);
+                                   reset_reference(hp^);
+                                   hp^.offset:=procinfo.framepointer_offset;
+                                   hp^.base:=procinfo.framepointer;
+
+                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
+
+                                   simple_loadn:=false;
+                                   i:=lexlevel-1;
+                                   while i>(p^.symtable^.symtablelevel) do
+                                     begin
+                                        { make a reference }
+                                        new(hp);
+                                        reset_reference(hp^);
+                                        hp^.offset:=8;
+                                        hp^.base:=hregister;
+
+                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
+                                        dec(i);
+                                     end;
+                                   p^.location.reference.base:=hregister;
+                                end;
+                           end
+                         { --------------------- END OF LOCAL AND TEMP VARS ---------------- }
+                         else
+                           case symtabletype of
+                              unitsymtable,globalsymtable,
+                              staticsymtable : begin
+                                                  stringdispose(p^.location.reference.symbol);
+                                                  p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
+                                                   if symtabletype=unitsymtable then
+                                                     concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
+                                               end;
+                              objectsymtable : begin
+                                                  if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
+                                                    begin
+                                                       stringdispose(p^.location.reference.symbol);
+                                                       p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
+                                                        if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then
+                                                          concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
+                                                    end
+                                                  else
+                                                    begin
+                                                  p^.location.reference.base:=R_A5;
+                                                  p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
+                                               end;
+                                               end;
+                              withsymtable :   begin
+                                                  hregister:=getaddressreg;
+                                                  p^.location.reference.base:=hregister;
+                                                  { make a reference }
+                                                  new(hp);
+                                                  reset_reference(hp^);
+                                                  hp^.offset:=p^.symtable^.datasize;
+                                                  hp^.base:=procinfo.framepointer;
+
+                                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
+
+                                                  p^.location.reference.offset:=
+                                                    pvarsym(p^.symtableentry)^.address;
+                                               end;
+                           end;
+
+                         { in case call by reference, then calculate: }
+                         if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
+                            ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
+                             dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) then
+                           begin
+                              simple_loadn:=false;
+                              if hregister=R_NO then
+                                hregister:=getaddressreg;
+                              { ADDED FOR OPEN ARRAY SUPPORT. }
+                              if (p^.location.reference.base=procinfo.framepointer) then
+                                begin
+                                   highframepointer:=p^.location.reference.base;
+                                   highoffset:=p^.location.reference.offset;
+                                end
+                              else
+                                begin
+                                   highframepointer:=R_A1;
+                                   highoffset:=p^.location.reference.offset;
+                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+                                     p^.location.reference.base,R_A1)));
+                                end;
+                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
+                                hregister)));
+                              { END ADDITION }
+                              clear_reference(p^.location.reference);
+                              p^.location.reference.base:=hregister;
+                          end;
+                         { should be dereferenced later (FK)
+                         if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
+                           ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
+                           begin
+                              simple_loadn:=false;
+                              if hregister=R_NO then
+                                hregister:=getaddressreg;
+                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
+                                hregister)));
+                              clear_reference(p^.location.reference);
+                              p^.location.reference.base:=hregister;
+                           end;
+                         }
+                      end;
+                 end;
+              procsym:
+                 begin
+                    {!!!!! Be aware, work on virtual methods too }
+                    stringdispose(p^.location.reference.symbol);
+                    p^.location.reference.symbol:=
+                      stringdup(pprocsym(p^.symtableentry)^.definition^.mangledname);
+                    if p^.symtable^.symtabletype=unitsymtable then
+                    concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
+                 end;
+              typedconstsym :
+                 begin
+                    stringdispose(p^.location.reference.symbol);
+                    p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
+                    if p^.symtable^.symtabletype=unitsymtable then
+                    concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
+                 end;
+              else internalerror(4);
+         end;
+      end;
+
+
+{*****************************************************************************
+                             SecondAssignment
+*****************************************************************************}
+
+    procedure secondassignment(var p : ptree);
+
+      var
+         opsize : topsize;
+         withresult : boolean;
+         otlabel,hlabel,oflabel : plabel;
+         hregister : tregister;
+         loc : tloc;
+
+      begin
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         withresult:=false;
+         { calculate left sides }
+         secondpass(p^.left);
+         case p^.left^.location.loc of
+            LOC_REFERENCE : begin
+                              { in case left operator uses too many registers }
+                              { but to few are free then LEA                  }
+                              if (p^.left^.location.reference.base<>R_NO) and
+                                 (p^.left^.location.reference.index<>R_NO) and
+                                 (usableaddress<p^.right^.registers32) then
+                                begin
+                                   del_reference(p^.left^.location.reference);
+                                   hregister:=getaddressreg;
+                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(
+                                     p^.left^.location.reference),
+                                     hregister)));
+                                   clear_reference(p^.left^.location.reference);
+                                   p^.left^.location.reference.base:=hregister;
+                                   p^.left^.location.reference.index:=R_NO;
+                                end;
+                              loc:=LOC_REFERENCE;
+                           end;
+            LOC_CREGISTER : loc:=LOC_CREGISTER;
+            else
+               begin
+                  Message(cg_e_illegal_expression);
+                  exit;
+               end;
+         end;
+         { lets try to optimize this (PM)             }
+         { define a dest_loc that is the location      }
+         { and a ptree to verify that it is the right }
+         { place to insert it                         }
+{$ifdef test_dest_loc}
+         if (aktexprlevel<4) then
+           begin
+              dest_loc_known:=true;
+              dest_loc:=p^.left^.location;
+              dest_loc_tree:=p^.right;
+           end;
+{$endif test_dest_loc}
+
+         if (p^.right^.treetype=realconstn) then
+           begin
+              if p^.left^.resulttype^.deftype=floatdef then
+                begin
+                   case pfloatdef(p^.left^.resulttype)^.typ of
+                     s32real : p^.right^.realtyp:=ait_real_32bit;
+                     s64real : p^.right^.realtyp:=ait_real_64bit;
+                     s80real : p^.right^.realtyp:=ait_real_extended;
+                     { what about f32bit and s64bit }
+                     end;
+                end;
+           end;
+         secondpass(p^.right);
+{$ifdef test_dest_loc}
+         dest_loc_known:=false;
+         if in_dest_loc then
+           begin
+              truelabel:=otlabel;
+              falselabel:=oflabel;
+              in_dest_loc:=false;
+              exit;
+           end;
+{$endif test_dest_loc}
+         if p^.left^.resulttype^.deftype=stringdef then
+           begin
+             { we do not need destination anymore }
+             del_reference(p^.left^.location.reference);
+             { only source if withresult is set }
+             if not(withresult) then
+               del_reference(p^.right^.location.reference);
+             loadstring(p);
+             ungetiftemp(p^.right^.location.reference);
+           end
+         else case p^.right^.location.loc of
+            LOC_REFERENCE,
+            LOC_MEM : begin
+                         { handle ordinal constants trimmed }
+                         if (p^.right^.treetype in [ordconstn,fixconstn]) or
+                            (loc=LOC_CREGISTER) then
+                           begin
+                              case p^.left^.resulttype^.size of
+                                 1 : opsize:=S_B;
+                                 2 : opsize:=S_W;
+                                 4 : opsize:=S_L;
+                              end;
+                              if loc=LOC_CREGISTER then
+                                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
+                                  newreference(p^.right^.location.reference),
+                                  p^.left^.location.register)))
+                              else
+                                exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,opsize,
+                                  p^.right^.location.reference.offset,
+                                  newreference(p^.left^.location.reference))));
+                              {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,opsize,
+                                  p^.right^.location.reference.offset,
+                                  p^.left^.location)));}
+                           end
+                         else
+                           begin
+                              concatcopy(p^.right^.location.reference,
+                                p^.left^.location.reference,p^.left^.resulttype^.size,
+                                withresult);
+                              ungetiftemp(p^.right^.location.reference);
+                           end;
+                      end;
+            LOC_REGISTER,
+            LOC_CREGISTER : begin
+                              case p^.right^.resulttype^.size of
+                                 1 : opsize:=S_B;
+                                 2 : opsize:=S_W;
+                                 4 : opsize:=S_L;
+                              end;
+                              { simplified with op_reg_loc         }
+                              if loc=LOC_CREGISTER then
+                                exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,opsize,
+                                  p^.right^.location.register,
+                                  p^.left^.location.register)))
+                              else
+                                exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,
+                                  p^.right^.location.register,
+                                  newreference(p^.left^.location.reference))));
+                              {exprasmlist^.concat(new(pai68k,op_reg_loc(A_MOV,opsize,
+                                  p^.right^.location.register,
+                                  p^.left^.location)));             }
+
+                           end;
+            LOC_FPU : begin
+                              if loc<>LOC_REFERENCE then
+                                internalerror(10010)
+                              else
+                                floatstore(pfloatdef(p^.left^.resulttype)^.typ,
+                                  p^.right^.location,p^.left^.location.reference);
+                      end;
+            LOC_JUMP     : begin
+                              getlabel(hlabel);
+                              emitl(A_LABEL,truelabel);
+                              if loc=LOC_CREGISTER then
+                                exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,
+                                  1,p^.left^.location.register)))
+                              else
+                                exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
+                                  1,newreference(p^.left^.location.reference))));
+                              {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,S_B,
+                                  1,p^.left^.location)));}
+                              emitl(A_JMP,hlabel);
+                              emitl(A_LABEL,falselabel);
+                              if loc=LOC_CREGISTER then
+                                exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,
+                                  p^.left^.location.register)))
+                              else
+                                exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
+                                  0,newreference(p^.left^.location.reference))));
+                              emitl(A_LABEL,hlabel);
+                           end;
+            LOC_FLAGS    : begin
+                              if loc=LOC_CREGISTER then
+                               begin
+                                exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,
+                                  p^.left^.location.register)));
+                                exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_B,p^.left^.location.register)));
+                               end
+                              else
+                               begin
+                                 exprasmlist^.concat(new(pai68k,op_ref(flag_2_set[p^.right^.location.resflags],S_B,
+                                    newreference(p^.left^.location.reference))));
+                                 exprasmlist^.concat(new(pai68k,op_ref(A_NEG,S_B,newreference(p^.left^.location.reference))));
+                               end;
+
+                           end;
+         end;
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+      end;
+
+
+{*****************************************************************************
+                             SecondFuncRetN
+*****************************************************************************}
+
+    procedure secondfuncret(var p : ptree);
+      var
+         hr : tregister;
+         hp : preference;
+         pp : pprocinfo;
+         hr_valid : boolean;
+      begin
+         clear_reference(p^.location.reference);
+         hr_valid:=false;
+{ !!!!!!! }     
+
+(*         if @procinfo<>pprocinfo(p^.funcretprocinfo) then
+           begin
+              hr:=getregister32;
+              hr_valid:=false;
+              hp:=new_reference(procinfo.framepointer,
+                procinfo.framepointer_offset);
+              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hr)));
+
+              pp:=procinfo.parent;
+              { walk up the stack frame }
+              while pp<>pprocinfo(p^.funcretprocinfo) do
+                begin
+                   hp:=new_reference(hr,
+                     pp^.framepointer_offset);
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hr)));
+                   pp:=pp^.parent;
+                end;
+              p^.location.reference.base:=hr;
+           end
+         else *)
+           p^.location.reference.base:=procinfo.framepointer;
+         p^.location.reference.offset:=procinfo.retoffset;
+         if ret_in_param(p^.retdef) then
+           begin
+              if not hr_valid then
+                hr:=getregister32;
+              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),hr)));
+              p^.location.reference.base:=hr;
+              p^.location.reference.offset:=0;
+           end;
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}
+

compiler/cg68kmat.pas

@@ -0,0 +1,452 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for math nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kmat;
+interface
+
+    uses
+      tree;
+
+    procedure secondmoddiv(var p : ptree);
+    procedure secondshlshr(var p : ptree);
+    procedure secondumminus(var p : ptree);
+    procedure secondnot(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      m68k,cga68k,tgen68k;
+
+{*****************************************************************************
+                             SecondModDiv
+*****************************************************************************}
+
+    { D0 and D1 used as temp (ok)   }
+    procedure secondmoddiv(var p : ptree);
+
+      var
+         hreg1 : tregister;
+         power : longint;
+         hl : plabel;
+         reg: tregister;
+         pushed: boolean;
+         hl1: plabel;
+      begin
+         secondpass(p^.left);
+         set_location(p^.location,p^.left^.location);
+         pushed:=maybe_push(p^.right^.registers32,p);
+         secondpass(p^.right);
+         if pushed then restore(p);
+
+         { put numerator in register }
+         if p^.left^.location.loc<>LOC_REGISTER then
+           begin
+              if p^.left^.location.loc=LOC_CREGISTER then
+                begin
+                  hreg1:=getregister32;
+                  emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hreg1);
+                end
+              else
+                begin
+                  del_reference(p^.left^.location.reference);
+                  hreg1:=getregister32;
+                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
+                    hreg1)));
+                end;
+              p^.left^.location.loc:=LOC_REGISTER;
+              p^.left^.location.register:=hreg1;
+           end
+         else hreg1:=p^.left^.location.register;
+
+         if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
+            ispowerof2(p^.right^.value,power) then
+           begin
+              exprasmlist^.concat(new(pai68k, op_reg(A_TST, S_L, hreg1)));
+              getlabel(hl);
+              emitl(A_BPL,hl);
+              if (power = 1) then
+                 exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L,1, hreg1)))
+              else
+               Begin
+                 { optimize using ADDQ if possible!   }
+                 if (p^.right^.value-1) < 9 then
+                   exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L,p^.right^.value-1, hreg1)))
+                 else
+                   exprasmlist^.concat(new(pai68k, op_const_reg(A_ADD, S_L,p^.right^.value-1, hreg1)));
+               end;
+              emitl(A_LABEL, hl);
+              if (power > 0) and (power < 9) then
+                 exprasmlist^.concat(new(pai68k, op_const_reg(A_ASR, S_L,power, hreg1)))
+              else
+               begin
+                  exprasmlist^.concat(new(pai68k, op_const_reg(A_MOVE,S_L,power, R_D0)));
+                  exprasmlist^.concat(new(pai68k, op_reg_reg(A_ASR,S_L,R_D0, hreg1)));
+               end;
+           end
+         else
+           begin
+              { bring denominator to D1 }
+              { D1 is always free, it's }
+              { only used for temporary  }
+              { purposes                 }
+              if (p^.right^.location.loc<>LOC_REGISTER) and
+                 (p^.right^.location.loc<>LOC_CREGISTER) then
+                 begin
+                   del_reference(p^.right^.location.reference);
+                   p^.left^.location.loc:=LOC_REGISTER;
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),R_D1)));
+                end
+             else
+              begin
+                   ungetregister32(p^.right^.location.register);
+                   emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
+              end;
+
+              { on entering this section D1 should contain the divisor }
+
+              if (aktoptprocessor = MC68020) then
+              begin
+                 { Check if divisor is ZERO - if so call HALT_ERROR }
+                 { with d0 = 200 (Division by zero!)                }
+                 getlabel(hl1);
+                 exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D1)));
+                 { if not zero then simply continue on }
+                 emitl(A_BNE,hl1);
+                 exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,200,R_D0)));
+                 emitcall('HALT_ERROR',true);
+                 emitl(A_LABEL,hl1);
+                 if (p^.treetype = modn) then
+                 Begin
+                   reg := getregister32;
+                   exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,reg)));
+                   getlabel(hl);
+                   { here what we do is prepare the high register with the     }
+                   { correct sign. i.e we clear it, check if the low dword reg }
+                   { which will participate in the division is signed, if so we}
+                   { we extend the sign to the high doword register by inverting }
+                   { all the bits.                                             }
+                   exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hreg1)));
+                   emitl(A_BPL,hl);
+                   exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,reg)));
+                   emitl(A_LABEL,hl);
+                   { reg:hreg1 / d1 }
+                   exprasmlist^.concat(new(pai68k,op_reg_reg_reg(A_DIVSL,S_L,R_D1,reg,hreg1)));
+                   { hreg1 already contains quotient }
+                   { looking for remainder }
+                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg,hreg1)));
+                   ungetregister32(reg);
+                 end
+                 else
+                 { simple division... }
+                 Begin
+                   { reg:hreg1 / d1 }
+                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_DIVS,S_L,R_D1,hreg1)));
+                 end;
+              end
+              else { MC68000 operations }
+                 begin
+                     { put numerator in d0 }
+                     emit_reg_reg(A_MOVE,S_L,hreg1,R_D0);
+                     { operation to perform on entry to both }
+                     { routines...  d0/d1                    }
+                     { return result in d0                   }
+                     if p^.treetype = divn then
+                       emitcall('LONGDIV',true)
+                     else
+                       emitcall('LONGMOD',true);
+                     emit_reg_reg(A_MOVE,S_L,R_D0,hreg1);
+              end; { endif }
+         end;
+         { this registers are always used when div/mod are present }
+         usedinproc:=usedinproc or ($800 shr word(R_D1));
+         usedinproc:=usedinproc or ($800 shr word(R_D0));
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=hreg1;
+      end;
+
+
+{*****************************************************************************
+                             SecondShlShr
+*****************************************************************************}
+
+    { D6 used as scratch (ok) }
+    procedure secondshlshr(var p : ptree);
+
+      var
+         hregister1,hregister2,hregister3 : tregister;
+         op : tasmop;
+         pushed : boolean;
+      begin
+
+         secondpass(p^.left);
+         pushed:=maybe_push(p^.right^.registers32,p);
+         secondpass(p^.right);
+         if pushed then restore(p);
+
+         { load left operators in a register }
+         if p^.left^.location.loc<>LOC_REGISTER then
+           begin
+              if p^.left^.location.loc=LOC_CREGISTER then
+                begin
+                   hregister1:=getregister32;
+                   emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
+                     hregister1);
+                end
+              else
+                begin
+                   del_reference(p^.left^.location.reference);
+                   hregister1:=getregister32;
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
+                     hregister1)));
+                end;
+           end
+         else hregister1:=p^.left^.location.register;
+
+         { determine operator }
+         if p^.treetype=shln then
+           op:=A_LSL
+         else
+           op:=A_LSR;
+
+         { shifting by a constant directly decode: }
+         if (p^.right^.treetype=ordconstn) then
+           begin
+             if (p^.right^.location.reference.offset and 31 > 0) and (p^.right^.location.reference.offset and 31 < 9) then
+                 exprasmlist^.concat(new(pai68k,op_const_reg(op,S_L,p^.right^.location.reference.offset and 31,
+                   hregister1)))
+             else
+               begin
+                 exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,p^.right^.location.reference.offset and 31,
+                   R_D6)));
+                 exprasmlist^.concat(new(pai68k,op_reg_reg(op,S_L,R_D6,hregister1)));
+               end;
+              p^.location.loc:=LOC_REGISTER;
+              p^.location.register:=hregister1;
+           end
+         else
+           begin
+              { load right operators in a register }
+              if p^.right^.location.loc<>LOC_REGISTER then
+                begin
+                   if p^.right^.location.loc=LOC_CREGISTER then
+                     begin
+                        hregister2:=getregister32;
+                        emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,
+                          hregister2);
+                     end
+                   else
+                     begin
+                        del_reference(p^.right^.location.reference);
+                        hregister2:=getregister32;
+                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
+                          hregister2)));
+                     end;
+                end
+              else hregister2:=p^.right^.location.register;
+
+
+              emit_reg_reg(op,S_L,hregister2,hregister1);
+              p^.location.register:=hregister1;
+           end;
+         { this register is always used when shl/shr are present }
+         usedinproc:=usedinproc or ($800 shr byte(R_D6));
+      end;
+
+{*****************************************************************************
+                             SecondUmMinus
+*****************************************************************************}
+
+    procedure secondumminus(var p : ptree);
+
+      begin
+         secondpass(p^.left);
+         p^.location.loc:=LOC_REGISTER;
+         case p^.left^.location.loc of
+            LOC_REGISTER : begin
+                              p^.location.register:=p^.left^.location.register;
+                              exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
+                           end;
+            LOC_CREGISTER : begin
+                               p^.location.register:=getregister32;
+                               emit_reg_reg(A_MOVE,S_L,p^.location.register,
+                                 p^.location.register);
+                               exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
+                            end;
+            LOC_REFERENCE,LOC_MEM :
+                           begin
+                              del_reference(p^.left^.location.reference);
+                              { change sign of a floating point  }
+                              { in the case of emulation, get    }
+                              { a free register, and change sign }
+                              { manually.                        }
+                              { otherwise simply load into an FPU}
+                              { register.                        }
+                              if (p^.left^.resulttype^.deftype=floatdef) and
+                                 (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
+                                begin
+                                   { move to FPU }
+                                   floatload(pfloatdef(p^.left^.resulttype)^.typ,
+                                     p^.left^.location.reference,p^.location);
+                                   if (cs_fp_emulation) in aktmoduleswitches then
+                                       { if in emulation mode change sign manually }
+                                       exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,
+                                          p^.location.fpureg)))
+                                   else
+                                       exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_FX,
+                                          p^.location.fpureg)));
+                                end
+                              else
+                                begin
+                                   p^.location.register:=getregister32;
+                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                     newreference(p^.left^.location.reference),
+                                     p^.location.register)));
+                                   exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
+                                end;
+                           end;
+            LOC_FPU : begin
+                              p^.location.loc:=LOC_FPU;
+                              p^.location.fpureg := p^.left^.location.fpureg;
+                              if (cs_fp_emulation) in aktmoduleswitches then
+                                  exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,p^.location.fpureg)))
+                              else
+                                 exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_FX,p^.location.fpureg)));
+                           end;
+         end;
+{         emitoverflowcheck;}
+      end;
+
+
+{*****************************************************************************
+                               SecondNot
+*****************************************************************************}
+
+    procedure secondnot(var p : ptree);
+
+      const
+         flagsinvers : array[F_E..F_BE] of tresflags =
+            (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
+             F_A,F_AE,F_B,F_BE);
+
+      var
+         hl : plabel;
+
+      begin
+         if (p^.resulttype^.deftype=orddef) and
+            (porddef(p^.resulttype)^.typ=bool8bit) then
+              begin
+                 case p^.location.loc of
+                    LOC_JUMP : begin
+                                  hl:=truelabel;
+                                  truelabel:=falselabel;
+                                  falselabel:=hl;
+                                  secondpass(p^.left);
+                                  maketojumpbool(p^.left);
+                                  hl:=truelabel;
+                                  truelabel:=falselabel;
+                                  falselabel:=hl;
+                               end;
+                    LOC_FLAGS : begin
+                                   secondpass(p^.left);
+                                   p^.location.resflags:=flagsinvers[p^.left^.location.resflags];
+                                end;
+                    LOC_REGISTER : begin
+                                      secondpass(p^.left);
+                                      p^.location.register:=p^.left^.location.register;
+                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
+                                   end;
+                    LOC_CREGISTER : begin
+                                       secondpass(p^.left);
+                                       p^.location.loc:=LOC_REGISTER;
+                                       p^.location.register:=getregister32;
+                                       emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
+                                         p^.location.register);
+                                       exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
+                                    end;
+                    LOC_REFERENCE,LOC_MEM : begin
+                                              secondpass(p^.left);
+                                              del_reference(p^.left^.location.reference);
+                                              p^.location.loc:=LOC_REGISTER;
+                                              p^.location.register:=getregister32;
+                                              if p^.left^.location.loc=LOC_CREGISTER then
+                                                emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
+                                                   p^.location.register)
+                                              else
+                                                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
+                                              newreference(p^.left^.location.reference),
+                                                p^.location.register)));
+                                              exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
+                                           end;
+                 end;
+              end
+            else
+              begin
+                secondpass(p^.left);
+                p^.location.loc:=LOC_REGISTER;
+
+                case p^.left^.location.loc of
+                   LOC_REGISTER : begin
+                                     p^.location.register:=p^.left^.location.register;
+                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
+                                  end;
+                   LOC_CREGISTER : begin
+                                     p^.location.register:=getregister32;
+                                     emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
+                                       p^.location.register);
+                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
+                                   end;
+                   LOC_REFERENCE,LOC_MEM :
+                                  begin
+                                     del_reference(p^.left^.location.reference);
+                                     p^.location.register:=getregister32;
+                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                                       newreference(p^.left^.location.reference),
+                                       p^.location.register)));
+                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
+                                  end;
+                end;
+                {if  p^.left^.location.loc=loc_register then
+                  p^.location.register:=p^.left^.location.register
+                else
+                  begin
+                     del_locref(p^.left^.location);
+                     p^.location.register:=getregister32;
+                     exprasmlist^.concat(new(pai68k,op_loc_reg(A_MOV,S_L,
+                       p^.left^.location,
+                       p^.location.register)));
+                  end;
+                exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));}
+
+             end;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}

compiler/cg68kmem.pas

@@ -0,0 +1,698 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for in memory related nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kmem;
+interface
+
+    uses
+      tree;
+
+    procedure secondloadvmt(var p : ptree);
+    procedure secondhnewn(var p : ptree);
+    procedure secondnewn(var p : ptree);
+    procedure secondhdisposen(var p : ptree);
+    procedure secondsimplenewdispose(var p : ptree);
+    procedure secondaddr(var p : ptree);
+    procedure seconddoubleaddr(var p : ptree);
+    procedure secondderef(var p : ptree);
+    procedure secondsubscriptn(var p : ptree);
+    procedure secondvecn(var p : ptree);
+    procedure secondselfn(var p : ptree);
+    procedure secondwith(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      m68k,cga68k,tgen68k;
+
+
+{*****************************************************************************
+                             SecondLoadVMT
+*****************************************************************************}
+
+    procedure secondloadvmt(var p : ptree);
+      begin
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=getregister32;
+         exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
+            S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
+            p^.location.register)));
+      end;
+
+
+{*****************************************************************************
+                             SecondHNewN
+*****************************************************************************}
+
+    procedure secondhnewn(var p : ptree);
+      begin
+      end;
+
+
+{*****************************************************************************
+                             SecondNewN
+*****************************************************************************}
+
+    procedure secondnewn(var p : ptree);
+      begin
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+         p^.location.register:=p^.left^.location.register;
+      end;
+
+
+{*****************************************************************************
+                             SecondDisposeN
+*****************************************************************************}
+
+    procedure secondhdisposen(var p : ptree);
+      begin
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+         clear_reference(p^.location.reference);
+         case p^.left^.location.loc of
+            LOC_REGISTER,
+            LOC_CREGISTER : begin
+                               p^.location.reference.base:=getaddressreg;
+                               exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+                                 p^.left^.location.register,
+                                 p^.location.reference.base)));
+                            end;
+            LOC_MEM,LOC_REFERENCE :
+                            begin
+                               del_reference(p^.left^.location.reference);
+                               p^.location.reference.base:=getaddressreg;
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
+                                 p^.location.reference.base)));
+                            end;
+         end;
+      end;
+
+
+{*****************************************************************************
+                             SecondNewDispose
+*****************************************************************************}
+
+    procedure secondsimplenewdispose(var p : ptree);
+
+
+      var
+         pushed : tpushed;
+         r : preference;
+
+      begin
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+
+         pushusedregisters(pushed,$ffff);
+         { determines the size of the mem block }
+         push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
+
+         { push pointer adress }
+         case p^.left^.location.loc of
+            LOC_CREGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+              p^.left^.location.register,R_SPPUSH)));
+            LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
+
+         end;
+
+         { call the mem handling procedures }
+         case p^.treetype of
+           simpledisposen:
+             begin
+                if ppointerdef(p^.left^.resulttype)^.definition^.needs_rtti then
+                  begin
+{!!!!!!!}               
+
+(*                     new(r);
+                     reset_reference(r^);
+                     r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_rtti_label));
+                     emitpushreferenceaddr(exprasmlist,r^);
+                     { push pointer adress }
+                     case p^.left^.location.loc of
+                        LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
+                          p^.left^.location.register)));
+                        LOC_REFERENCE:
+                          emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     end;
+                     emitcall('FINALIZE',true); *)
+                  end;
+                emitcall('FREEMEM',true);
+             end;
+           simplenewn:
+             begin
+                emitcall('GETMEM',true);
+                if ppointerdef(p^.left^.resulttype)^.definition^.needs_rtti then
+                  begin
+{!!!!!!!}               
+
+(*                     new(r);
+                     reset_reference(r^);
+                     r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_rtti_label));
+                     emitpushreferenceaddr(exprasmlist,r^);
+                     { push pointer adress }
+                     case p^.left^.location.loc of
+                        LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
+                          p^.left^.location.register)));
+                        LOC_REFERENCE:
+                          emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     end;
+                     emitcall('INITIALIZE',true); *)
+                  end;
+             end;
+         end;
+         popusedregisters(pushed);
+         { may be load ESI }
+         maybe_loada5;
+      end;
+
+
+{*****************************************************************************
+                             SecondAddr
+*****************************************************************************}
+
+    procedure secondaddr(var p : ptree);
+      begin
+         secondpass(p^.left);
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=getregister32;
+         {@ on a procvar means returning an address to the procedure that
+          is stored in it.}
+       { yes but p^.left^.symtableentry can be nil
+       for example on @self !! }
+         { symtableentry can be also invalid, if left is no tree node }
+         if (p^.left^.treetype=loadn) and
+          assigned(p^.left^.symtableentry) and
+            (p^.left^.symtableentry^.typ=varsym) and
+          (Pvarsym(p^.left^.symtableentry)^.definition^.deftype=
+           procvardef) then
+            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+             newreference(p^.left^.location.reference),
+             p^.location.register)))
+         else
+           begin
+            exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+             newreference(p^.left^.location.reference),R_A0)));
+            exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+             R_A0,p^.location.register)));
+           end;
+         { for use of other segments }
+         { if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
+             p^.location.segment:=p^.left^.location.reference.segment;
+         }
+         del_reference(p^.left^.location.reference);
+      end;
+
+
+{*****************************************************************************
+                             SecondDoubleAddr
+*****************************************************************************}
+
+    procedure seconddoubleaddr(var p : ptree);
+      begin
+         secondpass(p^.left);
+         p^.location.loc:=LOC_REGISTER;
+         del_reference(p^.left^.location.reference);
+         p^.location.register:=getregister32;
+         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+          newreference(p^.left^.location.reference),R_A0)));
+         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
+          R_A0,p^.location.register)));
+      end;
+
+
+{*****************************************************************************
+                             SecondDeRef
+*****************************************************************************}
+
+    procedure secondderef(var p : ptree);
+      var
+         hr : tregister;
+
+      begin
+         secondpass(p^.left);
+         clear_reference(p^.location.reference);
+         case p^.left^.location.loc of
+            LOC_REGISTER : Begin
+                             hr := getaddressreg;
+                             emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
+                             p^.location.reference.base:=hr;
+                             ungetregister(p^.left^.location.register);
+                           end;
+            LOC_CREGISTER : begin
+                               { ... and reserve one for the pointer }
+                               hr:=getaddressreg;
+                               emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
+                                      p^.location.reference.base:=hr;
+                               { LOC_REGISTER indicates that this is a
+                               variable register which should not be freed. }
+{                               ungetregister(p^.left^.location.register); }
+                            end;
+            else
+              begin
+                 { free register }
+                 del_reference(p^.left^.location.reference);
+
+                 { ...and reserve one for the pointer }
+                 hr:=getaddressreg;
+                 exprasmlist^.concat(new(pai68k,op_ref_reg(
+                   A_MOVE,S_L,newreference(p^.left^.location.reference),
+                   hr)));
+                 p^.location.reference.base:=hr;
+              end;
+         end;
+      end;
+
+
+{*****************************************************************************
+                             SecondSubScriptN
+*****************************************************************************}
+
+    procedure secondsubscriptn(var p : ptree);
+      var
+       hr: tregister;
+
+      begin
+
+         secondpass(p^.left);
+
+         if codegenerror then
+           exit;
+         { classes must be dereferenced implicit }
+         if (p^.left^.resulttype^.deftype=objectdef) and
+           pobjectdef(p^.left^.resulttype)^.isclass then
+           begin
+             clear_reference(p^.location.reference);
+             case p^.left^.location.loc of
+                LOC_REGISTER:
+                  begin
+                     { move it to an address register...}
+                     hr:=getaddressreg;
+                     emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
+                     p^.location.reference.base:=hr;
+                     { free register }
+                     ungetregister(p^.left^.location.register);
+                  end;
+                LOC_CREGISTER:
+                  begin
+                     { ... and reserve one for the pointer }
+                     hr:=getaddressreg;
+                     emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
+                       p^.location.reference.base:=hr;
+                  end;
+                else
+                  begin
+                     { free register }
+                     del_reference(p^.left^.location.reference);
+
+                     { ... and reserve one for the pointer }
+                     hr:=getaddressreg;
+                     exprasmlist^.concat(new(pai68k,op_ref_reg(
+                       A_MOVE,S_L,newreference(p^.left^.location.reference),
+                       hr)));
+                     p^.location.reference.base:=hr;
+                  end;
+             end;
+           end
+         else
+           set_location(p^.location,p^.left^.location);
+
+         inc(p^.location.reference.offset,p^.vs^.address);
+      end;
+
+
+{*****************************************************************************
+                               SecondVecN
+*****************************************************************************}
+
+    { used D0, D1 as scratch (ok) }
+    { arrays ...                  }
+    { Sets up the array and string }
+    { references .                 }
+    procedure secondvecn(var p : ptree);
+
+      var
+         pushed : boolean;
+         ind : tregister;
+         _p : ptree;
+
+      procedure calc_emit_mul;
+
+        var
+           l1,l2 : longint;
+
+        begin
+           l1:=p^.resulttype^.size;
+           case l1 of
+              1     : p^.location.reference.scalefactor:=l1;
+              2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,ind)));
+              4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,ind)));
+              8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,ind)));
+           else
+             begin
+               if ispowerof2(l1,l2) then
+                 exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,l2,ind)))
+                   else
+                 begin
+                   { use normal MC68000 signed multiply }
+                   if (l1 >= -32768) and (l1 <= 32767) then
+                     exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_W,l1,ind)))
+                   else
+                   { use long MC68020 long multiply }
+                   if (aktoptprocessor = MC68020) then
+                     exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,l1,ind)))
+                   else
+                   { MC68000 long multiply }
+                     begin
+                       exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,l1,R_D0)));
+                       exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,ind,R_D1)));
+                       emitcall('LONGMUL',true);
+                       exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,ind)));
+                     end;
+                 end;
+             end; { else case }
+            end; { end case }
+        end; { calc_emit_mul }
+
+      var
+       extraoffset : longint;
+         t : ptree;
+         hp : preference;
+         tai:pai68k;
+       reg: tregister;
+
+      begin
+         secondpass(p^.left);
+         { RESULT IS IN p^.location.reference }
+         set_location(p^.location,p^.left^.location);
+
+         { offset can only differ from 0 if arraydef }
+         if p^.left^.resulttype^.deftype=arraydef then
+           dec(p^.location.reference.offset,
+             p^.resulttype^.size*
+             parraydef(p^.left^.resulttype)^.lowrange);
+
+         if p^.right^.treetype=ordconstn then
+           begin
+              { offset can only differ from 0 if arraydef }
+              if (p^.left^.resulttype^.deftype=arraydef) then
+              begin
+                   if not(is_open_array(p^.left^.resulttype)) then
+                       begin
+                     if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
+                        (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
+                        Message(parser_e_range_check_error);
+
+                     dec(p^.left^.location.reference.offset,
+                        p^.resulttype^.size*parraydef(p^.left^.resulttype)^.lowrange);
+                    end
+                   else
+                     begin
+                        { range checking for open arrays }
+                     end;
+                  end;
+              inc(p^.left^.location.reference.offset,
+                 p^.right^.value*p^.resulttype^.size);
+              p^.left^.resulttype:=p^.resulttype;
+              disposetree(p^.right);
+              _p:=p^.left;
+              putnode(p);
+              p:=_p;
+           end
+         else
+           begin
+              { quick hack, to overcome Delphi 2 }
+              if (cs_regalloc in aktglobalswitches) and
+                (p^.left^.resulttype^.deftype=arraydef) then
+                begin
+                   extraoffset:=0;
+                   if (p^.right^.treetype=addn) then
+                     begin
+                        if p^.right^.right^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.right^.value;
+                             t:=p^.right^.left;
+                             putnode(p^.right);
+                             putnode(p^.right^.right);
+                             p^.right:=t
+                          end
+                        else if p^.right^.left^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.left^.value;
+                             t:=p^.right^.right;
+                                    putnode(p^.right);
+                             putnode(p^.right^.left);
+                             p^.right:=t
+                          end;
+                     end
+                   else if (p^.right^.treetype=subn) then
+                     begin
+                              if p^.right^.right^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.right^.value;
+                             t:=p^.right^.left;
+                             putnode(p^.right);
+                             putnode(p^.right^.right);
+                             p^.right:=t
+                          end
+                        else if p^.right^.left^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.left^.value;
+                                    t:=p^.right^.right;
+                             putnode(p^.right);
+                             putnode(p^.right^.left);
+                             p^.right:=t
+                          end;
+                     end;
+                   inc(p^.location.reference.offset,
+                     p^.resulttype^.size*extraoffset);
+                end;
+              { calculate from left to right }
+              if (p^.location.loc<>LOC_REFERENCE) and
+                 (p^.location.loc<>LOC_MEM) then
+                Message(cg_e_illegal_expression);
+
+              pushed:=maybe_push(p^.right^.registers32,p);
+              secondpass(p^.right);
+              if pushed then restore(p);
+                 case p^.right^.location.loc of
+                LOC_REGISTER : begin
+                                 ind:=p^.right^.location.register;
+                                 case p^.right^.resulttype^.size of
+                                 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                                      $ff,ind)));
+                                 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                                      $ffff,ind)));
+                                 end;
+                               end;
+
+                LOC_CREGISTER : begin
+                                       ind:=getregister32;
+                                   emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,ind);
+                                   case p^.right^.resulttype^.size of
+                                   1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                                      $ff,ind)));
+                                   2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                                      $ffff,ind)));
+                                end;
+                                end;
+                   LOC_FLAGS:
+                     begin
+                        ind:=getregister32;
+                        exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,ind)));
+                        exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,ind)));
+                     end
+                else { else outer case }
+                   begin
+                      del_reference(p^.right^.location.reference);
+                           ind:=getregister32;
+
+                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                        newreference(p^.right^.location.reference),ind)));
+
+                           {Booleans are stored in an 8 bit memory location, so
+                           the use of MOVL is not correct.}
+                      case p^.right^.resulttype^.size of
+                        1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                          $ff,ind)));
+                        2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                          $ffff,ind)));
+                      end; { end case }
+                      end; { end else begin }
+              end;
+
+              { produce possible range check code: }
+              if cs_check_range in aktlocalswitches  then
+                begin
+                   if p^.left^.resulttype^.deftype=arraydef then
+                     begin
+                        new(hp);
+                        reset_reference(hp^);
+                        parraydef(p^.left^.resulttype)^.genrangecheck;
+                        hp^.symbol:=stringdup('R_'+tostr(parraydef(p^.left^.resulttype)^.rangenr));
+                        emit_bounds_check(hp^,ind);
+                     end;
+                end;
+
+           { ------------------------ HANDLE INDEXING ----------------------- }
+           { In Motorola 680x0 mode, displacement can only be of 64K max.     }
+           { Therefore instead of doing a direct displacement, we must first  }
+           { load the new address into an address register. Therefore the     }
+           { symbol is not used.                                              }
+           if assigned(p^.location.reference.symbol) then
+           begin
+              if p^.location.reference.base <> R_NO then
+               Message(cg_f_secondvecn_base_defined_twice);
+              p^.location.reference.base:=getaddressreg;
+              exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,S_L,newcsymbol(p^.location.reference.symbol^,0),
+                p^.location.reference.base)));
+              stringdispose(p^.location.reference.symbol);
+           end;
+
+              if (p^.location.reference.index=R_NO) then
+                begin
+                   p^.location.reference.index:=ind;
+                   calc_emit_mul;
+               { here we must check for the offset      }
+               { and if out of bounds for the motorola  }
+               { eg: out of signed d8 then reload index }
+               { with correct value.                    }
+               if p^.location.reference.offset > 127 then
+               begin
+                  exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,p^.location.reference.offset,ind)));
+                  p^.location.reference.offset := 0;
+               end
+               else
+               if p^.location.reference.offset < -128 then
+               begin
+                  exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,S_L,-p^.location.reference.offset,ind)));
+                  p^.location.reference.offset := 0;
+               end;
+                end
+              else
+                begin
+                   if p^.location.reference.base=R_NO then
+                      begin
+                          case p^.location.reference.scalefactor of
+                       2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,p^.location.reference.index)));
+                       4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,p^.location.reference.index)));
+                       8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,p^.location.reference.index)));
+                       end;
+                          calc_emit_mul;
+
+                    { we must use address register to put index in base }
+                    { compare with cgi386.pas                           }
+
+                    reg := getaddressreg;
+                    p^.location.reference.base := reg;
+
+                    emit_reg_reg(A_MOVE,S_L,p^.location.reference.index,reg);
+                    ungetregister(p^.location.reference.index);
+
+                    p^.location.reference.index:=ind;
+                 end
+               else
+                 begin
+                    reg := getaddressreg;
+                    exprasmlist^.concat(new(pai68k,op_ref_reg(
+                      A_LEA,S_L,newreference(p^.location.reference),
+                      reg)));
+
+                    ungetregister(p^.location.reference.base);
+                    { the symbol offset is loaded,               }
+                    { so release the symbol name and set symbol  }
+                    { to nil                                     }
+                    stringdispose(p^.location.reference.symbol);
+                    p^.location.reference.offset:=0;
+                    calc_emit_mul;
+                    p^.location.reference.base:=reg;
+                    ungetregister32(p^.location.reference.index);
+                    p^.location.reference.index:=ind;
+                 end;
+               end;
+           end;
+      end;
+
+
+{*****************************************************************************
+                               SecondSelfN
+*****************************************************************************}
+
+    procedure secondselfn(var p : ptree);
+      begin
+         clear_reference(p^.location.reference);
+         p^.location.reference.base:=R_A5;
+      end;
+
+
+{*****************************************************************************
+                               SecondWithN
+*****************************************************************************}
+
+    procedure secondwith(var p : ptree);
+       var
+          ref : treference;
+          symtable : psymtable;
+          i : longint;
+
+       begin
+          if assigned(p^.left) then
+            begin
+               secondpass(p^.left);
+               ref.symbol:=nil;
+               gettempofsizereference(4,ref);
+               exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+                 newreference(p^.left^.location.reference),R_A0)));
+               exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
+                 R_A0,newreference(ref))));
+               del_reference(p^.left^.location.reference);
+               { the offset relative to (%ebp) is only needed here! }
+               symtable:=p^.withsymtable;
+               for i:=1 to p^.tablecount do
+                 begin
+                    symtable^.datasize:=ref.offset;
+                    symtable:=symtable^.next;
+                 end;
+
+               { p^.right can be optimize out !!! }
+               if p^.right<>nil then
+                 secondpass(p^.right);
+               { clear some stuff }
+               ungetiftemp(ref);
+            end;
+       end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}
+

compiler/cg68kset.pas

@@ -0,0 +1,819 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate m68k assembler for in set/case nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cg68kset;
+interface
+
+    uses
+      tree;
+
+    procedure secondsetelement(var p : ptree);
+    procedure secondin(var p : ptree);
+    procedure secondcase(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      m68k,cga68k,tgen68k;
+
+    const
+      bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
+
+{*****************************************************************************
+                              SecondSetElement
+*****************************************************************************}
+
+    procedure secondsetelement(var p : ptree);
+       begin
+       { load first value in 32bit register }
+         secondpass(p^.left);
+         if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+           emit_to_reg32(p^.left^.location.register);
+
+       { also a second value ? }
+         if assigned(p^.right) then
+           begin
+             secondpass(p^.right);
+             if p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+              emit_to_reg32(p^.right^.location.register);
+           end;
+
+         { we doesn't modify the left side, we check only the type }
+         set_location(p^.location,p^.left^.location);
+       end;
+
+
+{*****************************************************************************
+                              SecondIn
+*****************************************************************************}
+
+    { could be built into secondadd but it }
+    { should be easy to read }
+    procedure secondin(var p : ptree);
+
+
+      type  Tsetpart=record
+                range:boolean;      {Part is a range.}
+                start,stop:byte;    {Start/stop when range; Stop=element
+                                     when an element.}
+            end;
+
+      var
+         pushed,ranges : boolean;
+         hr : tregister;
+         setparts:array[1..8] of Tsetpart;
+         i,numparts:byte;
+         href,href2:Treference;
+         l,l2 : plabel;
+         hl,hl1 : plabel;
+         hl2, hl3: plabel;
+         opsize : topsize;
+
+
+               function swaplongint(l : longint): longint;
+               var
+                 w1: word;
+                 w2: word;
+               begin
+                 w1:=l and $ffff;
+                 w2:=l shr 16;
+                 l:=swap(w2)+(longint(swap(w1)) shl 16);
+                 swaplongint:=l;
+               end;
+
+            function analizeset(Aset:Pconstset):boolean;
+
+            type    byteset=set of byte;
+                    tlongset  = array[0..7] of longint;
+            var compares,maxcompares:word;
+                someset : tlongset;
+                i:byte;
+
+            begin
+                analizeset:=false;
+                ranges:=false;
+                numparts:=0;
+                compares:=0;
+                {Lots of comparisions take a lot of time, so do not allow
+                 too much comparisions. 8 comparisions are, however, still
+                 smalller than emitting the set.}
+                maxcompares:=5;
+                if cs_littlesize in aktglobalswitches then
+                    maxcompares:=8;
+                move(ASet^,someset,32);
+                { On Big endian machines sets are stored   }
+                { as INTEL Little-endian format, therefore }
+                { we must convert it to the correct format }
+{$IFDEF BIG_ENDIAN}
+                for I:=0 to 7 do
+                  someset[i]:=swaplongint(someset[i]);
+{$ENDIF}
+                for i:=0 to 255 do
+                    if i in byteset(someset) then
+                        begin
+                            if (numparts=0) or
+                             (i<>setparts[numparts].stop+1) then
+                                begin
+                                    {Set element is a separate element.}
+                                    inc(compares);
+                                    if compares>maxcompares then
+                                        exit;
+                                    inc(numparts);
+                                    setparts[numparts].range:=false;
+                                    setparts[numparts].stop:=i;
+                                end
+                             else
+                                {Set element is part of a range.}
+                                if not setparts[numparts].range then
+                                    begin
+                                        {Transform an element into a range.}
+                                        setparts[numparts].range:=true;
+                                        setparts[numparts].start:=
+                                         setparts[numparts].stop;
+                                        setparts[numparts].stop:=i;
+                                        inc(compares);
+                                        if compares>maxcompares then
+                                            exit;
+                                    end
+                                else
+                                    begin
+                                        {Extend a range.}
+                                        setparts[numparts].stop:=i;
+                                        {A range of two elements can better
+                                         be checked as two separate ones.
+                                         When extending a range, our range
+                                         becomes larger than two elements.}
+                                        ranges:=true;
+                                    end;
+                        end;
+                analizeset:=true;
+            end;  { end analizeset }
+
+      begin
+         if psetdef(p^.right^.resulttype)^.settype=smallset then
+           begin
+              if p^.left^.treetype=ordconstn then
+                begin
+                   { only compulsory }
+                   secondpass(p^.left);
+                   secondpass(p^.right);
+                   if codegenerror then
+                     exit;
+                   p^.location.resflags:=F_NE;
+                   { Because of the Endian of the m68k, we have to consider this as a  }
+                   { normal set and load it byte per byte, otherwise we will never get }
+                   { the correct result.                                               }
+                   case p^.right^.location.loc of
+                     LOC_REGISTER,LOC_CREGISTER :
+                       begin
+                         emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
+                         exprasmlist^.concat(new(pai68k,
+                           op_const_reg(A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
+                       end;
+                   else
+                       begin
+                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
+                           p^.right^.location.reference),R_D1)));
+                         exprasmlist^.concat(new(pai68k,op_const_reg(
+                           A_AND,S_L,1 shl (p^.left^.value and 31) ,R_D1)));
+                       end;
+                   end;
+                   del_reference(p^.right^.location.reference);
+                end
+              else
+                begin
+                   { calculate both operators }
+                   { the complex one first }
+                   firstcomplex(p);
+                   secondpass(p^.left);
+                   { are too few registers free? }
+                   pushed:=maybe_push(p^.right^.registers32,p^.left);
+                   secondpass(p^.right);
+                   if pushed then
+                     restore(p^.left);
+                   { of course not commutative }
+                   if p^.swaped then
+                        swaptree(p);
+                   { load index into register }
+                   case p^.left^.location.loc of
+                      LOC_REGISTER,
+                      LOC_CREGISTER :
+                          hr:=p^.left^.location.register;
+                      else
+                         begin
+                            { Small sets are always 32 bit values, there is no  }
+                            { way they can be anything else, so no problems here}
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                              newreference(p^.left^.location.reference),R_D1)));
+                            hr:=R_D1;
+                            del_reference(p^.left^.location.reference);
+                         end;
+                   end;
+                   case p^.right^.location.loc of
+                      LOC_REGISTER,
+                      LOC_CREGISTER : exprasmlist^.concat(new(pai68k, op_reg_reg(A_BTST,S_L,hr,p^.right^.location.register)));
+                      else
+                         begin
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
+                              R_D0)));
+                            exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,hr,R_D0)));
+                            del_reference(p^.right^.location.reference);
+                         end;
+                   end;
+                   { support carry routines }
+                   { sets the carry flags according to the result of BTST }
+                   { i.e the Z flag.                                      }
+                   getlabel(hl);
+                   emitl(A_BNE,hl);
+                   { leave all bits unchanged except Carry  = 0 }
+                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B, $FE, R_CCR)));
+                   getlabel(hl1);
+                   emitl(A_BRA,hl1);
+                   emitl(A_LABEL, hl);
+                   { set carry to 1 }
+                   exprasmlist^.concat(new(pai68k, op_const_reg(A_OR, S_B, $01, R_CCR)));
+                   emitl(A_LABEL, hl1);
+                   { end support carry routines }
+                   p^.location.loc:=LOC_FLAGS;
+                   p^.location.resflags:=F_C;
+                end;
+           end
+         else { //// NOT a small set  //// }
+           begin
+              if p^.left^.treetype=ordconstn then
+                begin
+                   { only compulsory }
+                   secondpass(p^.left);
+                   secondpass(p^.right);
+                   if codegenerror then
+                     exit;
+                   p^.location.resflags:=F_NE;
+                   inc(p^.right^.location.reference.offset,(p^.left^.value div 32)*4);
+                   exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L,
+                       newreference(p^.right^.location.reference), R_D1)));
+                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_L,
+                       1 shl (p^.left^.value mod 32),R_D1)));
+                   del_reference(p^.right^.location.reference);
+                end
+             else
+                begin
+                  if (p^.right^.treetype=setconstrn) and
+                     analizeset(p^.right^.constset) then
+                    begin
+                      {It gives us advantage to check for the set elements
+                        separately instead of using the SET_IN_BYTE procedure.
+                       To do: Build in support for LOC_JUMP.}
+                      secondpass(p^.left);
+                      {We won't do a second pass on p^.right, because
+                      this will emit the constant set.}
+                      case p^.left^.location.loc of
+                        LOC_REGISTER,
+                        LOC_CREGISTER :
+                           exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                             255,p^.left^.location.register)));
+                        else
+                         Begin
+                           { Because of the m68k endian, then we must LOAD normally the    }
+                           { value into a register first, all depending on the source      }
+                           { size!                                                         }
+                           opsize:=S_NO;
+                           case integer(p^.left^.resulttype^.savesize) of
+                             1 : opsize:=S_B;
+                             2 : opsize:=S_W;
+                             4 : opsize:=S_L;
+                           else
+                             internalerror(19);
+                           end;
+                           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
+                             newreference(p^.left^.location.reference),R_D0)));
+                           exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                             255,R_D0)));
+                         end;
+                      end;
+                      {Get a label to jump to the end.}
+                      p^.location.loc:=LOC_FLAGS;
+                      {It's better to use the zero flag when there are no ranges.}
+                      if ranges then
+                        p^.location.resflags:=F_C
+                      else
+                        p^.location.resflags:=F_E;
+                      href.symbol := nil;
+                      clear_reference(href);
+                      getlabel(l);
+                      href.symbol:=stringdup(lab2str(l));
+                      for i:=1 to numparts do
+                          if setparts[i].range then
+                             begin
+                                  {Check if left is in a range.}
+                                  {Get a label to jump over the check.}
+                                  href2.symbol := nil;
+                                  clear_reference(href2);
+                                  getlabel(l2);
+                                  href.symbol:=stringdup(lab2str(l2));
+                                  if setparts[i].start=setparts[i].stop-1 then
+                                  begin
+                                    case p^.left^.location.loc of
+                                      LOC_REGISTER,
+                                      LOC_CREGISTER :
+                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                           setparts[i].start,p^.left^.location.register)));
+                                    else
+                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                           setparts[i].start,R_D0)));
+{                                         exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                           setparts[i].start,newreference(p^.left^.location.reference))));}
+                                    end;
+                                  {Result should be in carry flag when ranges are used.}
+                                  { Here the m68k does not affect any flag except the  }
+                                  { flag which is OR'ed                                }
+                                  if ranges then
+                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
+                                  {If found, jump to end.}
+                                  emitl(A_BEQ,l);
+                                  case p^.left^.location.loc of
+                                    LOC_REGISTER,
+                                    LOC_CREGISTER :
+                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                        setparts[i].stop,p^.left^.location.register)));
+                                    else
+                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                        setparts[i].stop,R_D0)));
+{                                      exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                      setparts[i].stop,newreference(p^.left^.location.reference))));}
+                                  end;
+                                  {Result should be in carry flag when ranges are used.}
+                                  { Here the m68k does not affect any flag except the  }
+                                  { flag which is OR'ed                                }
+                                  if ranges then
+                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
+                                  {If found, jump to end.}
+                                  emitl(A_BEQ,l);
+                             end
+                          else
+                             begin
+                               if setparts[i].start<>0 then
+                                  begin
+                                  {We only check for the lower bound if it is > 0, because
+                                   set elements lower than 0 do nt exist.}
+                                    case p^.left^.location.loc of
+                                      LOC_REGISTER,
+                                      LOC_CREGISTER :
+                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                        setparts[i].start,p^.left^.location.register)));
+                                    else
+                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                        setparts[i].start,R_D0)));
+{                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                        setparts[i].start,newreference(p^.left^.location.reference)))); }
+                                    end;
+                                    {If lower, jump to next check.}
+                                    emitl(A_BCS,l2);
+                                    end;
+                                    if setparts[i].stop<>255 then
+                                       begin
+                                       {We only check for the high bound if it is < 255, because
+                                          set elements higher than 255 do nt exist.}
+                                          case p^.left^.location.loc of
+                                            LOC_REGISTER,
+                                            LOC_CREGISTER :
+                                              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                                setparts[i].stop+1,p^.left^.location.register)));
+                                          else
+                                              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                                setparts[i].stop+1,R_D0)));
+{                                              exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                                setparts[i].stop+1,newreference(p^.left^.location.reference))));}
+                                          end; { end case }
+                                          {If higher, element is in set.}
+                                          emitl(A_BCS,l);
+                                       end
+                                     else
+                                       begin
+                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
+                                         emitl(A_JMP,l);
+                                       end;
+                                  end;
+                               {Emit the jump over label.}
+                               exprasmlist^.concat(new(pai_label,init(l2)));
+                             end
+                            else
+                               begin
+                               {Emit code to check if left is an element.}
+                                 case p^.left^.location.loc of
+                                   LOC_REGISTER,
+                                   LOC_CREGISTER :
+                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                      setparts[i].stop,p^.left^.location.register)));
+                                   else
+{                                     exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                     setparts[i].stop,newreference(p^.left^.location.reference))));}
+                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                      setparts[i].stop,R_D0)));
+                                   end;
+                                 {Result should be in carry flag when ranges are used.}
+                                 if ranges then
+                                   exprasmlist^.concat(new(pai68k, op_const_reg(A_OR,S_B,$01,R_CCR)));
+                                   {If found, jump to end.}
+                                 emitl(A_BEQ,l);
+                               end;
+                            if ranges then
+                            { clear carry flag }
+                                exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,$FE,R_CCR)));
+                            {To compensate for not doing a second pass.}
+                            stringdispose(p^.right^.location.reference.symbol);
+                            {Now place the end label.}
+                            exprasmlist^.concat(new(pai_label,init(l)));
+                        end
+                   else
+                        begin
+                           { calculate both operators }
+                           { the complex one first }
+                           firstcomplex(p);
+                           secondpass(p^.left);
+                           set_location(p^.location,p^.left^.location);
+                           { are too few registers free? }
+                           pushed:=maybe_push(p^.right^.registers32,p);
+                           secondpass(p^.right);
+                           if pushed then restore(p);
+                           { of course not commutative }
+                           if p^.swaped then
+                             swaptree(p);
+                            { SET_IN_BYTE is an inline assembler procedure instead  }
+                            { of a normal procedure, which is *MUCH* faster         }
+                            { Parameters are passed by registers, and FLAGS are set }
+                            { according to the result.                              }
+                            { a0   = address of set                                 }
+                            { d0.b = value to compare with                          }
+                            { CARRY SET IF FOUND ON EXIT                            }
+                            loadsetelement(p^.left);
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+                              newreference(p^.right^.location.reference),R_A0)));;
+{                            emitpushreferenceaddr(p^.right^.location.reference);}
+                            del_reference(p^.right^.location.reference);
+                            emitcall('SET_IN_BYTE',true);
+                            { ungetiftemp(p^.right^.location.reference); }
+                            p^.location.loc:=LOC_FLAGS;
+                            p^.location.resflags:=F_C;
+                        end;
+                end;
+             end;
+      end;
+
+
+{*****************************************************************************
+                              SecondCase
+*****************************************************************************}
+
+    procedure secondcase(var p : ptree);
+
+      var
+         with_sign : boolean;
+         opsize : topsize;
+         jmp_gt,jmp_le,jmp_lee : tasmop;
+         hp : ptree;
+         { register with case expression }
+         hregister : tregister;
+         endlabel,elselabel : plabel;
+
+         { true, if we can omit the range check of the jump table }
+         jumptable_no_range : boolean;
+
+      procedure gentreejmp(p : pcaserecord);
+
+        var
+           lesslabel,greaterlabel : plabel;
+
+      begin
+         emitl(A_LABEL,p^._at);
+         { calculate labels for left and right }
+         if (p^.less=nil) then
+           lesslabel:=elselabel
+         else
+           lesslabel:=p^.less^._at;
+         if (p^.greater=nil) then
+           greaterlabel:=elselabel
+         else
+           greaterlabel:=p^.greater^._at;
+           { calculate labels for left and right }
+         { no range label: }
+         if p^._low=p^._high then
+           begin
+              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
+              if greaterlabel=lesslabel then
+                begin
+                   emitl(A_BNE,lesslabel);
+                end
+              else
+                begin
+                   emitl(jmp_le,lesslabel);
+                   emitl(jmp_gt,greaterlabel);
+                end;
+              emitl(A_JMP,p^.statement);
+           end
+         else
+           begin
+              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
+              emitl(jmp_le,lesslabel);
+              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._high,hregister)));
+              emitl(jmp_gt,greaterlabel);
+              emitl(A_JMP,p^.statement);
+           end;
+         if assigned(p^.less) then
+           gentreejmp(p^.less);
+         if assigned(p^.greater) then
+           gentreejmp(p^.greater);
+      end;
+
+      procedure genlinearlist(hp : pcaserecord);
+
+        var
+           first : boolean;
+           last : longint;
+
+        procedure genitem(t : pcaserecord);
+
+          begin
+             if assigned(t^.less) then
+               genitem(t^.less);
+             if t^._low=t^._high then
+               begin
+                  if (t^._low-last > 0) and (t^._low-last < 9) then
+                     exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last,hregister)))
+                  else
+                  if (t^._low-last = 0) then
+                     exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
+                  else
+                     exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
+                  last:=t^._low;
+
+                  emitl(A_BEQ,t^.statement);
+               end
+             else
+               begin
+                  { it begins with the smallest label, if the value }
+                  { is even smaller then jump immediately to the    }
+                  { ELSE-label                                      }
+                  if first then
+                    begin
+                       if (t^._low-1 > 0) and (t^._low < 9) then
+                          exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-1,hregister)))
+                       else
+                       if t^._low-1=0 then
+                         exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
+                       else
+                         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-1,hregister)));
+                       if t^._low = 0 then
+                          emitl(A_BLE,elselabel)
+                       else
+                          emitl(jmp_lee,elselabel);
+                    end
+                  { if there is no unused label between the last and the }
+                  { present label then the lower limit can be checked    }
+                  { immediately. else check the range in between:        }
+                  else if (t^._low-last>1)then
+
+                    begin
+                       if ((t^._low-last-1) > 0) and ((t^._low-last-1) < 9) then
+                         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last-1,hregister)))
+                       else
+                         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last-1,hregister)));
+                       emitl(jmp_lee,elselabel);
+                    end;
+                  exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._high-t^._low+1,hregister)));
+                  emitl(jmp_lee,t^.statement);
+
+                  last:=t^._high;
+               end;
+             first:=false;
+             if assigned(t^.greater) then
+               genitem(t^.greater);
+          end;
+
+        var
+           hr : tregister;
+
+        begin
+           { case register is modified by the list evalution }
+           if (p^.left^.location.loc=LOC_CREGISTER) then
+             begin
+                hr:=getregister32;
+             end;
+           last:=0;
+           first:=true;
+           genitem(hp);
+           emitl(A_JMP,elselabel);
+        end;
+
+      procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
+
+        var
+           table : plabel;
+           last : longint;
+           hr : preference;
+
+        procedure genitem(t : pcaserecord);
+
+          var
+             i : longint;
+
+          begin
+             if assigned(t^.less) then
+               genitem(t^.less);
+             { fill possible hole }
+             for i:=last+1 to t^._low-1 do
+               datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
+                 (elselabel)))));
+             for i:=t^._low to t^._high do
+               datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
+                (t^.statement)))));
+              last:=t^._high;
+             if assigned(t^.greater) then
+               genitem(t^.greater);
+          end;
+
+        begin
+           if not(jumptable_no_range) then
+             begin
+                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,min_,hregister)));
+                { case expr less than min_ => goto elselabel }
+                emitl(jmp_le,elselabel);
+                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,max_,hregister)));
+                emitl(jmp_gt,elselabel);
+             end;
+           getlabel(table);
+           { extend with sign }
+           if opsize=S_W then
+             begin
+                { word to long - unsigned }
+                exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
+             end
+           else if opsize=S_B then
+             begin
+                { byte to long - unsigned }
+                exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
+             end;
+           new(hr);
+           reset_reference(hr^);
+           hr^.symbol:=stringdup(lab2str(table));
+           hr^.offset:=(-min_)*4;
+
+           { add scalefactor *4 to index }
+           exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,hregister)));
+{           hr^.scalefactor:=4; }
+           hr^.base:=getaddressreg;
+           emit_reg_reg(A_MOVE,S_L,hregister,hr^.base);
+           exprasmlist^.concat(new(pai68k,op_ref(A_JMP,S_NO,hr)));
+{          if not(cs_littlesize in aktglobalswitches^ ) then
+             datasegment^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4))); }
+           datasegment^.concat(new(pai_label,init(table)));
+             last:=min_;
+           genitem(hp);
+           if hr^.base <> R_NO then ungetregister(hr^.base);
+           { !!!!!!!
+           if not(cs_littlesize in aktglobalswitches^ ) then
+             exprasmlist^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4)));
+           }
+        end;
+
+      var
+         lv,hv,min_label,max_label,labels : longint;
+         max_linear_list : longint;
+
+      begin
+         getlabel(endlabel);
+         getlabel(elselabel);
+         with_sign:=is_signed(p^.left^.resulttype);
+         if with_sign then
+           begin
+              jmp_gt:=A_BGT;
+              jmp_le:=A_BLT;
+              jmp_lee:=A_BLE;
+           end
+         else
+           begin
+              jmp_gt:=A_BHI;
+              jmp_le:=A_BCS;
+              jmp_lee:=A_BLS;
+           end;
+         cleartempgen;
+         secondpass(p^.left);
+         { determines the size of the operand }
+         { determines the size of the operand }
+         opsize:=bytes2Sxx[p^.left^.resulttype^.size];
+         { copy the case expression to a register }
+         { copy the case expression to a register }
+         case p^.left^.location.loc of
+            LOC_REGISTER,
+            LOC_CREGISTER : hregister:=p^.left^.location.register;
+            LOC_MEM,LOC_REFERENCE : begin
+                                       del_reference(p^.left^.location.reference);
+                                           hregister:=getregister32;
+                                       exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
+                                         p^.left^.location.reference),hregister)));
+                                    end;
+            else internalerror(2002);
+         end;
+         { now generate the jumps }
+         if cs_optimize in aktglobalswitches  then
+           begin
+              { procedures are empirically passed on }
+              { consumption can also be calculated   }
+              { but does it pay on the different     }
+              { processors?                          }
+              { moreover can the size only be appro- }
+              { ximated as it is not known if rel8,  }
+              { rel16 or rel32 jumps are used        }
+              min_label:=case_get_min(p^.nodes);
+              max_label:=case_get_max(p^.nodes);
+              labels:=case_count_labels(p^.nodes);
+              { can we omit the range check of the jump table }
+              getrange(p^.left^.resulttype,lv,hv);
+              jumptable_no_range:=(lv=min_label) and (hv=max_label);
+
+              { optimize for size ? }
+              if cs_littlesize in aktglobalswitches  then
+                begin
+                   if (labels<=2) or ((max_label-min_label)>3*labels) then
+                     { a linear list is always smaller than a jump tree }
+                     genlinearlist(p^.nodes)
+                   else
+                     { if the labels less or more a continuum then }
+                     genjumptable(p^.nodes,min_label,max_label);
+                end
+              else
+                begin
+                   if jumptable_no_range then
+                     max_linear_list:=4
+                   else
+                     max_linear_list:=2;
+
+                   if (labels<=max_linear_list) then
+                     genlinearlist(p^.nodes)
+                   else
+                     begin
+                        if ((max_label-min_label)>4*labels) then
+                          begin
+                             if labels>16 then
+                               gentreejmp(p^.nodes)
+                             else
+                               genlinearlist(p^.nodes);
+                          end
+                        else
+                          genjumptable(p^.nodes,min_label,max_label);
+                     end;
+                end;
+           end
+         else
+           { it's always not bad }
+           genlinearlist(p^.nodes);
+
+         { now generate the instructions }
+         hp:=p^.right;
+         while assigned(hp) do
+           begin
+              cleartempgen;
+              secondpass(hp^.right);
+              emitl(A_JMP,endlabel);
+              hp:=hp^.left;
+           end;
+         emitl(A_LABEL,elselabel);
+         { ... and the else block }
+         if assigned(p^.elseblock) then
+           begin
+              cleartempgen;
+              secondpass(p^.elseblock);
+           end;
+         emitl(A_LABEL,endlabel);
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}
+

compiler/cga68k.pas

@@ -32,6 +32,8 @@ unit cga68k;
     procedure emitcall(const routine:string;add_to_externals : boolean);
     procedure emitloadord2reg(location:Tlocation;orddef:Porddef;
                               destreg:Tregister;delloc:boolean);
+    procedure emit_to_reg32(var hr:tregister);
+    procedure loadsetelement(var p : ptree);
     { produces jumps to true respectively false labels using boolean expressions }
     procedure maketojumpbool(p : ptree);
     procedure emitoverflowcheck(p: ptree);
@@ -56,7 +58,6 @@ unit cga68k;
     procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize); }
 
     procedure firstcomplex(p : ptree);
-    procedure secondfuncret(var p : ptree);
 
     { generate stackframe for interrupt procedures }
     procedure generate_interrupt_stackframe_entry;
@@ -70,6 +71,18 @@ unit cga68k;
     procedure genexitcode(list : paasmoutput;parasize:longint;
                           nostackframe,inlined:boolean);
 
+{$ifdef test_dest_loc}
+const   { used to avoid temporary assignments }
+        dest_loc_known : boolean = false;
+        in_dest_loc : boolean = false;
+        dest_loc_tree : ptree = nil;
+
+var dest_loc : tlocation;
+
+procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
+
+{$endif test_dest_loc}
+
 
   implementation
 
@@ -265,6 +278,23 @@ unit cga68k;
      end;
 
 
+    procedure emit_to_reg32(var hr:tregister);
+      begin
+(*        case hr of
+      R_AX..R_DI : begin
+                     hr:=reg16toreg32(hr);
+                     exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,$ffff,hr)));
+                   end;
+      R_AL..R_DL : begin
+                     hr:=reg8toreg32(hr);
+                     exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,$ff,hr)));
+                   end;
+      R_AH..R_DH : begin
+                     hr:=reg8toreg32(hr);
+                     exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,$ff00,hr)));
+                   end;
+        end; *)
+      end;
 
     function getfloatsize(t: tfloattype): topsize;
     begin
@@ -426,6 +456,54 @@ unit cga68k;
            end;
         end;
 
+    { This routine needs to be further checked to see if it works correctly  }
+    { because contrary to the intel version, all large set elements are read }
+    { as 32-bit values, and then decomposed to find the correct byte.        }
+
+    { CHECKED : Depending on the result size, if reference, a load may be    }
+    { required on word, long or byte.                                        }
+    procedure loadsetelement(var p : ptree);
+
+      var
+         hr : tregister;
+         opsize : topsize;
+
+      begin
+         { copy the element in the d0.b register, slightly complicated }
+         case p^.location.loc of
+            LOC_REGISTER,
+            LOC_CREGISTER : begin
+                              hr:=p^.location.register;
+                              emit_reg_reg(A_MOVE,S_L,hr,R_D0);
+                              ungetregister32(hr);
+                           end;
+            else
+               begin
+                 { This is quite complicated, because of the endian on }
+                 { the m68k!                                           }
+                 opsize:=S_NO;
+                 case integer(p^.resulttype^.savesize) of
+                   1 : opsize:=S_B;
+                   2 : opsize:=S_W;
+                   4 : opsize:=S_L;
+                 else
+                   internalerror(19);
+                 end;
+                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
+                    newreference(p^.location.reference),R_D0)));
+                 exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                    255,R_D0)));
+{
+                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                    newreference(p^.location.reference),R_D0)));        }
+{                  exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                    $ff,R_D0))); }
+                  del_reference(p^.location.reference);
+               end;
+         end;
+      end;
+
+
     procedure generate_interrupt_stackframe_entry;
       begin
          { save the registers of an interrupt procedure }
@@ -812,7 +890,7 @@ begin
             procinfo.aktexitcode^.concat(new(pai_stabn,init(strpnew('224,0,0,'
              +lab2str(aktexit2label)))));
         end;
-{$endif * GDB *}
+{$endif GDB}
 end;
 
 
@@ -1244,27 +1322,36 @@ end;
       end;
 
 
-    procedure secondfuncret(var p : ptree);
-      var
-         hregister : tregister;
+{$ifdef test_dest_loc}
+        procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
-      begin
-         clear_reference(p^.location.reference);
-         p^.location.reference.base:=procinfo.framepointer;
-         p^.location.reference.offset:=procinfo.retoffset;
-         if ret_in_param(procinfo.retdef) then
-           begin
-              hregister:=getaddressreg;
-              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,newreference(p^.location.reference),hregister)));
-              p^.location.reference.base:=hregister;
-              p^.location.reference.offset:=0;
-           end;
-      end;
+          begin
+             if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
+               begin
+                 emit_reg_reg(A_MOVE,s,reg,dest_loc.register);
+                 p^.location:=dest_loc;
+                 in_dest_loc:=true;
+               end
+             else
+             if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
+               begin
+                 exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,s,reg,newreference(dest_loc.reference))));
+                 p^.location:=dest_loc;
+                 in_dest_loc:=true;
+               end
+             else
+               internalerror(20080);
+          end;
 
-  end.
+{$endif test_dest_loc}
+
+end.
 {
   $Log$
-  Revision 1.11  1998-08-31 12:26:24  peter
+  Revision 1.12  1998-09-01 09:07:09  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+  Revision 1.11  1998/08/31 12:26:24  peter
     * m68k and palmos updates from surebugfixes
 
   Revision 1.10  1998/08/21 14:08:41  pierre

compiler/pass_2.pas

@@ -0,0 +1,491 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    This unit handles the codegeneration pass
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{$ifdef TP}
+  {$E+,F+,N+}
+{$endif}
+unit pass_2;
+interface
+
+uses
+  tree;
+
+{ produces assembler for the expression in variable p }
+{ and produces an assembler node at the end           }
+procedure generatecode(var p : ptree);
+
+{ produces the actual code }
+function do_secondpass(var p : ptree) : boolean;
+procedure secondpass(var p : ptree);
+
+
+implementation
+
+   uses
+     cobjects,verbose,comphook,systems,globals,files,
+     symtable,types,aasm,scanner,
+     pass_1,hcodegen,temp_gen
+{$ifdef GDB}
+     ,gdb
+{$endif}
+{$ifdef i386}
+     ,i386,tgeni386,cgai386
+     ,cg386con,cg386mat,cg386cnv,cg386set,cg386add
+     ,cg386mem,cg386cal,cg386ld,cg386flw,cg386inl
+{$endif}
+{$ifdef m68k}
+     ,m68k,tgen68k,cga68k
+     ,cg68kcon,cg68kmat,cg68kcnv,cg68kset,cg68kadd
+     ,cg68kmem,cg68kcal,cg68kld,cg68kflw,cg68kinl
+{$endif}
+     ;
+
+{*****************************************************************************
+                              SecondPass
+*****************************************************************************}
+
+    type
+       secondpassproc = procedure(var p : ptree);
+
+    procedure secondnothing(var p : ptree);
+      begin
+      end;
+
+
+    procedure seconderror(var p : ptree);
+
+      begin
+         p^.error:=true;
+         codegenerror:=true;
+      end;
+
+
+    procedure secondstatement(var p : ptree);
+      var
+         hp : ptree;
+      begin
+         hp:=p;
+         while assigned(hp) do
+          begin
+            if assigned(hp^.right) then
+             begin
+               cleartempgen;
+               secondpass(hp^.right);
+             end;
+            hp:=hp^.left;
+          end;
+      end;
+
+
+    procedure secondblockn(var p : ptree);
+      begin
+      { do second pass on left node }
+        if assigned(p^.left) then
+         secondpass(p^.left);
+      end;
+
+
+    procedure secondasm(var p : ptree);
+      begin
+         exprasmlist^.concatlist(p^.p_asm);
+         if not p^.object_preserved then
+          begin
+{$ifdef i386}   
+
+            maybe_loadesi;
+{$endif}
+{$ifdef m68k}
+            maybe_loada5;
+{$endif}        
+
+          end;
+
+       end;
+
+
+     procedure secondpass(var p : ptree);
+       const
+         procedures : array[ttreetyp] of secondpassproc =
+            (secondadd,         {addn}
+             secondadd,         {muln}
+             secondadd,         {subn}
+             secondmoddiv,      {divn}
+             secondadd,         {symdifn}
+             secondmoddiv,      {modn}
+             secondassignment,  {assignn}
+             secondload,        {loadn}
+             secondnothing,     {range}
+             secondadd,         {ltn}
+             secondadd,         {lten}
+             secondadd,         {gtn}
+             secondadd,         {gten}
+             secondadd,         {equaln}
+             secondadd,         {unequaln}
+             secondin,          {inn}
+             secondadd,         {orn}
+             secondadd,         {xorn}
+             secondshlshr,      {shrn}
+             secondshlshr,      {shln}
+             secondadd,         {slashn}
+             secondadd,         {andn}
+             secondsubscriptn,  {subscriptn}
+             secondderef,       {derefn}
+             secondaddr,        {addrn}
+             seconddoubleaddr,  {doubleaddrn}
+             secondordconst,    {ordconstn}
+             secondtypeconv,    {typeconvn}
+             secondcalln,       {calln}
+             secondnothing,     {callparan}
+             secondrealconst,   {realconstn}
+             secondfixconst,    {fixconstn}
+             secondumminus,     {umminusn}
+             secondasm,         {asmn}
+             secondvecn,        {vecn}
+             secondstringconst, {stringconstn}
+             secondfuncret,     {funcretn}
+             secondselfn,       {selfn}
+             secondnot,         {notn}
+             secondinline,      {inlinen}
+             secondniln,        {niln}
+             seconderror,       {errorn}
+             secondnothing,     {typen}
+             secondhnewn,       {hnewn}
+             secondhdisposen,   {hdisposen}
+             secondnewn,        {newn}
+             secondsimplenewdispose, {simpledisposen}
+             secondsetelement,  {setelementn}
+             secondsetcons,     {setconstn}
+             secondblockn,      {blockn}
+             secondstatement,   {statementn}
+             secondnothing,     {loopn}
+             secondifn,         {ifn}
+             secondbreakn,      {breakn}
+             secondcontinuen,   {continuen}
+             second_while_repeatn, {repeatn}
+             second_while_repeatn, {whilen}
+             secondfor,         {forn}
+             secondexitn,       {exitn}
+             secondwith,        {withn}
+             secondcase,        {casen}
+             secondlabel,       {labeln}
+             secondgoto,        {goton}
+             secondsimplenewdispose, {simplenewn}
+             secondtryexcept,   {tryexceptn}
+             secondraise,       {raisen}
+             secondnothing,     {switchesn}
+             secondtryfinally,  {tryfinallyn}
+             secondon,          {onn}
+             secondis,          {isn}
+             secondas,          {asn}
+             seconderror,       {caretn}
+             secondfail,        {failn}
+             secondadd,         {starstarn}
+             secondprocinline,  {procinlinen}
+             secondnothing,     {nothingn}
+             secondloadvmt      {loadvmtn}
+             );
+      var
+         oldcodegenerror  : boolean;
+         oldlocalswitches : tlocalswitches;
+         oldpos           : tfileposinfo;
+      begin
+         if not(p^.error) then
+          begin
+            oldcodegenerror:=codegenerror;
+            oldlocalswitches:=aktlocalswitches;
+            oldpos:=aktfilepos;
+        
+
+            aktfilepos:=p^.fileinfo;
+            aktlocalswitches:=p^.localswitches;
+            codegenerror:=false;
+            procedures[p^.treetype](p);
+            p^.error:=codegenerror;
+        
+
+            codegenerror:=codegenerror or oldcodegenerror;
+            aktlocalswitches:=oldlocalswitches;
+            aktfilepos:=oldpos;
+          end
+         else
+           codegenerror:=true;
+      end;
+
+
+    function do_secondpass(var p : ptree) : boolean;
+      begin
+         codegenerror:=false;
+         if not(p^.error) then
+           secondpass(p);
+         do_secondpass:=codegenerror;
+      end;
+
+
+
+    var
+       regvars : array[1..maxvarregs] of pvarsym;
+       regvars_para : array[1..maxvarregs] of boolean;
+       regvars_refs : array[1..maxvarregs] of longint;
+       parasym : boolean;
+
+    procedure searchregvars(p : psym);
+
+      var
+         i,j,k : longint;
+
+      begin
+         if (p^.typ=varsym) and ((pvarsym(p)^.var_options and vo_regable)<>0) then
+           begin
+              { walk through all momentary register variables }
+              for i:=1 to maxvarregs do
+                begin
+                   { free register ? }
+                   if regvars[i]=nil then
+                     begin
+                        regvars[i]:=pvarsym(p);
+                        regvars_para[i]:=parasym;
+                        break;
+                     end;
+                   { else throw out a variable ? }
+                       j:=pvarsym(p)^.refs;
+                   { parameter get a less value }
+                   if parasym then
+                     begin
+                        if cs_littlesize in aktglobalswitches  then
+                          dec(j,1)
+                        else
+                          dec(j,100);
+                     end;
+                   if (j>regvars_refs[i]) and (j>0) then
+                     begin
+                        for k:=maxvarregs-1 downto i do
+                          begin
+                             regvars[k+1]:=regvars[k];
+                             regvars_para[k+1]:=regvars_para[k];
+                          end;
+                        { calc the new refs
+                        pvarsym(p)^.refs:=j; }
+                        regvars[i]:=pvarsym(p);
+                        regvars_para[i]:=parasym;
+                        regvars_refs[i]:=j;
+                        break;
+                     end;
+                end;
+           end;
+      end;
+
+
+    procedure generatecode(var p : ptree);
+      var
+         i       : longint;
+         regsize : topsize;
+         regi    : tregister;
+         hr      : preference;
+      label
+         nextreg;
+      begin
+         cleartempgen;
+         { when size optimization only count occurrence }
+         if cs_littlesize in aktglobalswitches then
+           t_times:=1
+         else
+           { reference for repetition is 100 }
+           t_times:=100;
+         { clear register count }
+         clearregistercount;
+         use_esp_stackframe:=false;
+
+         if not(do_firstpass(p)) then
+           begin
+              { max. optimizations     }
+              { only if no asm is used }
+              { and no try statement   }
+              if (cs_regalloc in aktglobalswitches) and
+                ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+                begin
+                   { can we omit the stack frame ? }
+                   { conditions:
+                     1. procedure (not main block)
+                     2. no constructor or destructor
+                     3. no call to other procedures
+                     4. no interrupt handler
+                   }
+                   if assigned(aktprocsym) then
+                     begin
+                       if (aktprocsym^.definition^.options and
+                        (poconstructor+podestructor{+poinline}+pointerrupt)=0) and
+                        ((procinfo.flags and pi_do_call)=0) and (lexlevel>1) then
+                       begin
+                         { use ESP as frame pointer }
+                         procinfo.framepointer:=stack_pointer;
+                         use_esp_stackframe:=true;
+
+                         { calc parameter distance new }
+                         dec(procinfo.framepointer_offset,4);
+                         dec(procinfo.ESI_offset,4);
+
+                         { is this correct ???}
+                         { retoffset can be negativ for results in eax !! }
+                         { the value should be decreased only if positive }
+                         if procinfo.retoffset>=0 then
+                           dec(procinfo.retoffset,4);
+
+                         dec(procinfo.call_offset,4);
+                         aktprocsym^.definition^.parast^.call_offset:=procinfo.call_offset;
+                       end;
+                     end;
+                   if (p^.registers32<4) then
+                       begin
+                        for i:=1 to maxvarregs do
+                          regvars[i]:=nil;
+                        parasym:=false;
+                      {$ifdef tp}
+                        symtablestack^.foreach(searchregvars);
+                      {$else}
+                        symtablestack^.foreach(@searchregvars);
+                      {$endif}
+                        { copy parameter into a register ? }
+                        parasym:=true;
+                      {$ifdef tp}
+                        symtablestack^.next^.foreach(searchregvars);
+                      {$else}
+                        symtablestack^.next^.foreach(@searchregvars);
+                      {$endif}
+                        { hold needed registers free }
+                        for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
+                          regvars[i]:=nil;
+                        { now assign register }
+                        for i:=1 to maxvarregs-p^.registers32 do
+                          begin
+                             if assigned(regvars[i]) then
+                               begin
+                                  { it is nonsens, to copy the variable to }
+                                  { a register because we need then much   }
+                                  { pushes ?                               }
+                                  if reg_pushes[varregs[i]]>=regvars[i]^.refs then
+                                    begin
+                                       regvars[i]:=nil;
+                                       goto nextreg;
+                                    end;
+
+                                  { register is no longer available for }
+                                  { expressions                         }
+                                  { search the register which is the most }
+                                  { unused                                }
+                                  usableregs:=usableregs-[varregs[i]];
+                                  is_reg_var[varregs[i]]:=true;
+                                  dec(c_usableregs);
+
+                                  { possibly no 32 bit register are needed }
+                                  if  (regvars[i]^.definition^.deftype=orddef) and
+                                      (porddef(regvars[i]^.definition)^.typ in [bool8bit,uchar,u8bit,s8bit]) then
+                                    begin
+{$ifdef i386}                           
+
+                                       regvars[i]^.reg:=reg32toreg8(varregs[i]);
+{$endif}                                
+
+                                       regsize:=S_B;
+                                    end
+                                  else if  (regvars[i]^.definition^.deftype=orddef) and
+                                           (porddef(regvars[i]^.definition)^.typ in [bool16bit,u16bit,s16bit]) then
+                                    begin
+{$ifdef i386}                           
+
+                                       regvars[i]^.reg:=reg32toreg16(varregs[i]);
+{$endif}                                
+
+                                       regsize:=S_W;
+                                    end
+                                  else
+                                    begin
+                                       regvars[i]^.reg:=varregs[i];
+                                       regsize:=S_L;
+                                    end;
+                                  { parameter must be load }
+                                  if regvars_para[i] then
+                                    begin
+                                       { procinfo is there actual,      }
+                                       { because we can't never be in a }
+                                       { nested procedure               }
+                                       { when loading parameter to reg  }
+                                       new(hr);
+                                       reset_reference(hr^);
+                                       hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
+                                       hr^.base:=procinfo.framepointer;
+{$ifdef i386}
+                                       procinfo.aktentrycode^.concat(new(pai386,op_ref_reg(A_MOV,regsize,
+                                         hr,regvars[i]^.reg)));
+{$endif i386}
+{$ifdef m68k}
+                                       procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
+                                         hr,regvars[i]^.reg)));
+{$endif m68k}                                   
+
+                                       unused:=unused - [regvars[i]^.reg];
+                                    end;
+                                  { procedure uses this register }
+{$ifdef i386}
+                                  usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
+{$endif i386}
+{$ifdef m68k}
+                                  usedinproc:=usedinproc or ($800 shr word(varregs[i]));
+{$endif m68k}                                   
+
+                               end;
+                             nextreg:
+                               { dummy }
+                               regsize:=S_W;
+                          end;
+                        if (status.verbosity and v_debug)=v_debug then
+                          begin
+                             for i:=1 to maxvarregs do
+                               begin
+                                  if assigned(regvars[i]) then
+                                   Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
+                                           tostr(regvars[i]^.refs),regvars[i]^.name);
+                               end;
+                          end;
+                     end;
+                end;
+              if assigned(aktprocsym) and
+                 ((aktprocsym^.definition^.options and poinline)<>0) then
+                make_const_global:=true;
+              do_secondpass(p);
+
+{$ifdef StoreFPULevel}
+              procinfo.def^.fpu_used:=p^.registersfpu;
+{$endif StoreFPULevel}
+              { all registers can be used again }
+              resetusableregisters;
+           end;
+         procinfo.aktproccode^.concatlist(exprasmlist);
+         make_const_global:=false;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-09-01 09:07:12  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+}

compiler/systems.pas

@@ -100,7 +100,7 @@ unit systems;
        );
 
 
-       tosinfo = record
+       tosinfo = packed record
           name      : string[30];
           sharedlibext,
           staticlibext,
@@ -333,8 +333,8 @@ implementation
             sourceext    : '.pp';
             pasext       : '.pas';
             exeext       : '';
-            scriptext    : '';
-            libprefix    : '';
+            scriptext    : '.sh';
+            libprefix    : 'lib';
             Cprefix      : '_';
             newline      : #10;
             endian       : en_big_endian;
@@ -908,7 +908,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.30  1998-08-31 12:26:34  peter
+  Revision 1.31  1998-09-01 09:07:13  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+  Revision 1.30  1998/08/31 12:26:34  peter
     * m68k and palmos updates from surebugfixes
 
   Revision 1.29  1998/08/26 10:09:21  peter