home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / pass_1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  175.0 KB  |  4,737 lines
  1. {
  2.     $Id: pass_1.pas,v 1.3 1998/03/28 23:09:56 florian Exp $
  3.     Copyright (c) 1996-98 by Florian Klaempfl
  4.  
  5.     This unit implements the first pass of the code generator
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23.  
  24. {$ifdef tp}
  25.   {$F+}
  26. {$endif tp}
  27. unit pass_1;
  28.  
  29.   interface
  30.  
  31.     uses tree;
  32.  
  33.     function do_firstpass(var p : ptree) : boolean;
  34.  
  35.   implementation
  36.  
  37.      uses
  38.         objects,cobjects,verbose,systems,globals,aasm,symtable,
  39.         types,strings,hcodegen,files
  40. {$ifdef i386}
  41.         ,i386
  42.         ,tgeni386
  43. {$endif}
  44. {$ifdef m68k}
  45.         ,m68k
  46.         ,tgen68k
  47. {$endif}
  48. {$ifdef UseBrowser}
  49.         ,browser
  50. {$endif UseBrowser}
  51.         ;
  52.  
  53.     { firstcallparan without varspez
  54.       we don't count the ref }
  55.     const
  56.        count_ref : boolean = true;
  57.  
  58.     procedure error(const t : tmsgconst);
  59.  
  60.       begin
  61.          if not(codegenerror) then
  62.            verbose.Message(t);
  63.          codegenerror:=true;
  64.       end;
  65.  
  66.     procedure firstpass(var p : ptree);forward;
  67.  
  68.     { marks an lvalue as "unregable" }
  69.     procedure make_not_regable(p : ptree);
  70.  
  71.       begin
  72.          case p^.treetype of
  73.             typeconvn : make_not_regable(p^.left);
  74.             loadn : if p^.symtableentry^.typ=varsym then
  75.                       pvarsym(p^.symtableentry)^.regable:=false;
  76.          end;
  77.       end;
  78.  
  79.  
  80.     { calculates the needed registers for a binary operator }
  81.     procedure calcregisters(p : ptree;r32,fpu,mmx : word);
  82.  
  83.       begin
  84.          p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  85.          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  86. {$ifdef SUPPORT_MMX}
  87.          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  88. {$endif SUPPORT_MMX}
  89.  
  90.          { Nur wenn links und rechts ein Unterschied < ben”tige Anzahl ist, }
  91.          { wird ein zus„tzliches Register ben”tigt, da es dann keinen       }
  92.          { schwierigeren Ast gibt, welcher erst ausgewertet werden kann     }
  93.  
  94.          if (abs(p^.left^.registers32-p^.right^.registers32)<r32) then
  95.            inc(p^.registers32,r32);
  96.  
  97.          if (abs(p^.left^.registersfpu-p^.right^.registersfpu)<fpu) then
  98.            inc(p^.registersfpu,fpu);
  99.  
  100. {$ifdef SUPPORT_MMX}
  101.          if (abs(p^.left^.registersmmx-p^.right^.registersmmx)<mmx) then
  102.            inc(p^.registersmmx,mmx);
  103. {$endif SUPPORT_MMX}
  104.  
  105.          { error message, if more than 8 floating point }
  106.          { registers are needed                         }
  107.          if p^.registersfpu>8 then
  108.           Message(cg_e_too_complex_expr);
  109.       end;
  110.  
  111.     function both_rm(p : ptree) : boolean;
  112.  
  113.         begin
  114.            both_rm:=(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  115.              (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]);
  116.         end;
  117.  
  118.     function isconvertable(def_from,def_to : pdef;
  119.              var doconv : tconverttype;fromtreetype : ttreetyp) : boolean;
  120.  
  121.       { from_is_cstring muá true sein, wenn def_from die Definition einer }
  122.       { Stringkonstanten ist, n”tig wegen der Konvertierung von String-   }
  123.       { konstante zu nullterminiertem String                              }
  124.  
  125.       { Hilfsliste: u8bit,s32bit,uvoid,
  126.                     bool8bit,uchar,s8bit,s16bit,u16bit,u32bit }
  127.  
  128.       const
  129.          basedefconverts : array[u8bit..u32bit,u8bit..u32bit] of tconverttype =
  130.            {u8bit}
  131.            ((tc_only_rangechecks32bit,tc_u8bit_2_s32bit,tc_not_possible,
  132.              tc_not_possible,tc_not_possible,tc_only_rangechecks32bit,tc_u8bit_2_s16bit,
  133.              tc_u8bit_2_u16bit,{tc_not_possible}tc_u8bit_2_u32bit),
  134.  
  135.            {s32bit}
  136.             (tc_s32bit_2_u8bit,tc_only_rangechecks32bit,tc_not_possible,
  137.              tc_not_possible,tc_not_possible,tc_s32bit_2_s8bit,
  138.              tc_s32bit_2_s16bit,tc_s32bit_2_u16bit,{tc_not_possible}tc_s32bit_2_u32bit),
  139.  
  140.            {uvoid}
  141.             (tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible,
  142.              tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible,
  143.              tc_not_possible),
  144.  
  145.            {bool8bit}
  146.             (tc_not_possible,tc_not_possible,tc_not_possible,
  147.              tc_only_rangechecks32bit,tc_not_possible,tc_not_possible,tc_not_possible,
  148.              tc_not_possible,tc_not_possible),
  149.  
  150.            {uchar}
  151.             (tc_not_possible,tc_not_possible,tc_not_possible,
  152.              tc_not_possible,tc_only_rangechecks32bit,tc_not_possible,tc_not_possible,
  153.              tc_not_possible,tc_not_possible),
  154.  
  155.            {s8bit}
  156.             (tc_only_rangechecks32bit,tc_s8bit_2_s32bit,tc_not_possible,
  157.              tc_not_possible,tc_not_possible,tc_only_rangechecks32bit,tc_s8bit_2_s16bit,
  158.              tc_s8bit_2_u16bit,{tc_not_possible}tc_s8bit_2_u32bit),
  159.  
  160.            {s16bit}
  161.             (tc_s16bit_2_u8bit,tc_s16bit_2_s32bit,tc_not_possible,
  162.              tc_not_possible,tc_not_possible,tc_s16bit_2_s8bit,tc_only_rangechecks32bit,
  163.              tc_only_rangechecks32bit,{tc_not_possible}tc_s8bit_2_u32bit),
  164.  
  165.            {u16bit}
  166.             (tc_u16bit_2_u8bit,tc_u16bit_2_s32bit,tc_not_possible,
  167.              tc_not_possible,tc_not_possible,tc_u16bit_2_s8bit,tc_only_rangechecks32bit,
  168.              tc_only_rangechecks32bit,{tc_not_possible}tc_u16bit_2_u32bit),
  169.  
  170.            {u32bit}
  171.             (tc_not_possible,{tc_not_possible}tc_u32bit_2_s32bit,tc_not_possible,
  172.              tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible,
  173.              tc_not_possible,tc_only_rangechecks32bit)
  174.             );
  175.  
  176.       var
  177.          b : boolean;
  178.  
  179.       begin
  180.          b:=false;
  181.          if (not assigned(def_from)) or (not assigned(def_to)) then
  182.           begin
  183.             isconvertable:=false;
  184.             exit;
  185.           end;
  186.  
  187.          if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then
  188.            begin
  189.               doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ];
  190.               if doconv<>tc_not_possible then
  191.                 b:=true;
  192.            end
  193.          else if (def_from^.deftype=orddef) and (def_to^.deftype=floatdef) then
  194.            begin
  195.               if pfloatdef(def_to)^.typ=f32bit then
  196.                 doconv:=tc_int_2_fix
  197.               else
  198.                 doconv:=tc_int_2_real;
  199.               b:=true;
  200.            end
  201.          else if (def_from^.deftype=floatdef) and (def_to^.deftype=floatdef) then
  202.            begin
  203.               if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
  204.                 doconv:=tc_equal
  205.               else
  206.                 begin
  207.                    if pfloatdef(def_from)^.typ=f32bit then
  208.                      doconv:=tc_fix_2_real
  209.                    else if pfloatdef(def_to)^.typ=f32bit then
  210.                      doconv:=tc_real_2_fix
  211.                    else
  212.                      doconv:=tc_real_2_real;
  213.                    { comp isn't a floating type }
  214. {$ifdef i386}
  215.                    if (pfloatdef(def_to)^.typ=s64bit) then
  216.                      Message(parser_w_convert_real_2_comp);
  217. {$endif}
  218.                 end;
  219.               b:=true;
  220.            end
  221.          else if (def_from^.deftype=pointerdef) and (def_to^.deftype=arraydef) and
  222.                  (parraydef(def_to)^.lowrange=0) and
  223.                  is_equal(ppointerdef(def_from)^.definition,
  224.                    parraydef(def_to)^.definition) then
  225.            begin
  226.               doconv:=tc_pointer_to_array;
  227.               b:=true;
  228.            end
  229.          else if (def_from^.deftype=arraydef) and (def_to^.deftype=pointerdef) and
  230.                 (parraydef(def_from)^.lowrange=0) and
  231.                 is_equal(parraydef(def_from)^.definition,
  232.                 ppointerdef(def_to)^.definition) then
  233.            begin
  234.               doconv:=tc_array_to_pointer;
  235.               b:=true;
  236.            end
  237.          { typed files are all equal to the abstract file type
  238.          name TYPEDFILE in system.pp in is_equal in types.pas
  239.          the problem is that it sholud be also compatible to FILE
  240.          but this would leed to a problem for ASSIGN RESET and REWRITE
  241.          when trying to find the good overloaded function !!
  242.          so all file function are doubled in system.pp
  243.          this is not very beautiful !!}
  244.          else if (def_from^.deftype=filedef) and (def_to^.deftype=filedef) and
  245.             (
  246.              (
  247.               (pfiledef(def_from)^.filetype = ft_typed) and
  248.               (pfiledef(def_to)^.filetype = ft_typed) and
  249.               (
  250.                (pfiledef(def_from)^.typed_as = pdef(voiddef)) or
  251.                (pfiledef(def_to)^.typed_as = pdef(voiddef))
  252.               )
  253.              ) or
  254.              (
  255.               (
  256.                (pfiledef(def_from)^.filetype = ft_untyped) and
  257.                (pfiledef(def_to)^.filetype = ft_typed)
  258.               ) or
  259.               (
  260.                (pfiledef(def_from)^.filetype = ft_typed) and
  261.                (pfiledef(def_to)^.filetype = ft_untyped)
  262.               )
  263.              )
  264.             ) then
  265.            begin
  266.               doconv:=tc_equal;
  267.               b:=true;
  268.            end
  269.          { object pascal objects }
  270.          else if (def_from^.deftype=objectdef) and (def_to^.deftype=objectdef) and
  271.            pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass then
  272.            begin
  273.               doconv:=tc_equal;
  274.               b:=pobjectdef(def_from)^.isrelated(
  275.                 pobjectdef(def_to));
  276.            end
  277.          { class reference types }
  278.          else if (def_from^.deftype=classrefdef) and (def_from^.deftype=classrefdef) then
  279.            begin
  280.               doconv:=tc_equal;
  281.               b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
  282.                 pobjectdef(pclassrefdef(def_to)^.definition));
  283.            end
  284.  
  285.          else if (def_from^.deftype=pointerdef) and (def_to^.deftype=pointerdef) then
  286.            begin
  287.             { child class pointer can be assigned to anchestor pointers }
  288.             if (
  289.                 (ppointerdef(def_from)^.definition^.deftype=objectdef) and
  290.                 (ppointerdef(def_to)^.definition^.deftype=objectdef) and
  291.                 pobjectdef(ppointerdef(def_from)^.definition)^.isrelated(
  292.                 pobjectdef(ppointerdef(def_to)^.definition))
  293.                ) or
  294.                { all pointers can be assigned to void-pointer }
  295.                is_equal(ppointerdef(def_to)^.definition,voiddef) or
  296.                { in my opnion, is this not clean pascal }
  297.                { well, but it's handy to use, it isn't ? (FK) }
  298.                is_equal(ppointerdef(def_from)^.definition,voiddef) then
  299.                begin
  300.                   doconv:=tc_equal;
  301.                   b:=true;
  302.                end
  303.             end
  304.          else
  305.            if (def_from^.deftype=stringdef) and (def_to^.deftype=stringdef) then
  306.              begin
  307.                 doconv:=tc_string_to_string;
  308.                 b:=true;
  309.              end
  310.          else
  311.            { char to string}
  312.            if is_equal(def_from,cchardef) and
  313.              (def_to^.deftype=stringdef) then
  314.              begin
  315.                 doconv:=tc_char_to_string;
  316.                 b:=true;
  317.              end
  318.          else
  319.            { string constant to zero terminated string constant }
  320.            if (fromtreetype=stringconstn) and
  321.              (
  322.               (def_to^.deftype=pointerdef) and
  323.               is_equal(Ppointerdef(def_to)^.definition,cchardef)
  324.              ) then
  325.              begin
  326.                 doconv:=tc_cstring_charpointer;
  327.                 b:=true;
  328.              end
  329.          else
  330.            { array of char to string                                }
  331.            { the length check is done by the firstpass of this node }
  332.            if (def_from^.deftype=stringdef) and
  333.              (
  334.               (def_to^.deftype=arraydef) and
  335.               is_equal(parraydef(def_to)^.definition,cchardef)
  336.              ) then
  337.              begin
  338.                 doconv:=tc_string_chararray;
  339.                 b:=true;
  340.              end
  341.          else
  342.            { string to array of char }
  343.            { the length check is done by the firstpass of this node }
  344.            if (
  345.                (def_from^.deftype=arraydef) and
  346.                is_equal(parraydef(def_from)^.definition,cchardef)
  347.               ) and
  348.               (def_to^.deftype=stringdef) then
  349.              begin
  350.                 doconv:=tc_chararray_2_string;
  351.                 b:=true;
  352.              end
  353.          else
  354.            if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) then
  355.              begin
  356.                 if (def_to^.deftype=pointerdef) and
  357.                   is_equal(ppointerdef(def_to)^.definition,cchardef) then
  358.                   begin
  359.                      doconv:=tc_cchar_charpointer;
  360.                      b:=true;
  361.                   end;
  362.              end
  363.          else
  364.            if (def_to^.deftype=procvardef) and (def_from^.deftype=procdef) then
  365.              begin
  366.                 def_from^.deftype:=procvardef;
  367.                 doconv:=tc_proc2procvar;
  368.                 b:=is_equal(def_from,def_to);
  369.                 def_from^.deftype:=procdef;
  370.              end
  371.          else
  372.            { nil is compatible with class instances }
  373.            if (fromtreetype=niln) and (def_to^.deftype=objectdef)
  374.              and (pobjectdef(def_to)^.isclass) then
  375.              begin
  376.                 doconv:=tc_equal;
  377.                 b:=true;
  378.              end
  379.          else
  380.            { nil is compatible with class references }
  381.            if (fromtreetype=niln) and (def_to^.deftype=classrefdef) then
  382.              begin
  383.                 doconv:=tc_equal;
  384.                 b:=true;
  385.              end
  386.          { procedure variable can be assigned to an void pointer }
  387.          { Not anymore. Use the @ operator now.}
  388.          else
  389.            if not (cs_tp_compatible in aktswitches) then
  390.              begin
  391.                 if (def_from^.deftype=procvardef) and
  392.                   (def_to^.deftype=pointerdef) and
  393.                   (ppointerdef(def_to)^.definition^.deftype=orddef) and
  394.                   (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
  395.                   begin
  396.                      doconv:=tc_equal;
  397.                      b:=true;
  398.                   end;
  399.              end;
  400.          isconvertable:=b;
  401.       end;
  402.  
  403.     procedure firsterror(var p : ptree);
  404.  
  405.       begin
  406.          p^.error:=true;
  407.          codegenerror:=true;
  408.          p^.resulttype:=generrordef;
  409.       end;
  410.  
  411.     procedure firstload(var p : ptree);
  412.  
  413.       begin
  414.          p^.location.loc:=LOC_REFERENCE;
  415.          p^.registers32:=0;
  416.          p^.registersfpu:=0;
  417.  
  418. {$ifdef SUPPORT_MMX}
  419.          p^.registersmmx:=0;
  420. {$endif SUPPORT_MMX}
  421.          clear_reference(p^.location.reference);
  422. {$ifdef TEST_FUNCRET}
  423.          if p^.symtableentry^.typ=funcretsym then
  424.            begin
  425.               putnode(p);
  426.               p:=genzeronode(funcretn);
  427.               p^.funcretprocinfo:=pprocinfo(pfuncretsym(p^.symtableentry)^.funcretprocinfo);
  428.               p^.retdef:=pfuncretsym(p^.symtableentry)^.retdef;
  429.               firstpass(p);
  430.               exit;
  431.            end;
  432. {$endif TEST_FUNCRET}
  433.          if p^.symtableentry^.typ=absolutesym then
  434.            begin
  435.               p^.resulttype:=pabsolutesym(p^.symtableentry)^.definition;
  436.               if pabsolutesym(p^.symtableentry)^.abstyp=tovar then
  437.                 p^.symtableentry:=pabsolutesym(p^.symtableentry)^.ref;
  438.               p^.symtable:=p^.symtableentry^.owner;
  439.               p^.is_absolute:=true;
  440.                    end;
  441.          case p^.symtableentry^.typ of
  442.             absolutesym :;
  443.             varsym :
  444.                 begin
  445.                    if not(p^.is_absolute) and (p^.resulttype=nil) then
  446.                      p^.resulttype:=pvarsym(p^.symtableentry)^.definition;
  447.                    if ((p^.symtable^.symtabletype=parasymtable) or
  448.                        (p^.symtable^.symtabletype=localsymtable)) and
  449.                       (lexlevel>p^.symtable^.symtablelevel) then
  450.                      begin
  451.                         { sollte sich die Variable in einem anderen Stackframe       }
  452.                         { befinden, so brauchen wir ein Register zum Dereferenceieren }
  453.                         if (p^.symtable^.symtablelevel)>0 then
  454.                           begin
  455.                              p^.registers32:=1;
  456.                              { auáerdem kann sie nicht mehr in ein Register
  457.                                geladen werden }
  458.                              pvarsym(p^.symtableentry)^.regable:=false;
  459.                           end;
  460.                      end;
  461.                    if (pvarsym(p^.symtableentry)^.varspez=vs_const) then
  462.                      p^.location.loc:=LOC_MEM;
  463.                    { we need a register for call by reference parameters }
  464.                    if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
  465.                       ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
  466.                       dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)
  467.                       ) then
  468.                      p^.registers32:=1;
  469.                    if p^.symtable^.symtabletype=withsymtable then
  470.                      p^.registers32:=1;
  471.  
  472.                    { a class variable is a pointer !!!
  473.                      yes, but we have to resolve the reference in an
  474.                      appropriate tree node (FK)
  475.  
  476.                    if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
  477.                       ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
  478.                      p^.registers32:=1;
  479.                    }
  480.  
  481.                    { count variable references }
  482.  
  483.                    if must_be_valid and p^.is_first then
  484.                      begin
  485.                      if pvarsym(p^.symtableentry)^.is_valid=2 then
  486.                        if (assigned(pvarsym(p^.symtableentry)^.owner) and assigned(aktprocsym)
  487.                        and (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
  488.                        Message1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name);
  489.                      end;
  490.                    if count_ref then
  491.                      begin
  492.                         if (p^.is_first) then
  493.                           begin
  494.                              if (pvarsym(p^.symtableentry)^.is_valid=2) then
  495.                                pvarsym(p^.symtableentry)^.is_valid:=1;
  496.                               p^.is_first:=false;
  497.                            end;
  498.                      end;
  499.                      { this will create problem with local var set by
  500.                      under_procedures
  501.                      if (assigned(pvarsym(p^.symtableentry)^.owner) and assigned(aktprocsym)
  502.                        and ((pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)
  503.                        or (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst))) then }
  504.                    if t_times<1 then
  505.                      inc(pvarsym(p^.symtableentry)^.refs)
  506.                    else
  507.                      inc(pvarsym(p^.symtableentry)^.refs,t_times);
  508.                 end;
  509.             typedconstsym :
  510.               if not p^.is_absolute then
  511.                      p^.resulttype:=ptypedconstsym(p^.symtableentry)^.definition;
  512.             procsym :
  513.                 begin
  514.                    if assigned(pprocsym(p^.symtableentry)^.definition^.nextoverloaded) then
  515.                      Message(parser_e_no_overloaded_procvars);
  516.                    p^.resulttype:=pprocsym(p^.symtableentry)^.definition;
  517.                 end;
  518.             else internalerror(3);
  519.          end;
  520.       end;
  521.  
  522.     procedure firstadd(var p : ptree);
  523.  
  524.       var
  525.          lt,rt : ttreetyp;
  526.          t : ptree;
  527.          rv,lv : longint;
  528.          rvd,lvd : {double}bestreal;
  529.          rd,ld : pdef;
  530.          concatstrings : boolean;
  531.  
  532.          { to evalute const sets }
  533.          resultset : pconstset;
  534.          i : longint;
  535.          b : boolean;
  536.          s1,s2:^string;
  537.  
  538.          { this totally forgets to set the pi_do_call flag !! }
  539.       label
  540.          no_overload;
  541.  
  542.       begin
  543.          { first do the two subtrees }
  544.          firstpass(p^.left);
  545.          firstpass(p^.right);
  546.  
  547.          if codegenerror then
  548.            exit;
  549.  
  550.          new(s1);
  551.          new(s2);
  552.          { overloaded operator ? }
  553.          if (p^.treetype=caretn) or
  554.             (p^.left^.resulttype^.deftype=recorddef) or
  555.             { <> and = are defined for classes }
  556.             ((p^.left^.resulttype^.deftype=objectdef) and
  557.              (not(pobjectdef(p^.left^.resulttype)^.isclass) or
  558.               not(p^.treetype in [equaln,unequaln])
  559.              )
  560.             ) or
  561.             (p^.right^.resulttype^.deftype=recorddef) or
  562.             { <> and = are defined for classes }
  563.             ((p^.right^.resulttype^.deftype=objectdef) and
  564.              (not(pobjectdef(p^.right^.resulttype)^.isclass) or
  565.               not(p^.treetype in [equaln,unequaln])
  566.              )
  567.             ) then
  568.            begin
  569.               {!!!!!!!!! handle paras }
  570.               case p^.treetype of
  571.                  { the nil as symtable signs firstcalln that this is
  572.                    an overloaded operator }
  573.                  addn:
  574.                    t:=gencallnode(overloaded_operators[plus],nil);
  575.                  subn:
  576.                    t:=gencallnode(overloaded_operators[minus],nil);
  577.                  muln:
  578.                    t:=gencallnode(overloaded_operators[star],nil);
  579.                  caretn:
  580.                    t:=gencallnode(overloaded_operators[caret],nil);
  581.                  slashn:
  582.                    t:=gencallnode(overloaded_operators[slash],nil);
  583.                  ltn:
  584.                    t:=gencallnode(overloaded_operators[globals.lt],nil);
  585.                  gtn:
  586.                    t:=gencallnode(overloaded_operators[gt],nil);
  587.                  lten:
  588.                    t:=gencallnode(overloaded_operators[lte],nil);
  589.                  gten:
  590.                    t:=gencallnode(overloaded_operators[gte],nil);
  591.                  equaln,unequaln :
  592.                    t:=gencallnode(overloaded_operators[equal],nil);
  593.                  else goto no_overload;
  594.               end;
  595.               { we have to convert p^.left and p^.right into
  596.                callparanodes }
  597.               t^.left:=gencallparanode(p^.left,nil);
  598.               t^.left:=gencallparanode(p^.right,t^.left);
  599.               if t^.symtableprocentry=nil then
  600.                Message(parser_e_operator_not_overloaded);
  601.               if p^.treetype=unequaln then
  602.                t:=gensinglenode(notn,t);
  603.               dispose(s1);
  604.               dispose(s2);
  605.               firstpass(t);
  606.               putnode(p);
  607.               p:=t;
  608.               exit;
  609.            end;
  610.          no_overload:
  611.          { compact consts }
  612.          lt:=p^.left^.treetype;
  613.          rt:=p^.right^.treetype;
  614.  
  615.          { convert int consts to real consts, if the }
  616.          { other operand is a real const             }
  617.          if is_constintnode(p^.left) and
  618.            (rt=realconstn) then
  619.            begin
  620.               t:=genrealconstnode(p^.left^.value);
  621.               disposetree(p^.left);
  622.               p^.left:=t;
  623.               lt:=realconstn;
  624.            end;
  625.          if is_constintnode(p^.right) and
  626.             (lt=realconstn) then
  627.            begin
  628.               t:=genrealconstnode(p^.right^.value);
  629.               disposetree(p^.right);
  630.               p^.right:=t;
  631.               rt:=realconstn;
  632.            end;
  633.  
  634.          if is_constintnode(p^.left) and
  635.            is_constintnode(p^.right) then
  636.            begin
  637.               lv:=p^.left^.value;
  638.               rv:=p^.right^.value;
  639.               case p^.treetype of
  640.                  addn:
  641.                    t:=genordinalconstnode(lv+rv,s32bitdef);
  642.                  subn:
  643.                    t:=genordinalconstnode(lv-rv,s32bitdef);
  644.                  muln:
  645.                    t:=genordinalconstnode(lv*rv,s32bitdef);
  646.                  xorn:
  647.                    t:=genordinalconstnode(lv xor rv,s32bitdef);
  648.                  orn:
  649.                    t:=genordinalconstnode(lv or rv,s32bitdef);
  650.                  andn:
  651.                    t:=genordinalconstnode(lv and rv,s32bitdef);
  652.                  ltn:
  653.                    t:=genordinalconstnode(ord(lv<rv),booldef);
  654.                  lten:
  655.                    t:=genordinalconstnode(ord(lv<=rv),booldef);
  656.                  gtn:
  657.                    t:=genordinalconstnode(ord(lv>rv),booldef);
  658.                  gten:
  659.                    t:=genordinalconstnode(ord(lv>=rv),booldef);
  660.                  equaln:
  661.                    t:=genordinalconstnode(ord(lv=rv),booldef);
  662.                  unequaln:
  663.                    t:=genordinalconstnode(ord(lv<>rv),booldef);
  664.                  slashn :
  665.                    begin
  666.                       { int/int becomes a real }
  667.                       t:=genrealconstnode(int(lv)/int(rv));
  668.                       firstpass(t);
  669.                    end;
  670.                  else
  671.                    Message(sym_e_type_mismatch);
  672.                 end;
  673.               disposetree(p);
  674.               dispose(s1);
  675.               dispose(s2);
  676.               p:=t;
  677.               exit;
  678.               end
  679.          else
  680.            { real constants }
  681.            if (lt=realconstn) and (rt=realconstn) then
  682.            begin
  683.               lvd:=p^.left^.valued;
  684.               rvd:=p^.right^.valued;
  685.               case p^.treetype of
  686.                  addn:
  687.                    t:=genrealconstnode(lvd+rvd);
  688.                  subn:
  689.                    t:=genrealconstnode(lvd-rvd);
  690.                  muln:
  691.                    t:=genrealconstnode(lvd*rvd);
  692.                  caretn:
  693.                    t:=genrealconstnode(exp(ln(lvd)*rvd));
  694.                  slashn:
  695.                    t:=genrealconstnode(lvd/rvd);
  696.                  ltn:
  697.                    t:=genordinalconstnode(ord(lvd<rvd),booldef);
  698.                  lten:
  699.                    t:=genordinalconstnode(ord(lvd<=rvd),booldef);
  700.                  gtn:
  701.                    t:=genordinalconstnode(ord(lvd>rvd),booldef);
  702.                  gten:
  703.                    t:=genordinalconstnode(ord(lvd>=rvd),booldef);
  704.                  equaln:
  705.                    t:=genordinalconstnode(ord(lvd=rvd),booldef);
  706.                  unequaln:
  707.                    t:=genordinalconstnode(ord(lvd<>rvd),booldef);
  708.                  else
  709.                    Message(sym_e_type_mismatch);
  710.               end;
  711.               disposetree(p);
  712.               p:=t;
  713.               dispose(s1);
  714.               dispose(s2);
  715.               firstpass(p);
  716.               exit;
  717.            end;
  718.          concatstrings:=false;
  719.          if (lt=ordconstn) and (rt=ordconstn) and
  720.            (p^.left^.resulttype^.deftype=orddef) and
  721.            (porddef(p^.left^.resulttype)^.typ=uchar) and
  722.            (p^.right^.resulttype^.deftype=orddef) and
  723.            (porddef(p^.right^.resulttype)^.typ=uchar) then
  724.            begin
  725.               s1^:=char(byte(p^.left^.value));
  726.               s2^:=char(byte(p^.right^.value));
  727.               concatstrings:=true;
  728.            end
  729.          else if (lt=stringconstn) and (rt=ordconstn) and
  730.            (p^.right^.resulttype^.deftype=orddef) and
  731.            (porddef(p^.right^.resulttype)^.typ=uchar) then
  732.            begin
  733.               s1^:=Pstring(p^.left^.value)^;
  734.               s2^:=char(byte(p^.right^.value));
  735.               concatstrings:=true;
  736.            end
  737.          else if (lt=ordconstn) and (rt=stringconstn) and
  738.            (p^.left^.resulttype^.deftype=orddef) and
  739.            (porddef(p^.left^.resulttype)^.typ=uchar) then
  740.            begin
  741.               s1^:=char(byte(p^.left^.value));
  742.               s2^:=pstring(p^.right^.value)^;
  743.               concatstrings:=true;
  744.            end
  745.          else if (lt=stringconstn) and (rt=stringconstn) then
  746.            begin
  747.               s1^:=pstring(p^.left^.value)^;
  748.               s2^:=pstring(p^.right^.value)^;
  749.               concatstrings:=true;
  750.            end;
  751.  
  752.          if concatstrings then
  753.            begin
  754.               case p^.treetype of
  755.                  addn : t:=genstringconstnode(s1^+s2^);
  756.                  ltn : t:=genordinalconstnode(byte(s1^<s2^),booldef);
  757.                  lten : t:=genordinalconstnode(byte(s1^<=s2^),booldef);
  758.                  gtn : t:=genordinalconstnode(byte(s1^>s2^),booldef);
  759.                  gten : t:=genordinalconstnode(byte(s1^>=s2^),booldef);
  760.                  equaln : t:=genordinalconstnode(byte(s1^=s2^),booldef);
  761.                  unequaln : t:=genordinalconstnode(byte(s1^<>s2^),booldef);
  762.               end;
  763.               dispose(s1);
  764.               dispose(s2);
  765.               disposetree(p);
  766.               p:=t;
  767.               exit;
  768.            end;
  769.          rd:=p^.right^.resulttype;
  770.          ld:=p^.left^.resulttype;
  771.          dispose(s1);
  772.          dispose(s2);
  773.  
  774.          { we can set this globally but it not allways true }
  775.          { procinfo.flags:=procinfo.flags or pi_do_call;    }
  776.  
  777.          { if both are boolean: }
  778.          if ((ld^.deftype=orddef) and
  779.             (porddef(ld)^.typ=bool8bit)) and
  780.             ((rd^.deftype=orddef) and
  781.             (porddef(rd)^.typ=bool8bit)) then
  782.            begin
  783.               if (p^.treetype=andn) or (p^.treetype=orn) then
  784.                 begin
  785.                    calcregisters(p,0,0,0);
  786.                    p^.location.loc:=LOC_JUMP;
  787.                 end
  788.               else if p^.treetype in [unequaln,equaln,xorn] then
  789.                 begin
  790.                    { I'am not very content with this solution, but it's
  791.                      a working hack    (FK)                             }
  792.                    p^.left:=gentypeconvnode(p^.left,u8bitdef);
  793.                    p^.right:=gentypeconvnode(p^.right,u8bitdef);
  794.                    p^.left^.convtyp:=tc_bool_2_u8bit;
  795.                    p^.left^.explizit:=true;
  796.                    firstpass(p^.left);
  797.                    p^.left^.resulttype:=booldef;
  798.                    p^.right^.convtyp:=tc_bool_2_u8bit;
  799.                    p^.right^.explizit:=true;
  800.                    firstpass(p^.right);
  801.                    p^.right^.resulttype:=booldef;
  802.                    calcregisters(p,1,0,0);
  803.                    { is done commonly for all data types
  804.                    p^.location.loc:=LOC_FLAGS;
  805.                    p^.resulttype:=booldef;
  806.                    }
  807.                 end
  808.               else Message(sym_e_type_mismatch);
  809.            end
  810.          { wenn beides vom Char dann keine Konvertiereung einfgen }
  811.          { h”chstens es handelt sich um einen +-Operator           }
  812.          else if ((rd^.deftype=orddef) and (porddef(rd)^.typ=uchar)) and
  813.             ((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar)) then
  814.             begin
  815.                if p^.treetype=addn then
  816.                  begin
  817.                     p^.left:=gentypeconvnode(p^.left,cstringdef);
  818.                     firstpass(p^.left);
  819.                     p^.right:=gentypeconvnode(p^.right,cstringdef);
  820.                     firstpass(p^.right);
  821.                     { here we call STRCOPY }
  822.                     procinfo.flags:=procinfo.flags or pi_do_call;
  823.                     calcregisters(p,0,0,0);
  824.                     p^.location.loc:=LOC_MEM;
  825.                  end
  826.                else
  827.                 calcregisters(p,1,0,0);
  828.             end
  829.          { if string and character, then conver the character to a string }
  830.          else if ((rd^.deftype=stringdef) and
  831.                  ((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar))) or
  832.                  ((ld^.deftype=stringdef) and
  833.                  ((rd^.deftype=orddef) and (porddef(rd)^.typ=uchar))) then
  834.            begin
  835.               if ((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar)) then
  836.                 p^.left:=gentypeconvnode(p^.left,cstringdef)
  837.               else
  838.                 p^.right:=gentypeconvnode(p^.right,cstringdef);
  839.               firstpass(p^.left);
  840.               firstpass(p^.right);
  841.               { here we call STRCONCAT or STRCMP }
  842.               procinfo.flags:=procinfo.flags or pi_do_call;
  843.               calcregisters(p,0,0,0);
  844.               p^.location.loc:=LOC_MEM;
  845.            end
  846.          else
  847.            if ((rd^.deftype=setdef) and (ld^.deftype=setdef)) then
  848.              begin
  849.                 case p^.treetype of
  850.                    subn,symdifn,addn,muln,equaln,unequaln : ;
  851.                    else Message(sym_e_type_mismatch);
  852.                 end;
  853.                 if not(is_equal(rd,ld)) then
  854.                  Message(sym_e_set_element_are_not_comp);
  855.                 firstpass(p^.left);
  856.                 firstpass(p^.right);
  857.                 { do constant evalution }
  858.                 { set constructor ? }
  859.                 if (p^.right^.treetype=setconstrn) and
  860.                   (p^.left^.treetype=setconstrn) and
  861.                   { and no variables ? }
  862.                   (p^.right^.left=nil) and
  863.                   (p^.left^.left=nil) then
  864.                   begin
  865.                      new(resultset);
  866.                      case p^.treetype of
  867.                         addn : begin
  868.                                   for i:=0 to 31 do
  869.                                     resultset^[i]:=
  870.                                       p^.right^.constset^[i] or p^.left^.constset^[i];
  871.                                   t:=gensetconstruktnode(resultset,psetdef(ld));
  872.                                end;
  873.                         muln : begin
  874.                                   for i:=0 to 31 do
  875.                                     resultset^[i]:=
  876.                                       p^.right^.constset^[i] and p^.left^.constset^[i];
  877.                                   t:=gensetconstruktnode(resultset,psetdef(ld));
  878.                                end;
  879.                         subn : begin
  880.                                   for i:=0 to 31 do
  881.                                     resultset^[i]:=
  882.                                       p^.left^.constset^[i] and not(p^.right^.constset^[i]);
  883.                                   t:=gensetconstruktnode(resultset,psetdef(ld));
  884.                                end;
  885.                         symdifn : begin
  886.                                   for i:=0 to 31 do
  887.                                     resultset^[i]:=
  888.                                       p^.left^.constset^[i] xor p^.right^.constset^[i];
  889.                                   t:=gensetconstruktnode(resultset,psetdef(ld));
  890.                                end;
  891.                         unequaln : begin
  892.                                       b:=true;
  893.                                       for i:=0 to 31 do
  894.                                         if p^.right^.constset^[i]=p^.left^.constset^[i] then
  895.                                           begin
  896.                                              b:=false;
  897.                                              break;
  898.                                           end;
  899.                                       t:=genordinalconstnode(ord(b),booldef);
  900.                                    end;
  901.                         equaln : begin
  902.                                     b:=true;
  903.                                     for i:=0 to 31 do
  904.                                       if p^.right^.constset^[i]<>p^.left^.constset^[i] then
  905.                                         begin
  906.                                            b:=false;
  907.                                            break;
  908.                                         end;
  909.                                      t:=genordinalconstnode(ord(b),booldef);
  910.                                   end;
  911.                      end;
  912.                      dispose(resultset);
  913.                      disposetree(p);
  914.                      p:=t;
  915.                      firstpass(p);
  916.                      exit;
  917.                   end
  918.                 else if psetdef(rd)^.settype=smallset then
  919.                   begin
  920.                      calcregisters(p,1,0,0);
  921.                      p^.location.loc:=LOC_REGISTER;
  922.                   end
  923.                 else
  924.                   begin
  925.                      calcregisters(p,0,0,0);
  926.                      { here we call SET... }
  927.                      procinfo.flags:=procinfo.flags or pi_do_call;
  928.                      p^.location.loc:=LOC_MEM;
  929.                   end;
  930.              end
  931.          else
  932.            if ((rd^.deftype=stringdef) and (ld^.deftype=stringdef)) then
  933.              { here we call STR... }
  934.              procinfo.flags:=procinfo.flags or pi_do_call
  935.          { if there is a real float, convert both to float 80 bit }
  936.          else
  937.          if ((rd^.deftype=floatdef) and (pfloatdef(rd)^.typ<>f32bit)) or
  938.            ((ld^.deftype=floatdef) and (pfloatdef(ld)^.typ<>f32bit)) then
  939.            begin
  940.               p^.right:=gentypeconvnode(p^.right,c64floatdef);
  941.               p^.left:=gentypeconvnode(p^.left,c64floatdef);
  942.               firstpass(p^.left);
  943.               firstpass(p^.right);
  944.               calcregisters(p,1,1,0);
  945.               p^.location.loc:=LOC_FPU;
  946.            end
  947.          else
  948.           { if there is one fix comma number, convert both to 32 bit fixcomma }
  949.            if ((rd^.deftype=floatdef) and (pfloatdef(rd)^.typ=f32bit)) or
  950.              ((ld^.deftype=floatdef) and (pfloatdef(ld)^.typ=f32bit)) then
  951.             begin
  952.                if not(porddef(rd)^.typ in [u8bit,s8bit,u16bit,
  953.                  s16bit,s32bit]) or (p^.treetype<>muln) then
  954.                    p^.right:=gentypeconvnode(p^.right,s32fixeddef);
  955.  
  956.                if not(porddef(rd)^.typ in [u8bit,s8bit,u16bit,
  957.                  s16bit,s32bit]) or (p^.treetype<>muln) then
  958.                p^.left:=gentypeconvnode(p^.left,s32fixeddef);
  959.  
  960.                firstpass(p^.left);
  961.                firstpass(p^.right);
  962.                calcregisters(p,1,0,0);
  963.                p^.location.loc:=LOC_REGISTER;
  964.             end
  965.          { pointer comperation and subtraction }
  966.          else if (rd^.deftype=pointerdef) and (ld^.deftype=pointerdef) then
  967.            begin
  968.               p^.location.loc:=LOC_REGISTER;
  969.               p^.right:=gentypeconvnode(p^.right,ld);
  970.               firstpass(p^.right);
  971.               calcregisters(p,1,0,0);
  972.               case p^.treetype of
  973.                  equaln,unequaln : ;
  974.                  ltn,lten,gtn,gten:
  975.                    begin
  976.                       if not(cs_extsyntax in aktswitches) then
  977.                         Message(sym_e_type_mismatch);
  978.                    end;
  979.                  subn:
  980.                    begin
  981.                       if not(cs_extsyntax in aktswitches) then
  982.                         Message(sym_e_type_mismatch);
  983.                       p^.resulttype:=s32bitdef;
  984.                       exit;
  985.                    end;
  986.                  else Message(sym_e_type_mismatch);
  987.               end;
  988.            end
  989.          else if (rd^.deftype=objectdef) and (ld^.deftype=objectdef) and
  990.            pobjectdef(rd)^.isclass and pobjectdef(ld)^.isclass then
  991.            begin
  992.               p^.location.loc:=LOC_REGISTER;
  993.               if pobjectdef(rd)^.isrelated(pobjectdef(ld)) then
  994.                 p^.right:=gentypeconvnode(p^.right,ld)
  995.               else
  996.                 p^.left:=gentypeconvnode(p^.left,rd);
  997.               firstpass(p^.right);
  998.               firstpass(p^.left);
  999.               calcregisters(p,1,0,0);
  1000.               case p^.treetype of
  1001.                  equaln,unequaln : ;
  1002.                  else Message(sym_e_type_mismatch);
  1003.               end;
  1004.            end
  1005.          else if (rd^.deftype=classrefdef) and (ld^.deftype=classrefdef) then
  1006.            begin
  1007.               p^.location.loc:=LOC_REGISTER;
  1008.               if pobjectdef(pclassrefdef(rd)^.definition)^.isrelated(pobjectdef(
  1009.                 pclassrefdef(ld)^.definition)) then
  1010.                 p^.right:=gentypeconvnode(p^.right,ld)
  1011.               else
  1012.                 p^.left:=gentypeconvnode(p^.left,rd);
  1013.               firstpass(p^.right);
  1014.               firstpass(p^.left);
  1015.               calcregisters(p,1,0,0);
  1016.               case p^.treetype of
  1017.                  equaln,unequaln : ;
  1018.                  else Message(sym_e_type_mismatch);
  1019.               end;
  1020.            end
  1021.  
  1022.          { allows comperasion with nil pointer }
  1023.          else if (rd^.deftype=objectdef) and
  1024.            pobjectdef(rd)^.isclass then
  1025.            begin
  1026.               p^.location.loc:=LOC_REGISTER;
  1027.               p^.left:=gentypeconvnode(p^.left,rd);
  1028.               firstpass(p^.left);
  1029.               calcregisters(p,1,0,0);
  1030.               case p^.treetype of
  1031.                  equaln,unequaln : ;
  1032.                  else Message(sym_e_type_mismatch);
  1033.               end;
  1034.            end
  1035.          else if (ld^.deftype=objectdef) and
  1036.            pobjectdef(ld)^.isclass then
  1037.            begin
  1038.               p^.location.loc:=LOC_REGISTER;
  1039.               p^.right:=gentypeconvnode(p^.right,ld);
  1040.               firstpass(p^.right);
  1041.               calcregisters(p,1,0,0);
  1042.               case p^.treetype of
  1043.                  equaln,unequaln : ;
  1044.                  else Message(sym_e_type_mismatch);
  1045.               end;
  1046.            end
  1047.          else if (rd^.deftype=classrefdef) then
  1048.            begin
  1049.               p^.left:=gentypeconvnode(p^.left,rd);
  1050.               firstpass(p^.left);
  1051.               calcregisters(p,1,0,0);
  1052.               case p^.treetype of
  1053.                  equaln,unequaln : ;
  1054.                  else Message(sym_e_type_mismatch);
  1055.               end;
  1056.            end
  1057.          else if (ld^.deftype=classrefdef) then
  1058.            begin
  1059.               p^.right:=gentypeconvnode(p^.right,ld);
  1060.               firstpass(p^.right);
  1061.               calcregisters(p,1,0,0);
  1062.               case p^.treetype of
  1063.                  equaln,unequaln : ;
  1064.                  else Message(sym_e_type_mismatch);
  1065.               end;
  1066.            end
  1067.  
  1068.          else if (rd^.deftype=pointerdef) then
  1069.            begin
  1070.               p^.location.loc:=LOC_REGISTER;
  1071.               p^.left:=gentypeconvnode(p^.left,s32bitdef);
  1072.               firstpass(p^.left);
  1073.               calcregisters(p,1,0,0);
  1074.               if p^.treetype=addn then
  1075.                 begin
  1076.                    if not(cs_extsyntax in aktswitches) then
  1077.                      Message(sym_e_type_mismatch);
  1078.                 end
  1079.               else Message(sym_e_type_mismatch);
  1080.            end
  1081.          else if (ld^.deftype=pointerdef) then
  1082.            begin
  1083.               p^.location.loc:=LOC_REGISTER;
  1084.               p^.right:=gentypeconvnode(p^.right,s32bitdef);
  1085.               firstpass(p^.right);
  1086.               calcregisters(p,1,0,0);
  1087.               case p^.treetype of
  1088.                  addn,subn : if not(cs_extsyntax in aktswitches) then
  1089.                                Message(sym_e_type_mismatch);
  1090.                  else Message(sym_e_type_mismatch);
  1091.               end;
  1092.            end
  1093.          else if (rd^.deftype=procvardef) and (ld^.deftype=procvardef) and
  1094.            is_equal(rd,ld) then
  1095.            begin
  1096.               calcregisters(p,1,0,0);
  1097.               p^.location.loc:=LOC_REGISTER;
  1098.               case p^.treetype of
  1099.                  equaln,unequaln : ;
  1100.                  else Message(sym_e_type_mismatch);
  1101.               end;
  1102.            end
  1103.          else if (ld^.deftype=enumdef) and (rd^.deftype=enumdef)
  1104.             and (is_equal(ld,rd)) then
  1105.            begin
  1106.               calcregisters(p,1,0,0);
  1107.               case p^.treetype of
  1108.                  equaln,unequaln,
  1109.                  ltn,lten,gtn,gten : ;
  1110.                  else Message(sym_e_type_mismatch);
  1111.               end;
  1112.            end
  1113. {$ifdef SUPPORT_MMX}
  1114.          else if (cs_mmx in aktswitches) and is_mmx_able_array(ld)
  1115.            and is_mmx_able_array(rd) and is_equal(ld,rd) then
  1116.            begin
  1117.               firstpass(p^.right);
  1118.               firstpass(p^.left);
  1119.               case p^.treetype of
  1120.                 addn,subn,xorn,orn,andn:
  1121.                   ;
  1122.                 { mul is a little bit restricted }
  1123.                 muln:
  1124.                   if not(mmx_type(p^.left^.resulttype) in
  1125.                     [mmxu16bit,mmxs16bit,mmxfixed16]) then
  1126.                     Message(sym_e_type_mismatch);
  1127.                 else
  1128.                   Message(sym_e_type_mismatch);
  1129.               end;
  1130.               p^.location.loc:=LOC_MMXREGISTER;
  1131.               calcregisters(p,0,0,1);
  1132.        end
  1133. {$endif SUPPORT_MMX}
  1134.          { the general solution is to convert to 32 bit int }
  1135.          else
  1136.            begin
  1137.               { but an int/int gives real/real! }
  1138.               if p^.treetype=slashn then
  1139.                 begin
  1140.                    Message(parser_w_use_int_div_int_op);
  1141.                    p^.right:=gentypeconvnode(p^.right,c64floatdef);
  1142.                    p^.left:=gentypeconvnode(p^.left,c64floatdef);
  1143.                    firstpass(p^.left);
  1144.                    firstpass(p^.right);
  1145.                    { maybe we need an integer register to save }
  1146.                    { a reference                               }
  1147.                    if ((p^.left^.location.loc<>LOC_FPU) or
  1148.                        (p^.right^.location.loc<>LOC_FPU)) and
  1149.                        (p^.left^.registers32=p^.right^.registers32) then
  1150.                      calcregisters(p,1,1,0)
  1151.                    else
  1152.                      calcregisters(p,0,1,0);
  1153.                    p^.location.loc:=LOC_FPU;
  1154.                 end
  1155.               else
  1156.                 begin
  1157.                    p^.right:=gentypeconvnode(p^.right,s32bitdef);
  1158.                    p^.left:=gentypeconvnode(p^.left,s32bitdef);
  1159.                    firstpass(p^.left);
  1160.                    firstpass(p^.right);
  1161.                    calcregisters(p,1,0,0);
  1162.                    p^.location.loc:=LOC_REGISTER;
  1163.                 end;
  1164.            end;
  1165.  
  1166.          if codegenerror then
  1167.            exit;
  1168.  
  1169.          { determines result type for comparions }
  1170.          case p^.treetype of
  1171.             ltn,lten,gtn,gten,equaln,unequaln:
  1172.               begin
  1173.                  p^.resulttype:=booldef;
  1174.                  p^.location.loc:=LOC_FLAGS;
  1175.               end;
  1176.             addn:
  1177.               begin
  1178.                  { the result of a string addition is a string of length 255 }
  1179.                  if (p^.left^.resulttype^.deftype=stringdef) or
  1180.                     (p^.right^.resulttype^.deftype=stringdef) then
  1181.                    p^.resulttype:=cstringdef
  1182.                  else
  1183.                    p^.resulttype:=p^.left^.resulttype;
  1184.               end;
  1185.             else p^.resulttype:=p^.left^.resulttype;
  1186.          end;
  1187.       end;
  1188.  
  1189.     procedure firstmoddiv(var p : ptree);
  1190.  
  1191.       var
  1192.          t : ptree;
  1193.          {power : longint; }
  1194.  
  1195.       begin
  1196.          firstpass(p^.left);
  1197.          firstpass(p^.right);
  1198.  
  1199.          if codegenerror then
  1200.            exit;
  1201.  
  1202.          if is_constintnode(p^.left) and is_constintnode(p^.right) then
  1203.            begin
  1204.               case p^.treetype of
  1205.                  modn : t:=genordinalconstnode(p^.left^.value mod p^.right^.value,s32bitdef);
  1206.                  divn : t:=genordinalconstnode(p^.left^.value div p^.right^.value,s32bitdef);
  1207.               end;
  1208.               disposetree(p);
  1209.               p:=t;
  1210.               exit;
  1211.            end;
  1212.          { !!!!!! u32bit }
  1213.          p^.right:=gentypeconvnode(p^.right,s32bitdef);
  1214.          p^.left:=gentypeconvnode(p^.left,s32bitdef);
  1215.          firstpass(p^.left);
  1216.          firstpass(p^.right);
  1217.  
  1218.          if codegenerror then
  1219.            exit;
  1220.  
  1221.          p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  1222.          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  1223. {$ifdef SUPPORT_MMX}
  1224.          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  1225. {$endif SUPPORT_MMX}
  1226.          if p^.registers32<2 then p^.registers32:=2;
  1227.  
  1228.          p^.resulttype:=s32bitdef;
  1229.          p^.location.loc:=LOC_REGISTER;
  1230.       end;
  1231.  
  1232.     procedure firstshlshr(var p : ptree);
  1233.  
  1234.       var
  1235.          t : ptree;
  1236.  
  1237.       begin
  1238.          firstpass(p^.left);
  1239.          firstpass(p^.right);
  1240.  
  1241.          if codegenerror then
  1242.            exit;
  1243.  
  1244.          if is_constintnode(p^.left) and is_constintnode(p^.right) then
  1245.            begin
  1246.               case p^.treetype of
  1247.                  shrn : t:=genordinalconstnode(p^.left^.value shr p^.right^.value,s32bitdef);
  1248.                  shln : t:=genordinalconstnode(p^.left^.value shl p^.right^.value,s32bitdef);
  1249.               end;
  1250.               disposetree(p);
  1251.               p:=t;
  1252.               exit;
  1253.            end;
  1254.          p^.right:=gentypeconvnode(p^.right,s32bitdef);
  1255.          p^.left:=gentypeconvnode(p^.left,s32bitdef);
  1256.          firstpass(p^.left);
  1257.          firstpass(p^.right);
  1258.  
  1259.          if codegenerror then
  1260.            exit;
  1261.  
  1262.          calcregisters(p,2,0,0);
  1263.          {
  1264.          p^.registers32:=p^.left^.registers32;
  1265.  
  1266.          if p^.registers32<p^.right^.registers32 then
  1267.            p^.registers32:=p^.right^.registers32;
  1268.          if p^.registers32<1 then p^.registers32:=1;
  1269.          }
  1270.          p^.resulttype:=s32bitdef;
  1271.          p^.location.loc:=LOC_REGISTER;
  1272.       end;
  1273.  
  1274.     procedure firstrealconst(var p : ptree);
  1275.  
  1276.       begin
  1277.          p^.location.loc:=LOC_MEM;
  1278.       end;
  1279.  
  1280.     procedure firstfixconst(var p : ptree);
  1281.  
  1282.       begin
  1283.          p^.location.loc:=LOC_MEM;
  1284.       end;
  1285.  
  1286.     procedure firstordconst(var p : ptree);
  1287.  
  1288.       begin
  1289.          p^.location.loc:=LOC_MEM;
  1290.       end;
  1291.  
  1292.     procedure firstniln(var p : ptree);
  1293.  
  1294.       begin
  1295.          p^.resulttype:=voidpointerdef;
  1296.          p^.location.loc:=LOC_MEM;
  1297.       end;
  1298.  
  1299.     procedure firststringconst(var p : ptree);
  1300.  
  1301.       begin
  1302. {$ifdef GDB}
  1303.          {why this !!! lost of dummy type definitions
  1304.          one per const string !!!
  1305.          p^.resulttype:=new(pstringdef,init(length(p^.values^)));}
  1306.          p^.resulttype:=cstringdef;
  1307. {$Else GDB}
  1308.          p^.resulttype:=new(pstringdef,init(length(p^.values^)));
  1309. {$endif * GDB *}
  1310.          p^.location.loc:=LOC_MEM;
  1311.       end;
  1312.  
  1313.     procedure firstumminus(var p : ptree);
  1314.  
  1315.       var
  1316.          t : ptree;
  1317.          minusdef : pprocdef;
  1318.  
  1319.       begin
  1320.          firstpass(p^.left);
  1321.          p^.registers32:=p^.left^.registers32;
  1322.          p^.registersfpu:=p^.left^.registersfpu;
  1323. {$ifdef SUPPORT_MMX}
  1324.          p^.registersmmx:=p^.left^.registersmmx;
  1325. {$endif SUPPORT_MMX}
  1326.          p^.resulttype:=p^.left^.resulttype;
  1327.          if codegenerror then
  1328.            exit;
  1329.          if is_constintnode(p^.left) then
  1330.            begin
  1331.               t:=genordinalconstnode(-p^.left^.value,s32bitdef);
  1332.               disposetree(p);
  1333.               firstpass(t);
  1334.               p:=t;
  1335.               exit;
  1336.            end;
  1337.            { nasm can not cope with negativ reals !! }
  1338.          if is_constrealnode(p^.left)
  1339. {$ifdef i386}
  1340.          and (current_module^.output_format<>of_nasm)
  1341. {$endif}
  1342.            then
  1343.            begin
  1344.               t:=genrealconstnode(-p^.left^.valued);
  1345.               disposetree(p);
  1346.               firstpass(t);
  1347.               p:=t;
  1348.               exit;
  1349.            end;
  1350.          if (p^.left^.resulttype^.deftype=floatdef) then
  1351.            begin
  1352.               if pfloatdef(p^.left^.resulttype)^.typ=f32bit then
  1353.                 begin
  1354.                    if (p^.left^.location.loc<>LOC_REGISTER) and
  1355.                      (p^.registers32<1) then
  1356.                      p^.registers32:=1;
  1357.                    p^.location.loc:=LOC_REGISTER;
  1358.                 end
  1359.               else
  1360.                 p^.location.loc:=LOC_FPU;
  1361.            end
  1362. {$ifdef SUPPORT_MMX}
  1363.          else if (cs_mmx in aktswitches) and
  1364.            is_mmx_able_array(p^.left^.resulttype) then
  1365.              begin
  1366.                if (p^.left^.location.loc<>LOC_MMXREGISTER) and
  1367.                  (p^.registersmmx<1) then
  1368.                  p^.registersmmx:=1;
  1369.                { if saturation is on, p^.left^.resulttype isn't
  1370.                  "mmx able" (FK)
  1371.                if (cs_mmx_saturation in aktswitches^) and
  1372.                  (porddef(parraydef(p^.resulttype)^.definition)^.typ in
  1373.                  [s32bit,u32bit]) then
  1374.                  Message(sym_e_type_mismatch);
  1375.                }
  1376.              end
  1377. {$endif SUPPORT_MMX}
  1378.          else if (p^.left^.resulttype^.deftype=orddef) then
  1379.            begin
  1380.               p^.left:=gentypeconvnode(p^.left,s32bitdef);
  1381.               firstpass(p^.left);
  1382.               p^.registersfpu:=p^.left^.registersfpu;
  1383. {$ifdef SUPPORT_MMX}
  1384.               p^.registersmmx:=p^.left^.registersmmx;
  1385. {$endif SUPPORT_MMX}
  1386.               p^.registers32:=p^.left^.registers32;
  1387.               if codegenerror then
  1388.                 exit;
  1389.               if (p^.left^.location.loc<>LOC_REGISTER) and
  1390.                 (p^.registers32<1) then
  1391.               p^.registers32:=1;
  1392.               p^.location.loc:=LOC_REGISTER;
  1393.               p^.resulttype:=p^.left^.resulttype;
  1394.            end
  1395.          else
  1396.            begin
  1397.               if assigned(overloaded_operators[minus]) then
  1398.                 minusdef:=overloaded_operators[minus]^.definition
  1399.               else
  1400.                 minusdef:=nil;
  1401.               while assigned(minusdef) do
  1402.                 begin
  1403.                    if (minusdef^.para1^.data=p^.left^.resulttype) and
  1404.                      (minusdef^.para1^.next=nil) then
  1405.                      begin
  1406.                         t:=gencallnode(overloaded_operators[minus],nil);
  1407.                         t^.left:=gencallparanode(p^.left,nil);
  1408.                         putnode(p);
  1409.                         p:=t;
  1410.                         firstpass(p);
  1411.                         exit;
  1412.                      end;
  1413.                    minusdef:=minusdef^.nextoverloaded;
  1414.                 end;
  1415.               Message(sym_e_type_mismatch);
  1416.            end;
  1417.       end;
  1418.  
  1419.     procedure firstaddr(var p : ptree);
  1420.  
  1421.       var
  1422.          hp  : ptree;
  1423.          hp2 : pdefcoll;
  1424.          store_valid : boolean;
  1425.  
  1426.       begin
  1427.          make_not_regable(p^.left);
  1428.          if not(assigned(p^.resulttype)) then
  1429.            begin
  1430.               if p^.left^.treetype=calln then
  1431.                 begin
  1432.                      { it could also be a procvar, not only pprocsym ! }
  1433.                      if p^.left^.symtableprocentry^.typ=varsym then
  1434.                         hp:=genloadnode(pvarsym(p^.left^.symtableprocentry),p^.left^.symtableproc)
  1435.                      else
  1436.                         hp:=genloadcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc);
  1437.                    { result is a procedure variable }
  1438.                    { No, to be TP compatible, you must return a pointer to
  1439.                      the procedure that is stored in the procvar.}
  1440.                    if not(cs_tp_compatible in aktswitches) then
  1441.                      begin
  1442.                         p^.resulttype:=new(pprocvardef,init);
  1443.  
  1444.                         pprocvardef(p^.resulttype)^.options:=
  1445.                           p^.left^.symtableprocentry^.definition^.options;
  1446.  
  1447.                         pprocvardef(p^.resulttype)^.retdef:=
  1448.                           p^.left^.symtableprocentry^.definition^.retdef;
  1449.  
  1450.                         hp2:=p^.left^.symtableprocentry^.definition^.para1;
  1451.                         while assigned(hp2) do
  1452.                           begin
  1453.                              pprocvardef(p^.resulttype)^.concatdef(hp2^.data,hp2^.paratyp);
  1454.                              hp2:=hp2^.next;
  1455.                           end;
  1456.                      end
  1457.                    else
  1458.                      p^.resulttype:=voidpointerdef;
  1459.  
  1460.                    disposetree(p^.left);
  1461.                    p^.left:=hp;
  1462.                 end
  1463.               else
  1464.                 begin
  1465.                   if not(cs_typed_addresses in aktswitches) then
  1466.                     p^.resulttype:=voidpointerdef
  1467.                   else p^.resulttype:=new(ppointerdef,init(p^.left^.resulttype));
  1468.                 end;
  1469.            end;
  1470.          store_valid:=must_be_valid;
  1471.          must_be_valid:=false;
  1472.          firstpass(p^.left);
  1473.          must_be_valid:=store_valid;
  1474.          if codegenerror then
  1475.            exit;
  1476.  
  1477.          { we should allow loc_mem for @string }
  1478.          if (p^.left^.location.loc<>LOC_REFERENCE) and
  1479.             (p^.left^.location.loc<>LOC_MEM) then
  1480.            Message(cg_e_illegal_expression);
  1481.  
  1482.          p^.registers32:=p^.left^.registers32;
  1483.          p^.registersfpu:=p^.left^.registersfpu;
  1484. {$ifdef SUPPORT_MMX}
  1485.          p^.registersmmx:=p^.left^.registersmmx;
  1486. {$endif SUPPORT_MMX}
  1487.          if p^.registers32<1 then
  1488.            p^.registers32:=1;
  1489.          p^.location.loc:=LOC_REGISTER;
  1490.       end;
  1491.  
  1492.     procedure firstdoubleaddr(var p : ptree);
  1493.  
  1494.       var
  1495.          hp  : ptree;
  1496.          hp2 : pdefcoll;
  1497.  
  1498.       begin
  1499.          make_not_regable(p^.left);
  1500.          firstpass(p^.left);
  1501.          if p^.resulttype=nil then
  1502.                 p^.resulttype:=voidpointerdef;
  1503.          if (p^.left^.resulttype^.deftype)<>procvardef then
  1504.                 Message(cg_e_illegal_expression);
  1505.  
  1506.          if codegenerror then
  1507.            exit;
  1508.  
  1509.          if (p^.left^.location.loc<>LOC_REFERENCE) then
  1510.            Message(cg_e_illegal_expression);
  1511.  
  1512.          p^.registers32:=p^.left^.registers32;
  1513.          p^.registersfpu:=p^.left^.registersfpu;
  1514. {$ifdef SUPPORT_MMX}
  1515.          p^.registersmmx:=p^.left^.registersmmx;
  1516. {$endif SUPPORT_MMX}
  1517.          if p^.registers32<1 then
  1518.            p^.registers32:=1;
  1519.          p^.location.loc:=LOC_REGISTER;
  1520.       end;
  1521.  
  1522.     procedure firstnot(var p : ptree);
  1523.  
  1524.       var
  1525.          t : ptree;
  1526.  
  1527.       begin
  1528.          firstpass(p^.left);
  1529.  
  1530.          if codegenerror then
  1531.            exit;
  1532.  
  1533.          if (p^.left^.treetype=ordconstn) then
  1534.            begin
  1535.               t:=genordinalconstnode(not(p^.left^.value),p^.left^.resulttype);
  1536.               disposetree(p);
  1537.               p:=t;
  1538.               exit;
  1539.            end;
  1540.          p^.resulttype:=p^.left^.resulttype;
  1541.          p^.location.loc:=p^.left^.location.loc;
  1542. {$ifdef SUPPORT_MMX}
  1543.          p^.registersmmx:=p^.left^.registersmmx;
  1544. {$endif SUPPORT_MMX}
  1545.          if is_equal(p^.resulttype,booldef) then
  1546.            begin
  1547.               p^.registers32:=p^.left^.registers32;
  1548.               if ((p^.location.loc=LOC_REFERENCE) or
  1549.                 (p^.location.loc=LOC_CREGISTER)) and
  1550.                 (p^.registers32<1) then
  1551.                 p^.registers32:=1;
  1552.            end
  1553.          else
  1554. {$ifdef SUPPORT_MMX}
  1555.            if (cs_mmx in aktswitches) and
  1556.              is_mmx_able_array(p^.left^.resulttype) then
  1557.              begin
  1558.                if (p^.left^.location.loc<>LOC_MMXREGISTER) and
  1559.                  (p^.registersmmx<1) then
  1560.                  p^.registersmmx:=1;
  1561.              end
  1562.          else
  1563. {$endif SUPPORT_MMX}
  1564.            begin
  1565.               p^.left:=gentypeconvnode(p^.left,s32bitdef);
  1566.               firstpass(p^.left);
  1567.  
  1568.               if codegenerror then
  1569.                 exit;
  1570.  
  1571.               p^.resulttype:=p^.left^.resulttype;
  1572.               p^.registers32:=p^.left^.registers32;
  1573. {$ifdef SUPPORT_MMX}
  1574.               p^.registersmmx:=p^.left^.registersmmx;
  1575. {$endif SUPPORT_MMX}
  1576.  
  1577.               if (p^.left^.location.loc<>LOC_REGISTER) and
  1578.                 (p^.registers32<1) then
  1579.                 p^.registers32:=1;
  1580.               p^.location.loc:=LOC_REGISTER;
  1581.            end;
  1582.          p^.registersfpu:=p^.left^.registersfpu;
  1583.       end;
  1584.  
  1585.     procedure firstnothing(var p : ptree);
  1586.  
  1587.       begin
  1588.       end;
  1589.  
  1590.     procedure firstassignment(var p : ptree);
  1591.  
  1592.       var
  1593.          store_valid : boolean;
  1594.          hp : ptree;
  1595.  
  1596.       begin
  1597.          store_valid:=must_be_valid;
  1598.          must_be_valid:=false;
  1599.          firstpass(p^.left);
  1600.          { assignements to open arrays aren't allowed }
  1601.          if is_open_array(p^.left^.resulttype) then
  1602.            Message(sym_e_type_mismatch);
  1603. {$ifdef dummyi386}
  1604.          if ((p^.right^.treetype=addn) or (p^.right^.treetype=subn)) and
  1605.             equal_trees(p^.left,p^.right^.left) and
  1606.             (ret_in_acc(p^.left^.resulttype)) and
  1607.             (not cs_rangechecking in aktswitches^) then
  1608.            begin
  1609.               disposetree(p^.right^.left);
  1610.               hp:=p^.right;
  1611.               p^.right:=p^.right^.right;
  1612.               if hp^.treetype=addn then
  1613.                 p^.assigntyp:=at_plus
  1614.               else
  1615.                 p^.assigntyp:=at_minus;
  1616.               putnode(hp);
  1617.            end;
  1618.          if p^.assigntyp<>at_normal then
  1619.            begin
  1620.               { for fpu type there is no faster way }
  1621.               if is_fpu(p^.left^.resulttype) then
  1622.                 case p^.assigntyp of
  1623.                   at_plus  : p^.right:=gennode(addn,getcopy(p^.left),p^.right);
  1624.                   at_minus : p^.right:=gennode(subn,getcopy(p^.left),p^.right);
  1625.                   at_star  : p^.right:=gennode(muln,getcopy(p^.left),p^.right);
  1626.                   at_slash : p^.right:=gennode(slashn,getcopy(p^.left),p^.right);
  1627.                   end;
  1628.            end;
  1629. {$endif i386}
  1630.          must_be_valid:=true;
  1631.          firstpass(p^.right);
  1632.          must_be_valid:=store_valid;
  1633.          if codegenerror then
  1634.            exit;
  1635.  
  1636.        { some string functions don't need conversion, so treat them separatly }
  1637.          if (p^.left^.resulttype^.deftype=stringdef) and (assigned(p^.right^.resulttype)) then
  1638.           begin
  1639.             if not (p^.right^.resulttype^.deftype in [stringdef,orddef]) then
  1640.              begin
  1641.                p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
  1642.                firstpass(p^.right);
  1643.                if codegenerror then
  1644.                 exit;
  1645.              end;
  1646.           { we call STRCOPY }
  1647.             procinfo.flags:=procinfo.flags or pi_do_call;
  1648.           end
  1649.          else
  1650.           begin
  1651.             if (p^.right^.treetype=realconstn) then
  1652.               begin
  1653.                  if p^.left^.resulttype^.deftype=floatdef then
  1654.                    begin
  1655.                       case pfloatdef(p^.left^.resulttype)^.typ of
  1656.                         s32real : p^.right^.realtyp:=ait_real_32bit;
  1657.                         s64real : p^.right^.realtyp:=ait_real_64bit;
  1658.                         s80real : p^.right^.realtyp:=ait_real_extended;
  1659.                         { what about f32bit and s64bit }
  1660.                       else
  1661.                         begin
  1662.                            p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
  1663.  
  1664.                            { nochmal firstpass wegen der Typkonvertierung aufrufen }
  1665.                            firstpass(p^.right);
  1666.  
  1667.                            if codegenerror then
  1668.                              exit;
  1669.                         end;
  1670.                       end;
  1671.                    end;
  1672.                end
  1673.              else
  1674.                begin
  1675.                  p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
  1676.                  firstpass(p^.right);
  1677.                  if codegenerror then
  1678.                   exit;
  1679.                end;
  1680.           end;
  1681.  
  1682.          p^.resulttype:=voiddef;
  1683.          {
  1684.            p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  1685.            p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  1686.          }
  1687.          p^.registers32:=p^.left^.registers32+p^.right^.registers32;
  1688.          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  1689. {$ifdef SUPPORT_MMX}
  1690.          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  1691. {$endif SUPPORT_MMX}
  1692.       end;
  1693.  
  1694.     procedure firstlr(var p : ptree);
  1695.  
  1696.       begin
  1697.          firstpass(p^.left);
  1698.          firstpass(p^.right);
  1699.       end;
  1700.  
  1701.     procedure firstderef(var p : ptree);
  1702.  
  1703.       begin
  1704.          firstpass(p^.left);
  1705.          if codegenerror then
  1706.            exit;
  1707.  
  1708.          p^.registers32:=max(p^.left^.registers32,1);
  1709.          p^.registersfpu:=p^.left^.registersfpu;
  1710. {$ifdef SUPPORT_MMX}
  1711.          p^.registersmmx:=p^.left^.registersmmx;
  1712. {$endif SUPPORT_MMX}
  1713.  
  1714.          if p^.left^.resulttype^.deftype<>pointerdef then
  1715.           Message(cg_e_invalid_qualifier);
  1716.  
  1717.          p^.resulttype:=ppointerdef(p^.left^.resulttype)^.definition;
  1718.          p^.location.loc:=LOC_REFERENCE;
  1719.       end;
  1720.  
  1721.     procedure firstrange(var p : ptree);
  1722.  
  1723.       var
  1724.          ct : tconverttype;
  1725.  
  1726.       begin
  1727.          firstpass(p^.left);
  1728.          firstpass(p^.right);
  1729.          if codegenerror then
  1730.            exit;
  1731.          { allow only ordinal constants }
  1732.          if not((p^.left^.treetype=ordconstn) and
  1733.             (p^.right^.treetype=ordconstn)) then
  1734.            Message(cg_e_illegal_expression);
  1735.          { upper limit must be greater or equalt than lower limit }
  1736.          { not if u32bit }
  1737.          if (p^.left^.value>p^.right^.value) and
  1738.             (( p^.left^.value<0) or (p^.right^.value>=0)) then
  1739.            Message(cg_e_upper_lower_than_lower);
  1740.          { both types must be compatible }
  1741.          if not(isconvertable(p^.left^.resulttype,p^.right^.resulttype,
  1742.            ct,ordconstn)) and
  1743.            not(is_equal(p^.left^.resulttype,p^.right^.resulttype)) then
  1744.            Message(sym_e_type_mismatch);
  1745.       end;
  1746.  
  1747.     procedure firstvecn(var p : ptree);
  1748.  
  1749.       var
  1750.          harr : pdef;
  1751.          ct : tconverttype;
  1752.  
  1753.  
  1754.       begin
  1755.          firstpass(p^.left);
  1756.          firstpass(p^.right);
  1757.          if codegenerror then
  1758.            exit;
  1759.  
  1760.          { range check only for arrays }
  1761.          if (p^.left^.resulttype^.deftype=arraydef) then
  1762.            begin
  1763.               if not(isconvertable(p^.right^.resulttype,
  1764.                 parraydef(p^.left^.resulttype)^.rangedef,
  1765.                 ct,ordconstn)) and
  1766.               not(is_equal(p^.right^.resulttype,
  1767.                 parraydef(p^.left^.resulttype)^.rangedef)) then
  1768.                 Message(sym_e_type_mismatch);
  1769.            end;
  1770.          { Never convert a boolean or a char !}
  1771.                  { maybe type conversion }
  1772.                  if (p^.right^.resulttype^.deftype<>enumdef) and
  1773.                   not ((p^.right^.resulttype^.deftype=orddef) and
  1774.                   (Porddef(p^.right^.resulttype)^.typ in [bool8bit,uchar])) then
  1775.                         begin
  1776.                                 p^.right:=gentypeconvnode(p^.right,s32bitdef);
  1777.                                 { once more firstpass }
  1778.                                 {?? It's better to only firstpass when the tree has
  1779.                                  changed, isn't it ?}
  1780.                                 firstpass(p^.right);
  1781.                         end;
  1782.          if codegenerror then
  1783.            exit;
  1784.  
  1785.          { determine return type }
  1786.          if p^.left^.resulttype^.deftype=arraydef then
  1787.            p^.resulttype:=parraydef(p^.left^.resulttype)^.definition
  1788.          else if (p^.left^.resulttype^.deftype=pointerdef) then
  1789.            begin
  1790.               { convert pointer to array }
  1791.               harr:=new(parraydef,init(0,$7fffffff,s32bitdef));
  1792.               parraydef(harr)^.definition:=ppointerdef(p^.left^.resulttype)^.definition;
  1793.               p^.left:=gentypeconvnode(p^.left,harr);
  1794.               firstpass(p^.left);
  1795.  
  1796.               if codegenerror then
  1797.                 exit;
  1798.               p^.resulttype:=parraydef(harr)^.definition
  1799.            end
  1800.          else
  1801.          { indexed access to arrays }
  1802.            p^.resulttype:=cchardef;
  1803.  
  1804.          { the register calculation is easy if a const index is used }
  1805.          if p^.right^.treetype=ordconstn then
  1806.            p^.registers32:=p^.left^.registers32
  1807.          else
  1808.            begin
  1809.               p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  1810.  
  1811.               { not correct, but what works better ? }
  1812.               if p^.left^.registers32>0 then
  1813.                 p^.registers32:=max(p^.registers32,2)
  1814.               else
  1815.               { min. one register }
  1816.                 p^.registers32:=max(p^.registers32,1);
  1817.            end;
  1818.          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  1819. {$ifdef SUPPORT_MMX}
  1820.          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  1821. {$endif SUPPORT_MMX}
  1822.          p^.location.loc:=p^.left^.location.loc;
  1823.       end;
  1824.  
  1825.     type
  1826.        tfirstconvproc = procedure(var p : ptree);
  1827.  
  1828.     procedure first_bigger_smaller(var p : ptree);
  1829.  
  1830.       begin
  1831.          if (p^.left^.location.loc<>LOC_REGISTER) and (p^.registers32=0) then
  1832.            p^.registers32:=1;
  1833.          p^.location.loc:=LOC_REGISTER;
  1834.       end;
  1835.  
  1836.     procedure first_cstring_charpointer(var p : ptree);
  1837.  
  1838.       begin
  1839.          p^.registers32:=1;
  1840.          p^.location.loc:=LOC_REGISTER;
  1841.       end;
  1842.  
  1843.     procedure first_string_chararray(var p : ptree);
  1844.  
  1845.            begin
  1846.                    p^.registers32:=1;
  1847.                    p^.location.loc:=LOC_REGISTER;
  1848.            end;
  1849.  
  1850.     procedure first_string_string(var p : ptree);
  1851.  
  1852.       var l : longint;
  1853.  
  1854.            begin
  1855.                    if p^.left^.treetype=stringconstn then
  1856.                      l:=length(pstring(p^.left^.value)^)
  1857.                    else
  1858.                      l:=pstringdef(p^.left^.resulttype)^.len;
  1859.                    if l<>parraydef(p^.resulttype)^.highrange-parraydef(p^.resulttype)^.lowrange+1 then
  1860.                      Message(sym_e_type_mismatch);
  1861.            end;
  1862.  
  1863.     procedure first_char_to_string(var p : ptree);
  1864.  
  1865.       var
  1866.          hp : ptree;
  1867.  
  1868.       begin
  1869.          if p^.left^.treetype=ordconstn then
  1870.            begin
  1871.               hp:=genstringconstnode(chr(p^.left^.value));
  1872.               firstpass(hp);
  1873.               disposetree(p);
  1874.               p:=hp;
  1875.            end
  1876.          else
  1877.            p^.location.loc:=LOC_MEM;
  1878.       end;
  1879.  
  1880.     procedure first_nothing(var p : ptree);
  1881.  
  1882.       begin
  1883.          p^.location.loc:=LOC_MEM;
  1884.       end;
  1885.  
  1886.     procedure first_array_to_pointer(var p : ptree);
  1887.  
  1888.       begin
  1889.          if p^.registers32<1 then
  1890.            p^.registers32:=1;
  1891.          p^.location.loc:=LOC_REGISTER;
  1892.       end;
  1893.  
  1894.     procedure first_int_real(var p : ptree);
  1895.  
  1896.       var t : ptree;
  1897.  
  1898.       begin
  1899.          if p^.left^.treetype=ordconstn then
  1900.            begin
  1901.               { convert constants direct }
  1902.               { not because of type conversion }
  1903.               t:=genrealconstnode(p^.left^.value);
  1904.               firstpass(t);
  1905.               { the type can be something else than s64real !!}
  1906.               t:=gentypeconvnode(t,p^.resulttype);
  1907.               firstpass(t);
  1908.               disposetree(p);
  1909.               p:=t;
  1910.               exit;
  1911.            end
  1912.          else
  1913.            begin
  1914.               if p^.registersfpu<1 then
  1915.                 p^.registersfpu:=1;
  1916.               p^.location.loc:=LOC_FPU;
  1917.            end;
  1918.       end;
  1919.  
  1920.     procedure first_int_fix(var p : ptree);
  1921.  
  1922.       begin
  1923.          if p^.left^.treetype=ordconstn then
  1924.            begin
  1925.               { convert constants direct }
  1926.               p^.treetype:=fixconstn;
  1927.               p^.valuef:=p^.left^.value shl 16;
  1928.               p^.disposetyp:=dt_nothing;
  1929.               disposetree(p^.left);
  1930.               p^.location.loc:=LOC_MEM;
  1931.            end
  1932.          else
  1933.            begin
  1934.               if p^.registers32<1 then
  1935.                 p^.registers32:=1;
  1936.                   p^.location.loc:=LOC_REGISTER;
  1937.            end;
  1938.       end;
  1939.  
  1940.     procedure first_real_fix(var p : ptree);
  1941.  
  1942.       begin
  1943.          if p^.left^.treetype=realconstn then
  1944.            begin
  1945.               { convert constants direct }
  1946.               p^.treetype:=fixconstn;
  1947.               p^.valuef:=round(p^.left^.valued*65536);
  1948.               p^.disposetyp:=dt_nothing;
  1949.               disposetree(p^.left);
  1950.               p^.location.loc:=LOC_MEM;
  1951.            end
  1952.          else
  1953.            begin
  1954.               { at least one fpu and int register needed }
  1955.               if p^.registers32<1 then
  1956.                 p^.registers32:=1;
  1957.               if p^.registersfpu<1 then
  1958.                 p^.registersfpu:=1;
  1959.               p^.location.loc:=LOC_REGISTER;
  1960.            end;
  1961.       end;
  1962.  
  1963.     procedure first_fix_real(var p : ptree);
  1964.  
  1965.       begin
  1966.          if p^.left^.treetype=fixconstn then
  1967.            begin
  1968.               { convert constants direct }
  1969.               p^.treetype:=realconstn;
  1970.               p^.valued:=round(p^.left^.valuef/65536.0);
  1971.               p^.disposetyp:=dt_nothing;
  1972.               disposetree(p^.left);
  1973.               p^.location.loc:=LOC_MEM;
  1974.            end
  1975.          else
  1976.            begin
  1977.               if p^.registersfpu<1 then
  1978.                 p^.registersfpu:=1;
  1979.                   p^.location.loc:=LOC_FPU;
  1980.            end;
  1981.     end;
  1982.  
  1983.     procedure first_real_real(var p : ptree);
  1984.  
  1985.       begin
  1986.          if p^.registersfpu<1 then
  1987.            p^.registersfpu:=1;
  1988.          p^.location.loc:=LOC_FPU;
  1989.       end;
  1990.  
  1991.     procedure first_pointer_to_array(var p : ptree);
  1992.  
  1993.       begin
  1994.          if p^.registers32<1 then
  1995.            p^.registers32:=1;
  1996.          p^.location.loc:=LOC_REFERENCE;
  1997.       end;
  1998.  
  1999.     procedure first_chararray_string(var p : ptree);
  2000.  
  2001.       begin
  2002.          { the only important information is the location of the }
  2003.          { result                                                }
  2004.          { other stuff is done by firsttypeconv                  }
  2005.          p^.location.loc:=LOC_MEM;
  2006.       end;
  2007.  
  2008.     procedure first_cchar_charpointer(var p : ptree);
  2009.  
  2010.       begin
  2011.          p^.left:=gentypeconvnode(p^.left,cstringdef);
  2012.          { convert constant char to constant string }
  2013.          firstpass(p^.left);
  2014.          { evalute tree }
  2015.          firstpass(p);
  2016.       end;
  2017.  
  2018.     procedure first_locmem(var p : ptree);
  2019.  
  2020.       begin
  2021.          p^.location.loc:=LOC_MEM;
  2022.       end;
  2023.  
  2024.     procedure first_bool_byte(var p : ptree);
  2025.  
  2026.        begin
  2027.           p^.location.loc:=LOC_REGISTER;
  2028.           { Florian I think this is overestimated
  2029.             but I still do not really understand how to get this right (PM) }
  2030.           { Hmmm, I think we need only one reg to return the result of      }
  2031.           { this node => so
  2032.           if p^.registers32<1 then
  2033.             p^.registers32:=1;
  2034.             should work (FK)
  2035.           }
  2036.           p^.registers32:=p^.left^.registers32+1;
  2037.        end;
  2038.  
  2039.     procedure first_proc_to_procvar(var p : ptree);
  2040.  
  2041.       var
  2042.          hp : ptree;
  2043.          hp2 : pdefcoll;
  2044.  
  2045.       begin
  2046.          firstpass(p^.left);
  2047.          if codegenerror then
  2048.            exit;
  2049.  
  2050.          if (p^.left^.location.loc<>LOC_REFERENCE) then
  2051.            Message(cg_e_illegal_expression);
  2052.  
  2053.          p^.registers32:=p^.left^.registers32;
  2054.          if p^.registers32<1 then
  2055.            p^.registers32:=1;
  2056.          p^.location.loc:=LOC_REGISTER;
  2057.       end;
  2058.  
  2059.         function is_procsym_load(p:Ptree):boolean;
  2060.  
  2061.         begin
  2062.            is_procsym_load:=((p^.treetype=loadn) and (p^.symtableentry^.typ=procsym)) or
  2063.                             ((p^.treetype=addrn) and (p^.left^.treetype=loadn)
  2064.                             and (p^.left^.symtableentry^.typ=procsym)) ;
  2065.         end;
  2066.  
  2067.    { change a proc call to a procload for assignment to a procvar }
  2068.    { this can only happen for proc/function without arguments }
  2069.         function is_procsym_call(p:Ptree):boolean;
  2070.  
  2071.         begin
  2072.            is_procsym_call:=(p^.treetype=calln) and (p^.left=nil) and
  2073.              (((p^.symtableprocentry^.typ=procsym) and (p^.right=nil)) or
  2074.              ((p^.right<>nil) and (p^.right^.symtableprocentry^.typ=varsym)));
  2075.         end;
  2076. {***}
  2077.  
  2078.      function is_assignment_overloaded(from_def,to_def : pdef) : boolean;
  2079.        var
  2080.           passproc : pprocdef;
  2081.        begin
  2082.           is_assignment_overloaded:=false;
  2083.           if assigned(overloaded_operators[assignment]) then
  2084.             passproc:=overloaded_operators[assignment]^.definition
  2085.           else
  2086.             passproc:=nil;
  2087.           while passproc<>nil do
  2088.             begin
  2089.               if (passproc^.retdef=to_def) and (passproc^.para1^.data=from_def) then
  2090.                 begin
  2091.                    is_assignment_overloaded:=true;
  2092.                    break;
  2093.                 end;
  2094.               passproc:=passproc^.nextoverloaded;
  2095.             end;
  2096.        end;
  2097.     { Attention: do *** no ***  recursive call of firstpass }
  2098.     { because the child tree is always passed               }
  2099.  
  2100.         procedure firsttypeconv(var p : ptree);
  2101.  
  2102.           var
  2103.                  hp : ptree;
  2104.                  hp2,hp3:Pdefcoll;
  2105.                  aprocdef : pprocdef;
  2106.                  proctype : tdeftype;
  2107.  
  2108.     const
  2109.        firstconvert : array[tc_u8bit_2_s32bit..tc_cchar_charpointer] of
  2110.          tfirstconvproc = (first_bigger_smaller,first_nothing,first_bigger_smaller,
  2111.                            first_bigger_smaller,first_bigger_smaller,
  2112.                            first_bigger_smaller,first_bigger_smaller,
  2113.                            first_bigger_smaller,first_locmem,
  2114.                            first_cstring_charpointer,first_string_chararray,
  2115.                            first_array_to_pointer,first_pointer_to_array,
  2116.                            first_char_to_string,first_bigger_smaller,
  2117.                            first_bigger_smaller,first_bigger_smaller,
  2118.                            first_bigger_smaller,first_bigger_smaller,
  2119.                            first_bigger_smaller,first_bigger_smaller,
  2120.                            first_bigger_smaller,first_bigger_smaller,
  2121.                            first_bigger_smaller,first_bigger_smaller,
  2122.                            first_bigger_smaller,first_bigger_smaller,
  2123.                            first_bigger_smaller,first_bigger_smaller,
  2124.                            first_int_real,first_real_fix,
  2125.                            first_fix_real,first_int_fix,first_real_real,
  2126.                            first_locmem,first_bool_byte,first_proc_to_procvar,
  2127.                first_cchar_charpointer);
  2128.  
  2129.     begin
  2130.        aprocdef:=nil;
  2131.        { if explicite type conversation, then run firstpass }
  2132.        if p^.explizit then
  2133.          firstpass(p^.left);
  2134.  
  2135.        if codegenerror then
  2136.          exit;
  2137.  
  2138.        if not assigned(p^.left^.resulttype) then
  2139.         begin
  2140.           codegenerror:=true;
  2141.           exit;
  2142.         end;
  2143.  
  2144.        { remove obsolete type conversions }
  2145.        if is_equal(p^.left^.resulttype,p^.resulttype) then
  2146.          begin
  2147.             hp:=p;
  2148.             p:=p^.left;
  2149.             p^.resulttype:=hp^.resulttype;
  2150.             putnode(hp);
  2151.             exit;
  2152.          end;
  2153.        p^.registers32:=p^.left^.registers32;
  2154.        p^.registersfpu:=p^.left^.registersfpu;
  2155. {$ifdef SUPPORT_MMX}
  2156.        p^.registersmmx:=p^.left^.registersmmx;
  2157. {$endif}
  2158.        set_location(p^.location,p^.left^.location);
  2159.        if (not(isconvertable(p^.left^.resulttype,p^.resulttype,p^.convtyp,p^.left^.treetype))) then
  2160.          begin
  2161.             if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
  2162.               begin
  2163.                  procinfo.flags:=procinfo.flags or pi_do_call;
  2164.                  hp:=gencallnode(overloaded_operators[assignment],nil);
  2165.                  hp^.left:=gencallparanode(p^.left,nil);
  2166.                  putnode(p);
  2167.                  p:=hp;
  2168.                  firstpass(p);
  2169.                  exit;
  2170.               end;
  2171.            {Procedures have a resulttype of voiddef and functions of their
  2172.            own resulttype. They will therefore always be incompatible with
  2173.            a procvar. Because isconvertable cannot check for procedures we
  2174.            use an extra check for them.}
  2175.            if (cs_tp_compatible in aktswitches) and
  2176.              ((is_procsym_load(p^.left) or is_procsym_call(p^.left)) and
  2177.              (p^.resulttype^.deftype=procvardef)) then
  2178.              begin
  2179.                 { just a test: p^.explizit:=false; }
  2180.                 if is_procsym_call(p^.left) then
  2181.                   begin
  2182.                      if p^.left^.right=nil then
  2183.                        begin
  2184.                           p^.left^.treetype:=loadn;
  2185.                           { are at same offset so this could be spared, but
  2186.                           it more secure to do it anyway }
  2187.                           p^.left^.symtableentry:=p^.left^.symtableprocentry;
  2188.                           p^.left^.resulttype:=pprocsym(p^.left^.symtableentry)^.definition;
  2189.                           aprocdef:=pprocdef(p^.left^.resulttype);
  2190.                        end
  2191.                      else
  2192.                        begin
  2193.                           p^.left^.right^.treetype:=loadn;
  2194.                           p^.left^.right^.symtableentry:=p^.left^.right^.symtableentry;
  2195.                           P^.left^.right^.resulttype:=pvarsym(p^.left^.symtableentry)^.definition;
  2196.                           hp:=p^.left^.right;
  2197.                           putnode(p^.left);
  2198.                           p^.left:=hp;
  2199.                           { should we do that ? }
  2200.                           firstpass(p^.left);
  2201.                           if not is_equal(p^.left^.resulttype,p^.resulttype) then
  2202.                             begin
  2203.                                Message(sym_e_type_mismatch);
  2204.                                exit;
  2205.                             end
  2206.                           else
  2207.                             begin
  2208.                                hp:=p;
  2209.                                p:=p^.left;
  2210.                                p^.resulttype:=hp^.resulttype;
  2211.                                putnode(hp);
  2212.                                exit;
  2213.                             end;
  2214.                        end;
  2215.                   end
  2216.                 else
  2217.                   begin
  2218.                      if p^.left^.treetype=addrn then
  2219.                        begin
  2220.                           hp:=p^.left;
  2221.                           p^.left:=p^.left^.left;
  2222.                           putnode(p^.left);
  2223.                        end
  2224.                      else
  2225.                        aprocdef:=pprocsym(p^.left^.symtableentry)^.definition;
  2226.                   end;
  2227.  
  2228.                 p^.convtyp:=tc_proc2procvar;
  2229.                 { Now check if the procedure we are going to assign to
  2230.                   the procvar,  is compatible with the procvar's type.
  2231.                   Did the original procvar support do such a check?
  2232.                   I can't find any.}
  2233.                 { answer : is_equal works for procvardefs !! }
  2234.                 { but both must be procvardefs, so we cheet  little }
  2235.                 if assigned(aprocdef) then
  2236.                   begin
  2237.                     proctype:=aprocdef^.deftype;
  2238.                     aprocdef^.deftype:=procvardef;
  2239.  
  2240.                     if not is_equal(aprocdef,p^.resulttype) then
  2241.                       begin
  2242.                         aprocdef^.deftype:=proctype;
  2243.                         Message(sym_e_type_mismatch);
  2244.                       end;
  2245.                     aprocdef^.deftype:=proctype;
  2246.                     firstconvert[p^.convtyp](p);
  2247.                   end
  2248.                 else
  2249.                   Message(sym_e_type_mismatch);
  2250.                 exit;
  2251.              end
  2252.            else
  2253.              begin
  2254.                 if p^.explizit then
  2255.                   begin
  2256.                      { boolean to byte are special because the
  2257.                        location can be different }
  2258.                      if (p^.resulttype^.deftype=orddef) and
  2259.                         (porddef(p^.resulttype)^.typ=u8bit) and
  2260.                         (p^.left^.resulttype^.deftype=orddef) and
  2261.                         (porddef(p^.left^.resulttype)^.typ=bool8bit) then
  2262.                        begin
  2263.                           p^.convtyp:=tc_bool_2_u8bit;
  2264.                           firstconvert[p^.convtyp](p);
  2265.                           exit;
  2266.                        end;
  2267.                      { normal tc_equal-Konvertierung durchfhren }
  2268.                      p^.convtyp:=tc_equal;
  2269.                      { wenn Aufz„hltyp nach Ordinal konvertiert werden soll }
  2270.                      { dann Aufz„hltyp=s32bit                               }
  2271.                      if (p^.left^.resulttype^.deftype=enumdef) and
  2272.                         is_ordinal(p^.resulttype) then
  2273.                        begin
  2274.                           if p^.left^.treetype=ordconstn then
  2275.                             begin
  2276.                                hp:=genordinalconstnode(p^.left^.value,p^.resulttype);
  2277.                                disposetree(p);
  2278.                                p:=hp;
  2279.                                exit;
  2280.                             end
  2281.                           else
  2282.                             begin
  2283.                                if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,ordconstn { nur Dummy} ) then
  2284.                                  Message(cg_e_illegal_type_conversion);
  2285.                             end;
  2286.  
  2287.                        end
  2288.                      { ordinal to enumeration }
  2289.                      else
  2290.                        if (p^.resulttype^.deftype=enumdef) and
  2291.                           is_ordinal(p^.left^.resulttype) then
  2292.                          begin
  2293.                             if p^.left^.treetype=ordconstn then
  2294.                               begin
  2295.                                  hp:=genordinalconstnode(p^.left^.value,p^.resulttype);
  2296.                                  disposetree(p);
  2297.                                  p:=hp;
  2298.                                  exit;
  2299.                               end
  2300.                             else
  2301.                               begin
  2302.                                  if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn { nur Dummy} ) then
  2303.                                    Message(cg_e_illegal_type_conversion);
  2304.                               end;
  2305.                          end
  2306.                      {Are we typecasting an ordconst to a char?}
  2307.                      else
  2308.                        if is_equal(p^.resulttype,cchardef) and
  2309.                           is_ordinal(p^.left^.resulttype) then
  2310.                          begin
  2311.                             if p^.left^.treetype=ordconstn then
  2312.                               begin
  2313.                                  hp:=genordinalconstnode(p^.left^.value,p^.resulttype);
  2314.                                  disposetree(p);
  2315.                                  p:=hp;
  2316.                                  exit;
  2317.                               end
  2318.                             else
  2319.                               begin
  2320.                                  { this is wrong because it converts to a 4 byte long var !!
  2321.                                    if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn  nur Dummy ) then }
  2322.                                  if not isconvertable(p^.left^.resulttype,u8bitdef,p^.convtyp,ordconstn { nur Dummy} ) then
  2323.                                    Message(cg_e_illegal_type_conversion);
  2324.                               end;
  2325.                          end
  2326.                      { only if the same size or formal def }
  2327.                      { why do we allow typecasting of voiddef ?? (PM) }
  2328.                      else
  2329.                        if not(
  2330.                              (p^.left^.resulttype^.deftype=formaldef) or
  2331.                              (p^.left^.resulttype^.size=p^.resulttype^.size) or
  2332.                              (is_equal(p^.left^.resulttype,voiddef)  and
  2333.                              (p^.left^.treetype=derefn))
  2334.                              ) then
  2335.                          Message(cg_e_illegal_type_conversion);
  2336.                      { the conversion into a strutured type is only }
  2337.                      { possible, if the source is no register         }
  2338.                      if (p^.resulttype^.deftype in [recorddef,stringdef,arraydef,objectdef]) and
  2339.                         (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  2340.                        Message(cg_e_illegal_type_conversion);
  2341.                 end
  2342.               else
  2343.                 Message(sym_e_type_mismatch);
  2344.            end
  2345.          end
  2346.        else
  2347.          begin
  2348.             { just a test: p^.explizit:=false; }
  2349.             { ordinale contants are direct converted }
  2350.             if (p^.left^.treetype=ordconstn) and is_ordinal(p^.resulttype) then
  2351.               begin
  2352.                  { perform range checking }
  2353.                  if not(p^.explizit and (cs_tp_compatible in aktswitches)) then
  2354.                    testrange(p^.resulttype,p^.left^.value);
  2355.                  hp:=genordinalconstnode(p^.left^.value,p^.resulttype);
  2356.                  disposetree(p);
  2357.                  p:=hp;
  2358.                  exit;
  2359.               end;
  2360.             if p^.convtyp<>tc_equal then
  2361.               firstconvert[p^.convtyp](p);
  2362.          end;
  2363.     end;
  2364.  
  2365.     { *************** subroutine handling **************** }
  2366.  
  2367.     procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
  2368.  
  2369.       var store_valid : boolean;
  2370.           convtyp     : tconverttype;
  2371.       begin
  2372.          inc(parsing_para_level);
  2373.          if assigned(p^.right) then
  2374.            begin
  2375.               if defcoll=nil then
  2376.                 firstcallparan(p^.right,nil)
  2377.               else
  2378.                 firstcallparan(p^.right,defcoll^.next);
  2379.               p^.registers32:=p^.right^.registers32;
  2380.               p^.registersfpu:=p^.right^.registersfpu;
  2381. {$ifdef SUPPORT_MMX}
  2382.               p^.registersmmx:=p^.right^.registersmmx;
  2383. {$endif}
  2384.            end;
  2385.          if defcoll=nil then
  2386.            begin
  2387.               firstpass(p^.left);
  2388.  
  2389.               if codegenerror then
  2390.                 begin
  2391.                    dec(parsing_para_level);
  2392.                    exit;
  2393.                 end;
  2394.  
  2395.               p^.resulttype:=p^.left^.resulttype;
  2396.            end
  2397.          { if we know the routine which is called, then the type }
  2398.          { conversions are inserted                            }
  2399.          else
  2400.            begin
  2401.                if count_ref then
  2402.                      begin
  2403.                      store_valid:=must_be_valid;
  2404.                      if (defcoll^.paratyp<>vs_var) then
  2405.                        must_be_valid:=true
  2406.                      else
  2407.                        must_be_valid:=false;
  2408.                      { here we must add something for the implicit type }
  2409.                      { conversion from array of char to pchar }
  2410.                      if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,p^.left^.treetype) then
  2411.                        if convtyp=tc_array_to_pointer then
  2412.                          must_be_valid:=false;
  2413.                      firstpass(p^.left);
  2414.                      must_be_valid:=store_valid;
  2415.                      End;
  2416.               if not((p^.left^.resulttype^.deftype=stringdef) and
  2417.                      (defcoll^.data^.deftype=stringdef)) and
  2418.                      (defcoll^.data^.deftype<>formaldef) then
  2419.                 begin
  2420.                    if (defcoll^.paratyp=vs_var) and
  2421.                    { allows conversion from word to integer and
  2422.                      byte to shortint }
  2423.                      (not(
  2424.                         (p^.left^.resulttype^.deftype=orddef) and
  2425.                         (defcoll^.data^.deftype=orddef) and
  2426.                         (p^.left^.resulttype^.size=defcoll^.data^.size)
  2427.                          ) and
  2428.                    { an implicit pointer conversion is allowed }
  2429.                      not(
  2430.                         (p^.left^.resulttype^.deftype=pointerdef) and
  2431.                         (defcoll^.data^.deftype=pointerdef)
  2432.                          ) and
  2433.                    { an implicit file conversion is also allowed }
  2434.                    { from a typed file to an untyped one           }
  2435.                      not(
  2436.                         (p^.left^.resulttype^.deftype=filedef) and
  2437.                         (defcoll^.data^.deftype=filedef) and
  2438.                         (pfiledef(defcoll^.data)^.filetype = ft_untyped) and
  2439.                         (pfiledef(p^.left^.resulttype)^.filetype = ft_typed)
  2440.                          ) and
  2441.                      not(is_equal(p^.left^.resulttype,defcoll^.data))) then
  2442.                        Message(parser_e_call_by_ref_without_typeconv);
  2443.                    { don't generate an type conversion for open arrays }
  2444.                    { else we loss the ranges                             }
  2445.                    if not(is_open_array(defcoll^.data)) then
  2446.                      begin
  2447.                         p^.left:=gentypeconvnode(p^.left,defcoll^.data);
  2448.                         firstpass(p^.left);
  2449.                      end;
  2450.                    if codegenerror then
  2451.                      begin
  2452.                         dec(parsing_para_level);
  2453.                         exit;
  2454.                      end;
  2455.                 end;
  2456.               { check var strings }
  2457.               if (cs_strict_var_strings in aktswitches) and
  2458.                  (p^.left^.resulttype^.deftype=stringdef) and
  2459.                  (defcoll^.data^.deftype=stringdef) and
  2460.                  (defcoll^.paratyp=vs_var) and
  2461.                  not(is_equal(p^.left^.resulttype,defcoll^.data)) then
  2462.                  Message(parser_e_strict_var_string_violation);
  2463.               { Variablen, die call by reference bergeben werden, }
  2464.               { k”nnen nicht in ein Register kopiert werden       }
  2465.               { is this usefull here ? }
  2466.               { this was missing in formal parameter list   }
  2467.               if defcoll^.paratyp=vs_var then
  2468.                 make_not_regable(p^.left);
  2469.  
  2470.               p^.resulttype:=defcoll^.data;
  2471.            end;
  2472.          if p^.left^.registers32>p^.registers32 then
  2473.            p^.registers32:=p^.left^.registers32;
  2474.          if p^.left^.registersfpu>p^.registersfpu then
  2475.            p^.registersfpu:=p^.left^.registersfpu;
  2476. {$ifdef SUPPORT_MMX}
  2477.          if p^.left^.registersmmx>p^.registersmmx then
  2478.            p^.registersmmx:=p^.left^.registersmmx;
  2479. {$endif SUPPORT_MMX}
  2480.          dec(parsing_para_level);
  2481.       end;
  2482.  
  2483.     procedure firstcalln(var p : ptree);
  2484.  
  2485.       type
  2486.          pprocdefcoll = ^tprocdefcoll;
  2487.  
  2488.          tprocdefcoll = record
  2489.             data : pprocdef;
  2490.             nextpara : pdefcoll;
  2491.             firstpara : pdefcoll;
  2492.             next : pprocdefcoll;
  2493.          end;
  2494.  
  2495.       var
  2496.          hp,procs,hp2 : pprocdefcoll;
  2497.          pd : pprocdef;
  2498.          st : psymtable;
  2499.          actprocsym : pprocsym;
  2500.          def_from,def_to,conv_to : pdef;
  2501.          pt : ptree;
  2502.          exactmatch : boolean;
  2503.          paralength,l : longint;
  2504.          pdc : pdefcoll;
  2505.  
  2506.          { only Dummy }
  2507.          hcvt : tconverttype;
  2508.          regi : tregister;
  2509.          store_valid, old_count_ref : boolean;
  2510.  
  2511.  
  2512.       { types.is_equal can't handle a formaldef ! }
  2513.       function is_equal(def1,def2 : pdef) : boolean;
  2514.  
  2515.         begin
  2516.            { all types can be passed to a  formaldef  }
  2517.            is_equal:=(def1^.deftype=formaldef) or
  2518.              (assigned(def2) and types.is_equal(def1,def2));
  2519.         end;
  2520.  
  2521.       function is_in_limit(def_from,def_to : pdef) : boolean;
  2522.  
  2523.         begin
  2524.            is_in_limit:=(def_from^.deftype = orddef) and
  2525.                         (def_to^.deftype = orddef) and
  2526.                         (porddef(def_from)^.von>porddef(def_to)^.von) and
  2527.                         (porddef(def_from)^.bis<porddef(def_to)^.bis);
  2528.         end;
  2529.  
  2530.  
  2531.       begin
  2532.          { release registers! }
  2533.          { if procdefinition<>nil then we called firstpass already }
  2534.          { it seems to be bad because of the registers }
  2535.          { at least we can avoid the overloaded search !! }
  2536.          procs:=nil;
  2537.          { made this global for disposing !! }
  2538.          store_valid:=must_be_valid;
  2539.          if not assigned(p^.procdefinition) then
  2540.            begin
  2541.               must_be_valid:=false;
  2542.               { procedure variable ? }
  2543.               if not(assigned(p^.right)) then
  2544.                 begin
  2545.                    if assigned(p^.left) then
  2546.                      begin
  2547.                         old_count_ref:=count_ref;
  2548.                         count_ref:=false;
  2549.                         store_valid:=must_be_valid;
  2550.                         must_be_valid:=false;
  2551.                         firstcallparan(p^.left,nil);
  2552.                         count_ref:=old_count_ref;
  2553.                         must_be_valid:=store_valid;
  2554.                         if codegenerror then
  2555.                           exit;
  2556.                      end;
  2557.                    { determine length of parameter list }
  2558.                    pt:=p^.left;
  2559.                    paralength:=0;
  2560.                    while assigned(pt) do
  2561.                      begin
  2562.                         inc(paralength);
  2563.                         pt:=pt^.right;
  2564.                      end;
  2565.  
  2566.                    { alle in Frage kommenden Prozeduren in eine }
  2567.                    { verkettete Liste einfgen                  }
  2568.                    actprocsym:=p^.symtableprocentry;
  2569.                    pd:=actprocsym^.definition;
  2570.                    while assigned(pd) do
  2571.                      begin
  2572.                         { we should also check that the overloaded function
  2573.                         has been declared in a unit that is in the uses !! }
  2574.                         { pd^.owner should be in the symtablestack !! }
  2575.                         { Laenge der deklarierten Parameterliste feststellen: }
  2576.                         { not necessary why nextprocsym field }
  2577.                         {st:=symtablestack;
  2578.                         if (pd^.owner^.symtabletype<>objectsymtable) then
  2579.                           while assigned(st) do
  2580.                             begin
  2581.                                if (st=pd^.owner) then break;
  2582.                                st:=st^.next;
  2583.                             end;
  2584.                         if assigned(st) then }
  2585.                           begin
  2586.                              pdc:=pd^.para1;
  2587.                              l:=0;
  2588.                              while assigned(pdc) do
  2589.                                begin
  2590.                                   inc(l);
  2591.                                   pdc:=pdc^.next;
  2592.                                end;
  2593.                              { nur wenn die Parameterl„nge paát, dann Einfgen }
  2594.                              if l=paralength then
  2595.                                begin
  2596.                                   new(hp);
  2597.                                   hp^.data:=pd;
  2598.                                   hp^.next:=procs;
  2599.                                   hp^.nextpara:=pd^.para1;
  2600.                                   hp^.firstpara:=pd^.para1;
  2601.                                   procs:=hp;
  2602.                                end;
  2603.                           end;
  2604.                         pd:=pd^.nextoverloaded;
  2605. {$ifdef CHAINPROCSYMS}
  2606.                         if (pd=nil) and not (p^.unit_specific) then
  2607.                           begin
  2608.                              actprocsym:=actprocsym^.nextprocsym;
  2609.                              if assigned(actprocsym) then
  2610.                                pd:=actprocsym^.definition;
  2611.                           end;
  2612. {$endif CHAINPROCSYMS}
  2613.                      end;
  2614.  
  2615.                    { nun alle Parameter nacheinander vergleichen }
  2616.                    pt:=p^.left;
  2617.                    while assigned(pt) do
  2618.                      begin
  2619.                         { matches a parameter of one procedure exact ? }
  2620.                         exactmatch:=false;
  2621.                         hp:=procs;
  2622.                         while assigned(hp) do
  2623.                           begin
  2624.                              if is_equal(hp^.nextpara^.data,pt^.resulttype) then
  2625.                                begin
  2626.                                   if hp^.nextpara^.data=pt^.resulttype then
  2627.                                     begin
  2628.                                        pt^.exact_match_found:=true;
  2629.                                        hp^.nextpara^.argconvtyp:=act_exact;
  2630.                                     end
  2631.                                   else
  2632.                                     hp^.nextpara^.argconvtyp:=act_equal;
  2633.                                   exactmatch:=true;
  2634.                                end
  2635.                              else
  2636.                                hp^.nextpara^.argconvtyp:=act_convertable;
  2637.                              hp:=hp^.next;
  2638.                           end;
  2639.  
  2640.                         { .... if yes, del all the other procedures }
  2641.                         if exactmatch then
  2642.                           begin
  2643.                              { the first .... }
  2644.                              while (assigned(procs)) and not(is_equal(procs^.nextpara^.data,pt^.resulttype)) do
  2645.                                begin
  2646.                                   hp:=procs^.next;
  2647.                                   dispose(procs);
  2648.                                   procs:=hp;
  2649.                                end;
  2650.                              { and the others }
  2651.                              hp:=procs;
  2652.                              while (assigned(hp)) and assigned(hp^.next) do
  2653.                                begin
  2654.                                   if not(is_equal(hp^.next^.nextpara^.data,pt^.resulttype)) then
  2655.                                     begin
  2656.                                        hp2:=hp^.next^.next;
  2657.                                        dispose(hp^.next);
  2658.                                        hp^.next:=hp2;
  2659.                                     end
  2660.                                   else
  2661.                                     hp:=hp^.next;
  2662.                                end;
  2663.                           end
  2664.                         { sollte nirgendwo ein Parameter exakt passen, }
  2665.                         { so alle Prozeduren entfernen, bei denen      }
  2666.                         { der Parameter auch nach einer impliziten     }
  2667.                         { Typkonvertierung nicht passt                 }
  2668.                         else
  2669.                           begin
  2670.                              { erst am Anfang }
  2671.                              while (assigned(procs)) and
  2672.                                not(isconvertable(pt^.resulttype,procs^.nextpara^.data,hcvt,pt^.left^.treetype)) do
  2673.                                begin
  2674.                                   hp:=procs^.next;
  2675.                                   dispose(procs);
  2676.                                   procs:=hp;
  2677.                                end;
  2678.                              { und jetzt aus der Mitte }
  2679.                              hp:=procs;
  2680.                              while (assigned(hp)) and assigned(hp^.next) do
  2681.                                begin
  2682.                                   if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data,
  2683.                                     hcvt,pt^.left^.treetype)) then
  2684.                                     begin
  2685.                                        hp2:=hp^.next^.next;
  2686.                                        dispose(hp^.next);
  2687.                                        hp^.next:=hp2;
  2688.                                     end
  2689.                                   else
  2690.                                     hp:=hp^.next;
  2691.                                end;
  2692.                           end;
  2693.                         { nun bei denn Prozeduren den nextpara-Zeiger auf den }
  2694.                         { naechsten Parameter setzen                          }
  2695.                         hp:=procs;
  2696.                         while assigned(hp) do
  2697.                           begin
  2698.                              hp^.nextpara:=hp^.nextpara^.next;
  2699.                              hp:=hp^.next;
  2700.                           end;
  2701.                         pt:=pt^.right;
  2702.                      end;
  2703.  
  2704.                    if procs=nil then
  2705.                      if (parsing_para_level=0) or (p^.left<>nil) then
  2706.                        begin
  2707.                           Message(parser_e_illegal_parameter_list);
  2708.                           exit;
  2709.                        end
  2710.                      else
  2711.                        begin
  2712.                           { try to convert to procvar }
  2713.                           p^.treetype:=loadn;
  2714.                           p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition;
  2715.                           p^.symtableentry:=p^.symtableprocentry;
  2716.                           p^.is_first:=false;
  2717.                           p^.disposetyp:=dt_nothing;
  2718.                           firstpass(p);
  2719.                           exit;
  2720.                        end;
  2721.  
  2722.                    { if there are several choices left then for orddef }
  2723.                    { if a type is totally included in the other        }
  2724.                    { we don't fear an overflow ,                       }
  2725.                    { so we can do as if it is an exact match           }
  2726.                    { this will convert integer to longint              }
  2727.                    { rather than to words                              }
  2728.                    { conversion of byte to integer or longint          }
  2729.                    {would still not be solved                          }
  2730.                    if assigned(procs^.next) then
  2731.                      begin
  2732.                         hp:=procs;
  2733.                         while assigned(hp) do
  2734.                           begin
  2735.                             hp^.nextpara:=hp^.firstpara;
  2736.                             hp:=hp^.next;
  2737.                           end;
  2738.                         pt:=p^.left;
  2739.                         while assigned(pt) do
  2740.                           begin
  2741.                              { matches a parameter of one procedure exact ? }
  2742.                              exactmatch:=false;
  2743.                              def_from:=pt^.resulttype;
  2744.                              hp:=procs;
  2745.                              while assigned(hp) do
  2746.                                begin
  2747.                                   if not is_equal(hp^.nextpara^.data,pt^.resulttype) then
  2748.                                     begin
  2749.                                        def_to:=hp^.nextpara^.data;
  2750.                                        if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then
  2751.                                          if is_in_limit(def_from,def_to) or
  2752.                                            ((hp^.nextpara^.paratyp=vs_var) and
  2753.                                            (def_from^.size=def_to^.size)) then
  2754.                                            begin
  2755.                                               exactmatch:=true;
  2756.                                               conv_to:=def_to;
  2757.                                            end;
  2758.                                     end;
  2759.                                   hp:=hp^.next;
  2760.                                end;
  2761.  
  2762.                              { .... if yes, del all the other procedures }
  2763.                              if exactmatch then
  2764.                                begin
  2765.                                   { the first .... }
  2766.                                   while (assigned(procs)) and not(is_in_limit(def_from,procs^.nextpara^.data)) do
  2767.                                     begin
  2768.                                        hp:=procs^.next;
  2769.                                        dispose(procs);
  2770.                                        procs:=hp;
  2771.                                     end;
  2772.                                   { and the others }
  2773.                                   hp:=procs;
  2774.                                   while (assigned(hp)) and assigned(hp^.next) do
  2775.                                     begin
  2776.                                        if not(is_in_limit(def_from,hp^.next^.nextpara^.data)) then
  2777.                                          begin
  2778.                                             hp2:=hp^.next^.next;
  2779.                                             dispose(hp^.next);
  2780.                                             hp^.next:=hp2;
  2781.                                          end
  2782.                                        else
  2783.                                          begin
  2784.                                            def_to:=hp^.next^.nextpara^.data;
  2785.                                            if (conv_to^.size>def_to^.size) or
  2786.                                               ((porddef(conv_to)^.von<porddef(def_to)^.von) and
  2787.                                               (porddef(conv_to)^.bis>porddef(def_to)^.bis)) then
  2788.                                              begin
  2789.                                                 hp2:=procs;
  2790.                                                 procs:=hp;
  2791.                                                 conv_to:=def_to;
  2792.                                                 dispose(hp2);
  2793.                                              end
  2794.                                            else
  2795.                                              hp:=hp^.next;
  2796.                                          end;
  2797.                                     end;
  2798.                                end;
  2799.                              { nun bei denn Prozeduren den nextpara-Zeiger auf den }
  2800.                              { naechsten Parameter setzen                          }
  2801.                              hp:=procs;
  2802.                              while assigned(hp) do
  2803.                                begin
  2804.                                   hp^.nextpara:=hp^.nextpara^.next;
  2805.                                   hp:=hp^.next;
  2806.                                end;
  2807.                              pt:=pt^.right;
  2808.                           end;
  2809.                      end;
  2810.                    { let's try to eliminate equal is exact is there }
  2811.                    {if assigned(procs^.next) then
  2812.                      begin
  2813.                         pt:=p^.left;
  2814.                         while assigned(pt) do
  2815.                           begin
  2816.                              if pt^.exact_match_found then
  2817.                                begin
  2818.                                   hp:=procs;
  2819.                                   while (assigned(procs)) and (procs^.nextpara^.data<>pt^.resulttype) do
  2820.                                     begin
  2821.                                        hp:=procs^.next;
  2822.                                        dispose(procs);
  2823.                                        procs:=hp;
  2824.                                     end;
  2825.                                end;
  2826.                              pt:=pt^.right;
  2827.                           end;
  2828.                      end; }
  2829.  
  2830. {$ifndef CHAINPROCSYMS}
  2831.                    if assigned(procs^.next) then
  2832.                      Message(cg_e_cant_choose_overload_function);
  2833. {$else CHAINPROCSYMS}
  2834.                    if assigned(procs^.next) then
  2835.                      { if the last retained is the only one }
  2836.                      { from a unit it is OK              PM  }
  2837.                      { the last is the one coming from the first symtable }
  2838.                      { as the diff defcoll are inserted in front }
  2839.                      begin
  2840.                         hp2:=procs;
  2841.                         while assigned(hp2^.next) and assigned(hp2^.next^.next) do
  2842.                           hp2:=hp2^.next;
  2843.                         if (hp2^.data^.owner<>hp2^.next^.data^.owner) then
  2844.                           begin
  2845.                              hp:=procs^.next;
  2846.                              {hp2 is the correct one }
  2847.                              hp2:=hp2^.next;
  2848.                              while hp<>hp2 do
  2849.                                begin
  2850.                                  dispose(procs);
  2851.                                  procs:=hp;
  2852.                                  hp:=procs^.next;
  2853.                                end;
  2854.                              procs:=hp2;
  2855.                           end
  2856.                         else
  2857.                           Message(cg_e_cant_choose_overload_function);
  2858.                           error(too_much_matches);
  2859.                      end;
  2860. {$endif CHAINPROCSYMS}
  2861.      {$ifdef UseBrowser}
  2862.                    add_new_ref(procs^.data^.lastref);
  2863.      {$endif UseBrowser}
  2864.                    p^.procdefinition:=procs^.data;
  2865.                    p^.resulttype:=procs^.data^.retdef;
  2866.                    p^.location.loc:=LOC_MEM;
  2867. {$ifdef CHAINPROCSYMS}
  2868.                    { object with method read;
  2869.                      call to read(x) will be a usual procedure call }
  2870.                    if assigned(p^.methodpointer) and
  2871.                      (p^.procdefinition^._class=nil) then
  2872.                      begin
  2873.                         { not ok for extended }
  2874.                         case p^.methodpointer^.treetype of
  2875.                            typen,hnewn : fatalerror(no_para_match);
  2876.                         end;
  2877.                         disposetree(p^.methodpointer);
  2878.                         p^.methodpointer:=nil;
  2879.                      end;
  2880. {$endif CHAINPROCSYMS}
  2881.  
  2882.                    { work trough all parameters to insert the type conversions }
  2883.                    if assigned(p^.left) then
  2884.                      begin
  2885.                         old_count_ref:=count_ref;
  2886.                         count_ref:=true;
  2887.                         firstcallparan(p^.left,p^.procdefinition^.para1);
  2888.                         count_ref:=old_count_ref;
  2889.                      end;
  2890.                    { handle predefined procedures }
  2891.                    if (p^.procdefinition^.options and pointernproc)<>0 then
  2892.                      begin
  2893.                         { settextbuf needs two args }
  2894.                         if assigned(p^.left^.right) then
  2895.                           pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,p^.left)
  2896.                         else
  2897.                           begin
  2898.                              pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,p^.left^.left);
  2899.                              putnode(p^.left);
  2900.                           end;
  2901.                         putnode(p);
  2902.                         firstpass(pt);
  2903.                         { was placed after the exit          }
  2904.                         { caused GPF                         }
  2905.                         { error caused and corrected by (PM) }
  2906.                         p:=pt;
  2907.  
  2908.                         must_be_valid:=store_valid;
  2909.                         if codegenerror then
  2910.                           exit;
  2911.  
  2912.                         dispose(procs);
  2913.                         exit;
  2914.                      end
  2915.                    else
  2916.                      { no intern procedure => we do a call }
  2917.                      procinfo.flags:=procinfo.flags or pi_do_call;
  2918.  
  2919.                    { calc the correture value for the register }
  2920. {$ifdef i386}
  2921.                    { calc the correture value for the register }
  2922.                    for regi:=R_EAX to R_EDI do
  2923.                      begin
  2924.                         if (p^.procdefinition^.usedregisters and ($80 shr word(regi)))<>0 then
  2925.                           inc(reg_pushes[regi],t_times*2);
  2926.                      end;
  2927. {$endif}
  2928. {$ifdef m68k}
  2929.                   for regi:=R_D0 to R_A6 do
  2930.                     begin
  2931.                        if (p^.procdefinition^.usedregisters and ($800 shr word(regi)))<>0 then
  2932.                          inc(reg_pushes[regi],t_times*2);
  2933.                     end;
  2934. {$endif}
  2935.                 end
  2936.               else
  2937.                 begin
  2938.                    { procedure variable }
  2939.                    { die Typen der Parameter berechnen }
  2940.  
  2941.                    { procedure does a call }
  2942.                    procinfo.flags:=procinfo.flags or pi_do_call;
  2943.  
  2944. {$ifdef i386}
  2945.                    { calc the correture value for the register }
  2946.                    for regi:=R_EAX to R_EDI do
  2947.                      inc(reg_pushes[regi],t_times*2);
  2948. {$endif}
  2949. {$ifdef m68k}
  2950.                    { calc the correture value for the register }
  2951.                    for regi:=R_D0 to R_A6 do
  2952.                      inc(reg_pushes[regi],t_times*2);
  2953. {$endif}
  2954.                    if assigned(p^.left) then
  2955.                      begin
  2956.                         old_count_ref:=count_ref;
  2957.                         count_ref:=false;
  2958.                         firstcallparan(p^.left,nil);
  2959.                         count_ref:=old_count_ref;
  2960.                         if codegenerror then
  2961.                           exit;
  2962.                      end;
  2963.                    firstpass(p^.right);
  2964.  
  2965.                    { check the parameters }
  2966.                    pdc:=pprocvardef(p^.right^.resulttype)^.para1;
  2967.                    pt:=p^.left;
  2968.                    while assigned(pdc) and assigned(pt) do
  2969.                      begin
  2970.                         pt:=pt^.right;
  2971.                         pdc:=pdc^.next;
  2972.                      end;
  2973.                    if assigned(pt) or assigned(pdc) then
  2974.                     Message(parser_e_illegal_parameter_list);
  2975.  
  2976.                    { insert type conversions }
  2977.                    if assigned(p^.left) then
  2978.                      begin
  2979.                         old_count_ref:=count_ref;
  2980.                         count_ref:=true;
  2981.                         firstcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1);
  2982.                         count_ref:=old_count_ref;
  2983.                         if codegenerror then
  2984.                           exit;
  2985.                      end;
  2986.                    p^.resulttype:=pprocvardef(p^.right^.resulttype)^.retdef;
  2987.                    { this was missing , leads to a bug below if
  2988.                      the procvar is a function }
  2989.                    p^.procdefinition:=pprocdef(p^.right^.resulttype);
  2990.                 end;
  2991.          end; { not assigned(p^.procdefinition) }
  2992.  
  2993.          { get a register for the return value }
  2994.          if (p^.resulttype<>pdef(voiddef)) then
  2995.            begin
  2996.               { the constructor returns the result with the flags }
  2997.               if (p^.procdefinition^.options and poconstructor)<>0 then
  2998.                 begin
  2999.                    { extra handling of classes }
  3000.                    { p^.methodpointer should be assigned! }
  3001.                    if assigned(p^.methodpointer) and assigned(p^.methodpointer^.resulttype) and
  3002.                      (p^.methodpointer^.resulttype^.deftype=classrefdef) then
  3003.                      begin
  3004.                         p^.location.loc:=LOC_REGISTER;
  3005.                         p^.registers32:=1;
  3006.                      end
  3007.                    else
  3008.                      p^.location.loc:=LOC_FLAGS;
  3009.                 end
  3010.               else
  3011.                 begin
  3012. {$ifdef SUPPORT_MMX}
  3013.                    if (cs_mmx in aktswitches) and
  3014.                      is_mmx_able_array(p^.resulttype) then
  3015.                      begin
  3016.                         p^.location.loc:=LOC_MMXREGISTER;
  3017.                         p^.registersmmx:=1;
  3018.                      end
  3019.                    else
  3020. {$endif SUPPORT_MMX}
  3021.                    if ret_in_acc(p^.resulttype) then
  3022.                      begin
  3023.                         p^.location.loc:=LOC_REGISTER;
  3024.                         p^.registers32:=1;
  3025.                      end
  3026.                    else if (p^.resulttype^.deftype=floatdef) then
  3027.                      begin
  3028.                         p^.location.loc:=LOC_FPU;
  3029.                         p^.registersfpu:=1;
  3030.                      end
  3031.                 end;
  3032.            end;
  3033.  
  3034.          { if this is a call to a method calc the registers }
  3035.          if (p^.methodpointer<>nil) then
  3036.            begin
  3037.               case p^.methodpointer^.treetype of
  3038.                 { but only, if this is not a supporting node }
  3039.                 typen,hnewn : ;
  3040.                 else
  3041.                   begin
  3042.                      { R.Assign is not a constructor !!! }
  3043.                      { but for R^.Assign, R must be valid !! }
  3044.                      if ((p^.procdefinition^.options and poconstructor) <> 0) or
  3045.                         ((p^.methodpointer^.treetype=loadn) and
  3046.                         ((pobjectdef(p^.methodpointer^.resulttype)^.options and oo_hasvirtual) = 0)) then
  3047.                        must_be_valid:=false
  3048.                      else
  3049.                        must_be_valid:=true;
  3050.                      firstpass(p^.methodpointer);
  3051.                      p^.registersfpu:=max(p^.methodpointer^.registersfpu,p^.registersfpu);
  3052.                      p^.registers32:=max(p^.methodpointer^.registers32,p^.registers32);
  3053. {$ifdef SUPPORT_MMX}
  3054.                      p^.registersmmx:=max(p^.methodpointer^.registersmmx,p^.registersmmx);
  3055. {$endif SUPPORT_MMX}
  3056.                   end;
  3057.               end;
  3058.            end;
  3059.  
  3060.          { determine the registers of the procedure variable }
  3061.          if assigned(p^.right) then
  3062.            begin
  3063.               p^.registersfpu:=max(p^.right^.registersfpu,p^.registersfpu);
  3064.               p^.registers32:=max(p^.right^.registers32,p^.registers32);
  3065. {$ifdef SUPPORT_MMX}
  3066.               p^.registersmmx:=max(p^.right^.registersmmx,p^.registersmmx);
  3067. {$endif SUPPORT_MMX}
  3068.            end;
  3069.          { determine the registers of the procedure }
  3070.          if assigned(p^.left) then
  3071.            begin
  3072.               p^.registersfpu:=max(p^.left^.registersfpu,p^.registersfpu);
  3073.               p^.registers32:=max(p^.left^.registers32,p^.registers32);
  3074. {$ifdef SUPPORT_MMX}
  3075.               p^.registersmmx:=max(p^.left^.registersmmx,p^.registersmmx);
  3076. {$endif SUPPORT_MMX}
  3077.            end;
  3078.          if assigned(procs) then
  3079.            dispose(procs);
  3080.          must_be_valid:=store_valid;
  3081.       end;
  3082.  
  3083.     procedure firstfuncret(var p : ptree);
  3084.  
  3085.           begin
  3086. {$ifdef TEST_FUNCRET}
  3087.              p^.resulttype:=p^.retdef;
  3088.              p^.location.loc:=LOC_REFERENCE;
  3089.              if ret_in_param(p^.retdef) or
  3090.                 (@procinfo<>pprocinfo(p^.funcretprocinfo)) then
  3091.                p^.registers32:=1;
  3092. {$ifdef GDB}
  3093.          if must_be_valid and not pprocinfo(p^.funcretprocinfo)^.funcret_is_valid then
  3094.            note(uninitialized_function_return);
  3095.          if count_ref then pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true;
  3096. {$endif * GDB *}
  3097. {$else TEST_FUNCRET}
  3098.          p^.resulttype:=procinfo.retdef;
  3099.          p^.location.loc:=LOC_REFERENCE;
  3100.          if ret_in_param(procinfo.retdef) then
  3101.            p^.registers32:=1;
  3102. {$ifdef GDB}
  3103.          if must_be_valid and
  3104.            not(procinfo.funcret_is_valid) and
  3105.            ((procinfo.flags and pi_uses_asm)=0) then
  3106.            Message(sym_w_function_result_not_set);
  3107.          if count_ref then procinfo.funcret_is_valid:=true;
  3108. {$endif * GDB *}
  3109. {$endif TEST_FUNCRET}
  3110.           end;
  3111.  
  3112.  
  3113.     { intern inline suborutines }
  3114.     procedure firstinline(var p : ptree);
  3115.  
  3116.       var
  3117.          hp,hpp : ptree;
  3118.          isreal,store_valid,file_is_typed : boolean;
  3119.          convtyp : tconverttype;
  3120.  
  3121.       procedure do_lowhigh(adef : pdef);
  3122.  
  3123.         var
  3124.            v : longint;
  3125.            enum : penumsym;
  3126.  
  3127.         begin
  3128.            case Adef^.deftype of
  3129.              orddef:
  3130.                begin
  3131.                   if p^.inlinenumber=in_low_x then
  3132.                     v:=porddef(Adef)^.von
  3133.                   else
  3134.                     v:=porddef(Adef)^.bis;
  3135.                   hp:=genordinalconstnode(v,adef);
  3136.                   disposetree(p);
  3137.                   p:=hp;
  3138.                end;
  3139.              enumdef:
  3140.                begin
  3141.                   enum:=Penumdef(Adef)^.first;
  3142.                   if p^.inlinenumber=in_high_x then
  3143.                     while enum^.next<>nil do
  3144.                       enum:=enum^.next;
  3145.                   hp:=genenumnode(enum);
  3146.                   disposetree(p);
  3147.                   p:=hp;
  3148.                end
  3149.            end;
  3150.         end;
  3151.  
  3152.       begin
  3153.          { if we handle writeln; p^.left contains no valid address }
  3154.          if assigned(p^.left) then
  3155.            begin
  3156.               p^.registers32:=p^.left^.registers32;
  3157.               p^.registersfpu:=p^.left^.registersfpu;
  3158. {$ifdef SUPPORT_MMX}
  3159.               p^.registersmmx:=p^.left^.registersmmx;
  3160. {$endif SUPPORT_MMX}
  3161.               set_location(p^.location,p^.left^.location);
  3162.            end;
  3163.            store_valid:=must_be_valid;
  3164.            if not (p^.inlinenumber in [in_read_x,in_readln_x,in_sizeof_x,
  3165.                                        in_typeof_x,in_ord_x,
  3166.                                        in_reset_typedfile,in_rewrite_typedfile]) then
  3167.              must_be_valid:=true
  3168.              else must_be_valid:=false;
  3169.            case p^.inlinenumber of
  3170.              in_lo_word,in_hi_word:
  3171.                begin
  3172.                   if p^.registers32<1 then
  3173.                     p^.registers32:=1;
  3174.                   p^.resulttype:=u8bitdef;
  3175.                   p^.location.loc:=LOC_REGISTER;
  3176.                end;
  3177.              in_lo_long,in_hi_long:
  3178.                begin
  3179.                   if p^.registers32<1 then
  3180.                     p^.registers32:=1;
  3181.                   p^.resulttype:=u16bitdef;
  3182.                   p^.location.loc:=LOC_REGISTER;
  3183.                end;
  3184.              in_sizeof_x:
  3185.                begin
  3186.                   if p^.registers32<1 then
  3187.                     p^.registers32:=1;
  3188.                   p^.resulttype:=s32bitdef;
  3189.                   p^.location.loc:=LOC_REGISTER;
  3190.                end;
  3191.              in_typeof_x:
  3192.                begin
  3193.                   if p^.registers32<1 then
  3194.                     p^.registers32:=1;
  3195.                   p^.location.loc:=LOC_REGISTER;
  3196.                   p^.resulttype:=voidpointerdef;
  3197.                end;
  3198.              in_ord_x:
  3199.                begin
  3200.                   if (p^.left^.treetype=ordconstn) then
  3201.                     begin
  3202.                        hp:=genordinalconstnode(p^.left^.value,s32bitdef);
  3203.                        disposetree(p);
  3204.                        p:=hp;
  3205.                        firstpass(p);
  3206.                     end
  3207.                   else
  3208.                     begin
  3209.                        if (p^.left^.resulttype^.deftype=orddef) then
  3210.                          if (porddef(p^.left^.resulttype)^.typ=uchar) or
  3211.                             (porddef(p^.left^.resulttype)^.typ=bool8bit) then
  3212.                            begin
  3213.                               if porddef(p^.left^.resulttype)^.typ=bool8bit then
  3214.                                 begin
  3215.                                    hp:=gentypeconvnode(p^.left,u8bitdef);
  3216.                                    putnode(p);
  3217.                                    p:=hp;
  3218.                                    p^.convtyp:=tc_bool_2_u8bit;
  3219.                                    p^.explizit:=true;
  3220.                                    firstpass(p);
  3221.                                 end
  3222.                               else
  3223.                                 begin
  3224.                                    hp:=gentypeconvnode(p^.left,u8bitdef);
  3225.                                    putnode(p);
  3226.                                    p:=hp;
  3227.                                    p^.explizit:=true;
  3228.                                    firstpass(p);
  3229.                                 end;
  3230.                            end
  3231.                          { can this happen ? }
  3232.                          else if (porddef(p^.left^.resulttype)^.typ=uvoid) then
  3233.                            Message(sym_e_type_mismatch)
  3234.                          else
  3235.                            { all other orddef need no transformation }
  3236.                            begin
  3237.                               hp:=p^.left;
  3238.                               putnode(p);
  3239.                               p:=hp;
  3240.                            end
  3241.                        else if (p^.left^.resulttype^.deftype=enumdef) then
  3242.                          begin
  3243.                             hp:=gentypeconvnode(p^.left,s32bitdef);
  3244.                             putnode(p);
  3245.                             p:=hp;
  3246.                             p^.explizit:=true;
  3247.                             firstpass(p);
  3248.                          end
  3249.                        else
  3250.                          begin
  3251.                             { can anything else be ord() ?}
  3252.                             Message(sym_e_type_mismatch);
  3253.                          end;
  3254.                     end;
  3255.                end;
  3256.              in_chr_byte:
  3257.                begin
  3258.                   hp:=gentypeconvnode(p^.left,cchardef);
  3259.                   putnode(p);
  3260.                   p:=hp;
  3261.                   p^.explizit:=true;
  3262.                   firstpass(p);
  3263.                end;
  3264.              in_length_string:
  3265.                begin
  3266.                   p^.resulttype:=u8bitdef;
  3267.                   { String nach Stringkonvertierungen brauchen wir hier nicht }
  3268.                   if (p^.left^.treetype=typeconvn) and
  3269.                      (p^.left^.left^.resulttype^.deftype=stringdef) then
  3270.                     begin
  3271.                        hp:=p^.left^.left;
  3272.                        putnode(p^.left);
  3273.                        p^.left:=hp;
  3274.                     end;
  3275.  
  3276.                   { evalutes length of constant strings direct }
  3277.                   if (p^.left^.treetype=stringconstn) then
  3278.                     begin
  3279.                        hp:=genordinalconstnode(length(p^.left^.values^),s32bitdef);
  3280.                        disposetree(p);
  3281.                        firstpass(hp);
  3282.                        p:=hp;
  3283.                     end;
  3284.  
  3285.                end;
  3286.              in_assigned_x:
  3287.                begin
  3288.                   p^.resulttype:=booldef;
  3289.                   p^.location.loc:=LOC_FLAGS;
  3290.                end;
  3291.              in_pred_x,
  3292.              in_succ_x:
  3293.                begin
  3294.                   p^.resulttype:=p^.left^.resulttype;
  3295.                   p^.location.loc:=LOC_REGISTER;
  3296.                   if not is_ordinal(p^.resulttype) then
  3297.                      Message(sym_e_type_mismatch)
  3298.                   else
  3299.                     begin
  3300.                   if (p^.resulttype^.deftype=enumdef) and
  3301.                      (penumdef(p^.resulttype)^.has_jumps) then
  3302.                     begin
  3303.                       Message(parser_e_succ_and_pred_enums_with_assign_not_possible);
  3304.                       exit;
  3305.                     end;
  3306.                        if p^.left^.treetype=ordconstn then
  3307.                          begin
  3308.                             if p^.inlinenumber=in_pred_x then
  3309.                               hp:=genordinalconstnode(p^.left^.value+1,
  3310.                                 p^.left^.resulttype)
  3311.                             else
  3312.                               hp:=genordinalconstnode(p^.left^.value-1,
  3313.                                 p^.left^.resulttype);
  3314.                             disposetree(p);
  3315.                             firstpass(hp);
  3316.                             p:=hp;
  3317.                          end;
  3318.                     end;
  3319.                end;
  3320.              in_dec_dword,
  3321.              in_dec_word,
  3322.              in_dec_byte,
  3323.              in_inc_dword,
  3324.              in_inc_word,
  3325.              in_inc_byte :
  3326.                begin
  3327.                   p^.resulttype:=voiddef;
  3328.                   if p^.left^.location.loc<>LOC_REFERENCE then
  3329.                     Message(cg_e_illegal_expression);
  3330.                end;
  3331.             in_inc_x,
  3332.             in_dec_x:
  3333.               begin
  3334.                  p^.resulttype:=voiddef;
  3335.                  if assigned(p^.left) then
  3336.                    begin
  3337.                       firstcallparan(p^.left,nil);
  3338.                       { first param must be var }
  3339.                       if p^.left^.left^.location.loc<>LOC_REFERENCE then
  3340.                         Message(cg_e_illegal_expression);
  3341.                       { check type }
  3342.                       if (p^.left^.resulttype^.deftype=pointerdef) or
  3343.                         (p^.left^.resulttype^.deftype=enumdef) or
  3344.                         ( (p^.left^.resulttype^.deftype=orddef) and
  3345.                           (porddef(p^.left^.resulttype)^.typ in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit])
  3346.                         ) then
  3347.                         begin
  3348.                            { two paras ? }
  3349.                            if assigned(p^.left^.right) then
  3350.                              begin
  3351.                                 { insert a type conversion         }
  3352.                                 { the second param is always longint }
  3353.                                 p^.left^.right^.left:=gentypeconvnode(
  3354.                                   p^.left^.right^.left,
  3355.                                   s32bitdef);
  3356.                                 { check the type conversion }
  3357.                                 firstpass(p^.left^.right^.left);
  3358.                                 if assigned(p^.left^.right^.right) then
  3359.                                   Message(cg_e_illegal_expression);
  3360.                              end;
  3361.                         end
  3362.                       else
  3363.                         Message(sym_e_type_mismatch);
  3364.                    end
  3365.                  else
  3366.                    Message(sym_e_type_mismatch);
  3367.               end;
  3368.              in_read_x,
  3369.              in_readln_x,
  3370.              in_write_x,
  3371.              in_writeln_x :
  3372.                begin
  3373.                   { needs a call }
  3374.                   procinfo.flags:=procinfo.flags or pi_do_call;
  3375.                   p^.resulttype:=voiddef;
  3376.                   { we must know if it is a typed file or not }
  3377.                   { but we must first do the firstpass for it }
  3378.                   file_is_typed:=false;
  3379.                   if assigned(p^.left) then
  3380.                     begin
  3381.                        firstcallparan(p^.left,nil);
  3382.                        { now we can check }
  3383.                        hp:=p^.left;
  3384.                        while assigned(hp^.right) do
  3385.                          hp:=hp^.right;
  3386.                        { if resulttype is not assigned, then automatically }
  3387.                        { file is not typed.                                }
  3388.                        if assigned(hp) and assigned(hp^.resulttype) then
  3389.                          Begin
  3390.                            if (hp^.resulttype^.deftype=filedef) and
  3391.                             (pfiledef(hp^.resulttype)^.filetype=ft_typed) then
  3392.                            begin
  3393.                               file_is_typed:=true;
  3394.                               { test the type here
  3395.                                 so we can use a trick in cgi386 (PM) }
  3396.                               hpp:=p^.left;
  3397.                               while (hpp<>hp) do
  3398.                                 begin
  3399.                                    { should we allow type conversion ? (PM)
  3400.                                    if not isconvertable(hpp^.resulttype,
  3401.                                      pfiledef(hp^.resulttype)^.typed_as,convtyp,hpp^.treetype) then
  3402.                                      Message(sym_e_type_mismatch);
  3403.                                    if not(is_equal(hpp^.resulttype,pfiledef(hp^.resulttype)^.typed_as)) then
  3404.                                      begin
  3405.                                         hpp^.left:=gentypeconvnode(hpp^.left,pfiledef(hp^.resulttype)^.typed_as);
  3406.                                      end; }
  3407.                                    if not is_equal(hpp^.resulttype,pfiledef(hp^.resulttype)^.typed_as) then
  3408.                                      Message(sym_e_type_mismatch);
  3409.                                    hpp:=hpp^.right;
  3410.                                 end;
  3411.                               { once again for typeconversions }
  3412.                               firstcallparan(p^.left,nil);
  3413.                            end;
  3414.                          end; { endif assigned(hp) }
  3415.                        { insert type conversions for write(ln) }
  3416.                        if (not file_is_typed) and
  3417.                           ((p^.inlinenumber=in_write_x) or (p^.inlinenumber=in_writeln_x)) then
  3418.                          begin
  3419.                             hp:=p^.left;
  3420.                             while assigned(hp) do
  3421.                               begin
  3422.                                 if assigned(hp^.left^.resulttype) then
  3423.                                   begin
  3424.                                    if hp^.left^.resulttype^.deftype=floatdef then
  3425.                                      begin
  3426.                                         isreal:=true;
  3427.                                      end
  3428.                                    else if hp^.left^.resulttype^.deftype=orddef then
  3429.                                      case porddef(hp^.left^.resulttype)^.typ of
  3430.                                        u8bit,s8bit,
  3431.                                        u16bit,s16bit :
  3432.                                          hp^.left:=gentypeconvnode(hp^.left,s32bitdef);
  3433.                                        end
  3434.                                    { but we convert only if the first index<>0, because in this case }
  3435.                                    { we have a ASCIIZ string                                         }
  3436.                                    else if (hp^.left^.resulttype^.deftype=arraydef) and
  3437.                                            (parraydef(hp^.left^.resulttype)^.lowrange<>0) and
  3438.                                            (parraydef(hp^.left^.resulttype)^.definition^.deftype=orddef) and
  3439.                                            (porddef(parraydef(hp^.left^.resulttype)^.definition)^.typ=uchar) then
  3440.                                      hp^.left:=gentypeconvnode(hp^.left,cstringdef);
  3441.                                   end;
  3442.                                  hp:=hp^.right;
  3443.                               end;
  3444.                          end;
  3445.                        { nochmals alle Parameter bearbeiten }
  3446.                        firstcallparan(p^.left,nil);
  3447.                     end;
  3448.                end;
  3449.             in_settextbuf_file_x :
  3450.               begin
  3451.                  { warning here p^.left is the callparannode
  3452.                    not the argument directly }
  3453.                  { p^.left^.left is text var }
  3454.                  { p^.left^.right^.left is the buffer var }
  3455.                  { firstcallparan(p^.left,nil);
  3456.                    already done in firstcalln }
  3457.                  { now we know the type of buffer }
  3458.                  getsymonlyin(systemunit,'SETTEXTBUF');
  3459.                  hp:=gencallnode(pprocsym(srsym),systemunit);
  3460.                  hp^.left:=gencallparanode(
  3461.                    genordinalconstnode(p^.left^.left^.resulttype^.size,s32bitdef),p^.left);
  3462.                  putnode(p);
  3463.                  p:=hp;
  3464.                  firstpass(p);
  3465.               end;
  3466.              { the firstpass of the arg has been done in firstcalln ? }
  3467.              in_reset_typedfile,in_rewrite_typedfile :
  3468.                begin
  3469.                   procinfo.flags:=procinfo.flags or pi_do_call;
  3470.                   { to be sure the right definition is loaded }
  3471.                   p^.left^.resulttype:=nil;
  3472.                   firstload(p^.left);
  3473.                   p^.resulttype:=voiddef;
  3474.                end;
  3475.              in_str_x_string :
  3476.                begin
  3477.                   procinfo.flags:=procinfo.flags or pi_do_call;
  3478.                   p^.resulttype:=voiddef;
  3479.                   if assigned(p^.left) then
  3480.                     begin
  3481.                        hp:=p^.left^.right;
  3482.                        { first pass just the string for first local use }
  3483.                        must_be_valid:=false;
  3484.                        count_ref:=true;
  3485.                        p^.left^.right:=nil;
  3486.                        firstcallparan(p^.left,nil);
  3487.                        p^.left^.right:=hp;
  3488.                        must_be_valid:=true;
  3489.                        firstcallparan(p^.left,nil);
  3490.                        hp:=p^.left;
  3491.                        isreal:=false;
  3492.                        { valid string ? }
  3493.                        if not assigned(hp) or
  3494.                           (hp^.left^.resulttype^.deftype<>stringdef) or
  3495.                           (hp^.right=nil) or
  3496.                           (hp^.left^.location.loc<>LOC_REFERENCE) then
  3497.                          Message(cg_e_illegal_expression);
  3498.                        { !!!! check length of string }
  3499.  
  3500.                        while assigned(hp^.right) do hp:=hp^.right;
  3501.  
  3502.                        { check and convert the first param }
  3503.                        if hp^.is_colon_para then
  3504.                          Message(cg_e_illegal_expression)
  3505.                        else if hp^.resulttype^.deftype=orddef then
  3506.                          case porddef(hp^.left^.resulttype)^.typ of
  3507.                            u8bit,s8bit,
  3508.                            u16bit,s16bit :
  3509.                              hp^.left:=gentypeconvnode(hp^.left,s32bitdef);
  3510.                          end
  3511.                        else if hp^.resulttype^.deftype=floatdef then
  3512.                          begin
  3513.                             isreal:=true;
  3514.                          end
  3515.                        else Message(cg_e_illegal_expression);
  3516.  
  3517.                        { some format options ? }
  3518.                        hp:=p^.left^.right;
  3519.                        if assigned(hp) and hp^.is_colon_para then
  3520.                          begin
  3521.                             hp^.left:=gentypeconvnode(hp^.left,s32bitdef);
  3522.                             hp:=hp^.right;
  3523.                          end;
  3524.                        if assigned(hp) and hp^.is_colon_para then
  3525.                          begin
  3526.                             if isreal then
  3527.                               hp^.left:=gentypeconvnode(hp^.left,s32bitdef)
  3528.                             else
  3529.                               Message(parser_e_illegal_colon_qualifier);
  3530.                             hp:=hp^.right;
  3531.                          end;
  3532.  
  3533.                        { for first local use }
  3534.                        must_be_valid:=false;
  3535.                        count_ref:=true;
  3536.                        if assigned(hp) then
  3537.                          firstcallparan(hp,nil);
  3538.                     end
  3539.                   else
  3540.                     Message(parser_e_illegal_parameter_list);
  3541.                   { check params once more }
  3542.                   if codegenerror then
  3543.                     exit;
  3544.                   must_be_valid:=true;
  3545.                   firstcallparan(p^.left,nil);
  3546.                end;
  3547.              in_low_x,in_high_x:
  3548.                begin
  3549.                   if p^.left^.treetype in [typen,loadn] then
  3550.                     begin
  3551.                        case p^.left^.resulttype^.deftype of
  3552.                   orddef,enumdef:
  3553.                 begin
  3554.                                do_lowhigh(p^.left^.resulttype);
  3555.                                firstpass(p);
  3556.                             end;
  3557.               setdef:
  3558.                         begin
  3559.                                do_lowhigh(Psetdef(p^.left^.resulttype)^.setof);
  3560.                                firstpass(p);
  3561.                             end;
  3562.                          arraydef:
  3563.                 begin
  3564.                               if is_open_array(p^.left^.resulttype) then
  3565.                                 begin
  3566.                                    if p^.inlinenumber=in_low_x then
  3567.                                      begin
  3568.                                         hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef);
  3569.                                         disposetree(p);
  3570.                                         p:=hp;
  3571.                                         firstpass(p);
  3572.                                      end
  3573.                                    else
  3574.                                      begin
  3575.                                         p^.resulttype:=s32bitdef;
  3576.                                         p^.registers32:=max(1,
  3577.                                           p^.registers32);
  3578.                                         p^.location.loc:=LOC_REGISTER;
  3579.                                      end;
  3580.                                 end
  3581.                               else
  3582.                                 begin
  3583.                                    if p^.inlinenumber=in_low_x then
  3584.                                      hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef)
  3585.                                    else
  3586.                                      hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.highrange,s32bitdef);
  3587.                                    disposetree(p);
  3588.                                    p:=hp;
  3589.                                    firstpass(p);
  3590.                                 end;
  3591.                            end;
  3592.                          stringdef:
  3593.                            begin
  3594.                               if p^.inlinenumber=in_low_x then
  3595.                                 hp:=genordinalconstnode(0,u8bitdef)
  3596.                               else
  3597.                                 hp:=genordinalconstnode(Pstringdef(p^.left^.resulttype)^.len,u8bitdef);
  3598.                               disposetree(p);
  3599.                               p:=hp;
  3600.                               firstpass(p);
  3601.                            end;
  3602.                          else
  3603.                            Message(sym_e_type_mismatch);
  3604.                          end;
  3605.                     end
  3606.                   else
  3607.                     Message(parser_e_varid_or_typeid_expected);
  3608.                end
  3609.                  else internalerror(8);
  3610.              end;
  3611.            must_be_valid:=store_valid;
  3612.        end;
  3613.  
  3614.     procedure firstsubscriptn(var p : ptree);
  3615.  
  3616.       begin
  3617.          firstpass(p^.left);
  3618.  
  3619.          if codegenerror then
  3620.            exit;
  3621.  
  3622.          p^.resulttype:=p^.vs^.definition;
  3623.          if count_ref and not must_be_valid then
  3624.            if (p^.vs^.properties and sp_protected)<>0 then
  3625.              Message(parser_e_cant_write_protected_member);
  3626.          p^.registers32:=p^.left^.registers32;
  3627.          p^.registersfpu:=p^.left^.registersfpu;
  3628. {$ifdef SUPPORT_MMX}
  3629.          p^.registersmmx:=p^.left^.registersmmx;
  3630. {$endif SUPPORT_MMX}
  3631.          { classes must be dereferenced implicit }
  3632.          if (p^.left^.resulttype^.deftype=objectdef) and
  3633.            pobjectdef(p^.left^.resulttype)^.isclass then
  3634.            begin
  3635.               if p^.registers32=0 then
  3636.                 p^.registers32:=1;
  3637.               p^.location.loc:=LOC_REFERENCE;
  3638.            end
  3639.          else
  3640.            begin
  3641.               if (p^.left^.location.loc<>LOC_MEM) and
  3642.                 (p^.left^.location.loc<>LOC_REFERENCE) then
  3643.                 Message(cg_e_illegal_expression);
  3644.               set_location(p^.location,p^.left^.location);
  3645.            end;
  3646.       end;
  3647.  
  3648.     procedure firstselfn(var p : ptree);
  3649.  
  3650.       begin
  3651.          if (p^.resulttype^.deftype=classrefdef) or
  3652.            ((p^.resulttype^.deftype=objectdef)
  3653.              and pobjectdef(p^.resulttype)^.isclass
  3654.            ) then
  3655.            p^.location.loc:=LOC_REGISTER
  3656.          else
  3657.            p^.location.loc:=LOC_REFERENCE;
  3658.       end;
  3659.  
  3660.     procedure firsttypen(var p : ptree);
  3661.  
  3662.       begin
  3663. {       DM: Why not allowed? For example: low(word) results in a type
  3664.         id of word.
  3665.         error(typeid_here_not_allowed);}
  3666.       end;
  3667.  
  3668.     procedure firsthnewn(var p : ptree);
  3669.  
  3670.       begin
  3671.       end;
  3672.  
  3673.     procedure firsthdisposen(var p : ptree);
  3674.  
  3675.       begin
  3676.          firstpass(p^.left);
  3677.  
  3678.          if codegenerror then
  3679.            exit;
  3680.  
  3681.          p^.registers32:=p^.left^.registers32;
  3682.          p^.registersfpu:=p^.left^.registersfpu;
  3683. {$ifdef SUPPORT_MMX}
  3684.          p^.registersmmx:=p^.left^.registersmmx;
  3685. {$endif SUPPORT_MMX}
  3686.          if p^.registers32<1 then
  3687.            p^.registers32:=1;
  3688.          {
  3689.          if p^.left^.location.loc<>LOC_REFERENCE then
  3690.            Message(cg_e_illegal_expression);
  3691.          }
  3692.          p^.location.loc:=LOC_REFERENCE;
  3693.          p^.resulttype:=ppointerdef(p^.left^.resulttype)^.definition;
  3694.       end;
  3695.  
  3696.     procedure firstnewn(var p : ptree);
  3697.  
  3698.       begin
  3699.          { Standardeinleitung }
  3700.          firstpass(p^.left);
  3701.  
  3702.          if codegenerror then
  3703.            exit;
  3704.          p^.registers32:=p^.left^.registers32;
  3705.          p^.registersfpu:=p^.left^.registersfpu;
  3706. {$ifdef SUPPORT_MMX}
  3707.          p^.registersmmx:=p^.left^.registersmmx;
  3708. {$endif SUPPORT_MMX}
  3709.          { result type is already set }
  3710.          procinfo.flags:=procinfo.flags or pi_do_call;
  3711.          p^.location.loc:=LOC_REGISTER;
  3712.       end;
  3713.  
  3714.     procedure firstsimplenewdispose(var p : ptree);
  3715.  
  3716.       begin
  3717.          { this cannot be in a register !! }
  3718.          make_not_regable(p^.left);
  3719.  
  3720.          firstpass(p^.left);
  3721.  
  3722.          { check the type }
  3723.          if (p^.left^.resulttype=nil) or (p^.left^.resulttype^.deftype<>pointerdef) then
  3724.            Message(parser_e_pointer_type_expected);
  3725.  
  3726.          if (p^.left^.location.loc<>LOC_REFERENCE) {and
  3727.             (p^.left^.location.loc<>LOC_CREGISTER)} then
  3728.            Message(cg_e_illegal_expression);
  3729.  
  3730.          p^.registers32:=p^.left^.registers32;
  3731.          p^.registersfpu:=p^.left^.registersfpu;
  3732. {$ifdef SUPPORT_MMX}
  3733.          p^.registersmmx:=p^.left^.registersmmx;
  3734. {$endif SUPPORT_MMX}
  3735.          p^.resulttype:=voiddef;
  3736.          procinfo.flags:=procinfo.flags or pi_do_call;
  3737.       end;
  3738.  
  3739.     procedure firstsetcons(var p : ptree);
  3740.  
  3741.       var
  3742.          hp : ptree;
  3743.  
  3744.       begin
  3745.          p^.location.loc:=LOC_MEM;
  3746.          hp:=p^.left;
  3747.          { is done by getnode*
  3748.          p^.registers32:=0;
  3749.          p^.registersfpu:=0;
  3750.          }
  3751.          while assigned(hp) do
  3752.            begin
  3753.               firstpass(hp^.left);
  3754.  
  3755.               if codegenerror then
  3756.                 exit;
  3757.  
  3758.               p^.registers32:=max(p^.registers32,hp^.left^.registers32);
  3759.               p^.registersfpu:=max(p^.registersfpu,hp^.left^.registersfpu);;
  3760. {$ifdef SUPPORT_MMX}
  3761.               p^.registersmmx:=max(p^.registersmmx,hp^.left^.registersmmx);
  3762. {$endif SUPPORT_MMX}
  3763.               hp:=hp^.right;
  3764.            end;
  3765.          { result type is already set }
  3766.       end;
  3767.  
  3768.     procedure firstin(var p : ptree);
  3769.  
  3770.       begin
  3771.          p^.location.loc:=LOC_FLAGS;
  3772.          p^.resulttype:=booldef;
  3773.  
  3774.          firstpass(p^.right);
  3775.          if codegenerror then
  3776.            exit;
  3777.  
  3778.          if p^.right^.resulttype^.deftype<>setdef then
  3779.           Message(sym_e_set_expected);
  3780.  
  3781.          firstpass(p^.left);
  3782.          if codegenerror then
  3783.            exit;
  3784.  
  3785.          p^.left:=gentypeconvnode(p^.left,psetdef(p^.right^.resulttype)^.setof);
  3786.  
  3787.          firstpass(p^.left);
  3788.          if codegenerror then
  3789.            exit;
  3790.  
  3791.          p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  3792.          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  3793. {$ifdef SUPPORT_MMX}
  3794.          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  3795. {$endif SUPPORT_MMX}
  3796.          { this is not allways true due to optimization }
  3797.          { but if we don't set this we get problems with optimizing self code }
  3798.          if psetdef(p^.right^.resulttype)^.settype<>smallset then
  3799.            procinfo.flags:=procinfo.flags or pi_do_call;
  3800.       end;
  3801.  
  3802.     { !!!!!!!!!!!! unused }
  3803.     procedure firstexpr(var p : ptree);
  3804.  
  3805.       begin
  3806.          firstpass(p^.left);
  3807.          if codegenerror then
  3808.            exit;
  3809.          p^.registers32:=p^.left^.registers32;
  3810.          p^.registersfpu:=p^.left^.registersfpu;
  3811. {$ifdef SUPPORT_MMX}
  3812.          p^.registersmmx:=p^.left^.registersmmx;
  3813. {$endif SUPPORT_MMX}
  3814.          if (cs_extsyntax in aktswitches) and (p^.left^.resulttype<>pdef(voiddef)) then
  3815.            Message(cg_e_illegal_expression);
  3816.       end;
  3817.  
  3818.     procedure firstblock(var p : ptree);
  3819.  
  3820.       var
  3821.          hp : ptree;
  3822.          count : longint;
  3823.  
  3824.       begin
  3825.          count:=0;
  3826.          hp:=p^.left;
  3827.          while assigned(hp) do
  3828.            begin
  3829.               if cs_maxoptimieren in aktswitches then
  3830.                 begin
  3831.                    { Codeumstellungen }
  3832.  
  3833.                    { Funktionsresultate an exit anh„ngen }
  3834.                    { this is wrong for string or other complex
  3835.                      result types !!! }
  3836.                    if ret_in_acc(procinfo.retdef) and
  3837.                       assigned(hp^.left) and
  3838.                       (hp^.left^.right^.treetype=exitn) and
  3839.                       (hp^.right^.treetype=assignn) and
  3840.                       (hp^.right^.left^.treetype=funcretn) then
  3841.                       begin
  3842.                          if assigned(hp^.left^.right^.left) then
  3843.                            Message(cg_n_inefficient_code)
  3844.                          else
  3845.                            begin
  3846.                               hp^.left^.right^.left:=getcopy(hp^.right^.right);
  3847.                               disposetree(hp^.right);
  3848.                               hp^.right:=nil;
  3849.                            end;
  3850.                       end
  3851.                    { warning if unreachable code occurs and elimate this }
  3852.                                    else if (hp^.right^.treetype in
  3853.                                         [exitn,breakn,continuen,goton]) and
  3854.                                         assigned(hp^.left) and
  3855.                                         (hp^.left^.treetype<>labeln) then
  3856.                                                  begin
  3857.                                                         { use correct line number }
  3858.                                                         current_module^.current_inputfile:=hp^.left^.inputfile;
  3859.                                                         current_module^.current_inputfile^.line_no:=hp^.left^.line;
  3860.  
  3861.                                                         disposetree(hp^.left);
  3862.                             hp^.left:=nil;
  3863.                             Message(cg_w_unreachable_code);
  3864.  
  3865.                             { old lines }
  3866.                             current_module^.current_inputfile:=hp^.right^.inputfile;
  3867.                             current_module^.current_inputfile^.line_no:=hp^.right^.line;
  3868.                          end;
  3869.                 end;
  3870.               if assigned(hp^.right) then
  3871.                 begin
  3872.                    cleartempgen;
  3873.                    firstpass(hp^.right);
  3874.                    if codegenerror then
  3875.                      exit;
  3876.  
  3877.                    hp^.registers32:=hp^.right^.registers32;
  3878.                    hp^.registersfpu:=hp^.right^.registersfpu;
  3879. {$ifdef SUPPORT_MMX}
  3880.                    hp^.registersmmx:=hp^.right^.registersmmx;
  3881. {$endif SUPPORT_MMX}
  3882.                 end
  3883.               else
  3884.                 hp^.registers32:=0;
  3885.  
  3886.               if hp^.registers32>p^.registers32 then
  3887.                 p^.registers32:=hp^.registers32;
  3888.               if hp^.registersfpu>p^.registersfpu then
  3889.                 p^.registersfpu:=hp^.registersfpu;
  3890. {$ifdef SUPPORT_MMX}
  3891.               if hp^.registersmmx>p^.registersmmx then
  3892.                 p^.registersmmx:=hp^.registersmmx;
  3893. {$endif}
  3894.               inc(count);
  3895.               hp:=hp^.left;
  3896.            end;
  3897.          { p^.registers32:=round(p^.registers32/count); }
  3898.       end;
  3899.  
  3900.     procedure first_while_repeat(var p : ptree);
  3901.  
  3902.       var
  3903.          old_t_times : longint;
  3904.  
  3905.       begin
  3906.          old_t_times:=t_times;
  3907.  
  3908.                  { Registergewichtung bestimmen }
  3909.          if not(cs_littlesize in aktswitches ) then
  3910.            t_times:=t_times*8;
  3911.  
  3912.          cleartempgen;
  3913.          must_be_valid:=true;
  3914.          firstpass(p^.left);
  3915.          if codegenerror then
  3916.            exit;
  3917.          if not((p^.left^.resulttype^.deftype=orddef) and
  3918.             (porddef(p^.left^.resulttype)^.typ=bool8bit)) then
  3919.             begin
  3920.                Message(sym_e_type_mismatch);
  3921.                exit;
  3922.             end;
  3923.  
  3924.          p^.registers32:=p^.left^.registers32;
  3925.          p^.registersfpu:=p^.left^.registersfpu;
  3926. {$ifdef SUPPORT_MMX}
  3927.          p^.registersmmx:=p^.left^.registersmmx;
  3928. {$endif SUPPORT_MMX}
  3929.  
  3930.          { loop instruction }
  3931.          if assigned(p^.right) then
  3932.            begin
  3933.               cleartempgen;
  3934.               firstpass(p^.right);
  3935.               if codegenerror then
  3936.                 exit;
  3937.  
  3938.               if p^.registers32<p^.right^.registers32 then
  3939.                 p^.registers32:=p^.right^.registers32;
  3940.               if p^.registersfpu<p^.right^.registersfpu then
  3941.                 p^.registersfpu:=p^.right^.registersfpu;
  3942. {$ifdef SUPPORT_MMX}
  3943.               if p^.registersmmx<p^.right^.registersmmx then
  3944.                 p^.registersmmx:=p^.right^.registersmmx;
  3945. {$endif SUPPORT_MMX}
  3946.            end;
  3947.  
  3948.          t_times:=old_t_times;
  3949.       end;
  3950.  
  3951.     procedure firstif(var p : ptree);
  3952.  
  3953.       var
  3954.          old_t_times : longint;
  3955.          hp : ptree;
  3956.  
  3957.       begin
  3958.          old_t_times:=t_times;
  3959.  
  3960.          cleartempgen;
  3961.          must_be_valid:=true;
  3962.          firstpass(p^.left);
  3963.          if codegenerror then
  3964.            exit;
  3965.          if not((p^.left^.resulttype^.deftype=orddef) and
  3966.             (porddef(p^.left^.resulttype)^.typ=bool8bit)) then
  3967.             begin
  3968.                Message(sym_e_type_mismatch);
  3969.                exit;
  3970.             end;
  3971.  
  3972.          p^.registers32:=p^.left^.registers32;
  3973.          p^.registersfpu:=p^.left^.registersfpu;
  3974. {$ifdef SUPPORT_MMX}
  3975.          p^.registersmmx:=p^.left^.registersmmx;
  3976. {$endif SUPPORT_MMX}
  3977.  
  3978.          { determines registers weigths }
  3979.          if not(cs_littlesize in aktswitches ) then
  3980.            t_times:=t_times div 2;
  3981.          if t_times=0 then
  3982.            t_times:=1;
  3983.  
  3984.          { if path }
  3985.          if assigned(p^.right) then
  3986.            begin
  3987.               cleartempgen;
  3988.               firstpass(p^.right);
  3989.               if codegenerror then
  3990.                 exit;
  3991.  
  3992.               if p^.registers32<p^.right^.registers32 then
  3993.                 p^.registers32:=p^.right^.registers32;
  3994.               if p^.registersfpu<p^.right^.registersfpu then
  3995.                 p^.registersfpu:=p^.right^.registersfpu;
  3996. {$ifdef SUPPORT_MMX}
  3997.               if p^.registersmmx<p^.right^.registersmmx then
  3998.                 p^.registersmmx:=p^.right^.registersmmx;
  3999. {$endif SUPPORT_MMX}
  4000.            end;
  4001.  
  4002.          { else path }
  4003.          if assigned(p^.t1) then
  4004.            begin
  4005.               cleartempgen;
  4006.               firstpass(p^.t1);
  4007.               if codegenerror then
  4008.                 exit;
  4009.  
  4010.               if p^.registers32<p^.t1^.registers32 then
  4011.                 p^.registers32:=p^.t1^.registers32;
  4012.               if p^.registersfpu<p^.t1^.registersfpu then
  4013.                 p^.registersfpu:=p^.t1^.registersfpu;
  4014. {$ifdef SUPPORT_MMX}
  4015.               if p^.registersmmx<p^.t1^.registersmmx then
  4016.                 p^.registersmmx:=p^.t1^.registersmmx;
  4017. {$endif SUPPORT_MMX}
  4018.            end;
  4019.          if p^.left^.treetype=ordconstn then
  4020.            begin
  4021.               { optimize }
  4022.               if p^.left^.value=1 then
  4023.                 begin
  4024.                    disposetree(p^.left);
  4025.                    hp:=p^.right;
  4026.                    disposetree(p^.t1);
  4027.                    { we cannot set p to nil !!! }
  4028.                    if assigned(hp) then
  4029.                      begin
  4030.                         putnode(p);
  4031.                         p:=hp;
  4032.                      end
  4033.                    else
  4034.                      begin
  4035.                         p^.left:=nil;
  4036.                         p^.t1:=nil;
  4037.                         p^.treetype:=nothingn;
  4038.                      end;
  4039.                 end
  4040.               else
  4041.                 begin
  4042.                    disposetree(p^.left);
  4043.                    hp:=p^.t1;
  4044.                    disposetree(p^.right);
  4045.                    { we cannot set p to nil !!! }
  4046.                    if assigned(hp) then
  4047.                      begin
  4048.                         putnode(p);
  4049.                         p:=hp;
  4050.                      end
  4051.                    else
  4052.                      begin
  4053.                         p^.left:=nil;
  4054.                         p^.right:=nil;
  4055.                         p^.treetype:=nothingn;
  4056.                      end;
  4057.                 end;
  4058.            end;
  4059.  
  4060.          t_times:=old_t_times;
  4061.       end;
  4062.  
  4063.     procedure firstexitn(var p : ptree);
  4064.  
  4065.       begin
  4066.          if assigned(p^.left) then
  4067.            begin
  4068.               firstpass(p^.left);
  4069.               p^.registers32:=p^.left^.registers32;
  4070.               p^.registersfpu:=p^.left^.registersfpu;
  4071. {$ifdef SUPPORT_MMX}
  4072.               p^.registersmmx:=p^.left^.registersmmx;
  4073. {$endif SUPPORT_MMX}
  4074.            end;
  4075.       end;
  4076.  
  4077.     procedure firstfor(var p : ptree);
  4078.  
  4079.       var
  4080.          old_t_times : longint;
  4081.  
  4082.       begin
  4083.          { Registergewichtung bestimmen
  4084.            (nicht genau), }
  4085.          old_t_times:=t_times;
  4086.          if not(cs_littlesize in aktswitches ) then
  4087.            t_times:=t_times*8;
  4088.  
  4089.          cleartempgen;
  4090.          if p^.t1<>nil then
  4091.            firstpass(p^.t1);
  4092.  
  4093.          p^.registers32:=p^.t1^.registers32;
  4094.          p^.registersfpu:=p^.t1^.registersfpu;
  4095. {$ifdef SUPPORT_MMX}
  4096.          p^.registersmmx:=p^.left^.registersmmx;
  4097. {$endif SUPPORT_MMX}
  4098.  
  4099.          if p^.left^.treetype<>assignn then
  4100.            Message(cg_e_illegal_expression);
  4101.  
  4102.          { Laufvariable retten }
  4103.          p^.t2:=getcopy(p^.left^.left);
  4104.  
  4105.          { Check count var }
  4106.          if (p^.t2^.treetype<>loadn) then
  4107.           Message(cg_e_illegal_count_var);
  4108.  
  4109.          if (not(is_ordinal(p^.t2^.resulttype))) then
  4110.           Message(parser_e_ordinal_expected);
  4111.  
  4112.          cleartempgen;
  4113.          must_be_valid:=false;
  4114.          firstpass(p^.left);
  4115.          must_be_valid:=true;
  4116.          if p^.left^.registers32>p^.registers32 then
  4117.            p^.registers32:=p^.left^.registers32;
  4118.          if p^.left^.registersfpu>p^.registersfpu then
  4119.            p^.registersfpu:=p^.left^.registersfpu;
  4120. {$ifdef SUPPORT_MMX}
  4121.          if p^.left^.registersmmx>p^.registersmmx then
  4122.            p^.registersmmx:=p^.left^.registersmmx;
  4123. {$endif SUPPORT_MMX}
  4124.          cleartempgen;
  4125.          firstpass(p^.t2);
  4126.          if p^.t2^.registers32>p^.registers32 then
  4127.            p^.registers32:=p^.t2^.registers32;
  4128.          if p^.t2^.registersfpu>p^.registersfpu then
  4129.            p^.registersfpu:=p^.t2^.registersfpu;
  4130. {$ifdef SUPPORT_MMX}
  4131.          if p^.t2^.registersmmx>p^.registersmmx then
  4132.            p^.registersmmx:=p^.t2^.registersmmx;
  4133. {$endif SUPPORT_MMX}
  4134.  
  4135.          cleartempgen;
  4136.          firstpass(p^.right);
  4137.          if p^.right^.treetype<>ordconstn then
  4138.            begin
  4139.               p^.right:=gentypeconvnode(p^.right,p^.t2^.resulttype);
  4140.               cleartempgen;
  4141.               firstpass(p^.right);
  4142.            end;
  4143.  
  4144.          if p^.right^.registers32>p^.registers32 then
  4145.            p^.registers32:=p^.right^.registers32;
  4146.          if p^.right^.registersfpu>p^.registersfpu then
  4147.            p^.registersfpu:=p^.right^.registersfpu;
  4148. {$ifdef SUPPORT_MMX}
  4149.          if p^.right^.registersmmx>p^.registersmmx then
  4150.            p^.registersmmx:=p^.right^.registersmmx;
  4151. {$endif SUPPORT_MMX}
  4152.          t_times:=old_t_times;
  4153.       end;
  4154.  
  4155.     procedure firstasm(var p : ptree);
  4156.  
  4157.       begin
  4158.          { it's a f... to determine the used registers }
  4159.          { should be done by getnode
  4160.            I think also, that all values should be set to their maximum (FK)
  4161.          p^.registers32:=0;
  4162.          p^.registersfpu:=0;
  4163.          p^.registersmmx:=0;
  4164.          }
  4165.          procinfo.flags:=procinfo.flags or pi_uses_asm;
  4166.       end;
  4167.  
  4168.     procedure firstgoto(var p : ptree);
  4169.  
  4170.       begin
  4171.          {
  4172.          p^.registers32:=0;
  4173.          p^.registersfpu:=0;
  4174.          }
  4175.          p^.resulttype:=voiddef;
  4176.       end;
  4177.  
  4178.     procedure firstlabel(var p : ptree);
  4179.  
  4180.       begin
  4181.          cleartempgen;
  4182.          firstpass(p^.left);
  4183.          p^.registers32:=p^.left^.registers32;
  4184.          p^.registersfpu:=p^.left^.registersfpu;
  4185. {$ifdef SUPPORT_MMX}
  4186.          p^.registersmmx:=p^.left^.registersmmx;
  4187. {$endif SUPPORT_MMX}
  4188.          p^.resulttype:=voiddef;
  4189.       end;
  4190.  
  4191.     procedure firstcase(var p : ptree);
  4192.  
  4193.       var
  4194.          old_t_times : longint;
  4195.          hp : ptree;
  4196.  
  4197.       begin
  4198.          { evalutes the case expression }
  4199.          cleartempgen;
  4200.          must_be_valid:=true;
  4201.          firstpass(p^.left);
  4202.          if codegenerror then
  4203.            exit;
  4204.          p^.registers32:=p^.left^.registers32;
  4205.          p^.registersfpu:=p^.left^.registersfpu;
  4206. {$ifdef SUPPORT_MMX}
  4207.          p^.registersmmx:=p^.left^.registersmmx;
  4208. {$endif SUPPORT_MMX}
  4209.  
  4210.          { walk through all instructions }
  4211.  
  4212.          {   estimates the repeat of each instruction }
  4213.          old_t_times:=t_times;
  4214.          if not(cs_littlesize in aktswitches ) then
  4215.            begin
  4216.               t_times:=t_times div case_count_labels(p^.nodes);
  4217.               if t_times<1 then
  4218.                 t_times:=1;
  4219.            end;
  4220.          {   first case }
  4221.          hp:=p^.right;
  4222.          while assigned(hp) do
  4223.            begin
  4224.               cleartempgen;
  4225.               firstpass(hp^.right);
  4226.  
  4227.               { searchs max registers }
  4228.               if hp^.right^.registers32>p^.registers32 then
  4229.                 p^.registers32:=hp^.right^.registers32;
  4230.               if hp^.right^.registersfpu>p^.registersfpu then
  4231.                 p^.registersfpu:=hp^.right^.registersfpu;
  4232. {$ifdef SUPPORT_MMX}
  4233.               if hp^.right^.registersmmx>p^.registersmmx then
  4234.                 p^.registersmmx:=hp^.right^.registersmmx;
  4235. {$endif SUPPORT_MMX}
  4236.  
  4237.               hp:=hp^.left;
  4238.            end;
  4239.  
  4240.          { may be handle else tree }
  4241.          if assigned(p^.elseblock) then
  4242.            begin
  4243.               cleartempgen;
  4244.               firstpass(p^.elseblock);
  4245.               if codegenerror then
  4246.                 exit;
  4247.               if p^.registers32<p^.elseblock^.registers32 then
  4248.                 p^.registers32:=p^.elseblock^.registers32;
  4249.               if p^.registersfpu<p^.elseblock^.registersfpu then
  4250.                 p^.registersfpu:=p^.elseblock^.registersfpu;
  4251. {$ifdef SUPPORT_MMX}
  4252.               if p^.registersmmx<p^.elseblock^.registersmmx then
  4253.                 p^.registersmmx:=p^.elseblock^.registersmmx;
  4254. {$endif SUPPORT_MMX}
  4255.            end;
  4256.          t_times:=old_t_times;
  4257.  
  4258.          { there is one register required for the case expression }
  4259.          if p^.registers32<1 then p^.registers32:=1;
  4260.       end;
  4261.  
  4262.     procedure firsttryexcept(var p : ptree);
  4263.  
  4264.       begin
  4265.       end;
  4266.  
  4267.     procedure firsttryfinally(var p : ptree);
  4268.  
  4269.       begin
  4270.       end;
  4271.  
  4272.     procedure firstis(var p : ptree);
  4273.  
  4274.       begin
  4275.          firstpass(p^.left);
  4276.          firstpass(p^.right);
  4277.  
  4278.          if (p^.right^.resulttype^.deftype<>classrefdef) then
  4279.            Message(sym_e_type_mismatch);
  4280.          if codegenerror then
  4281.            exit;
  4282.  
  4283.          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  4284.          p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  4285. {$ifdef SUPPORT_MMX}
  4286.          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  4287. {$endif SUPPORT_MMX}
  4288.  
  4289.          { left must be a class }
  4290.          if (p^.left^.resulttype^.deftype<>objectdef) or
  4291.            not(pobjectdef(p^.left^.resulttype)^.isclass) then
  4292.            Message(sym_e_type_mismatch);
  4293.  
  4294.          { the operands must be related }
  4295.          if (not(pobjectdef(p^.left^.resulttype)^.isrelated(
  4296.            pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)))) and
  4297.            (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.isrelated(
  4298.            pobjectdef(p^.left^.resulttype)))) then
  4299.            Message(sym_e_type_mismatch);
  4300.  
  4301.          p^.location.loc:=LOC_FLAGS;
  4302.          p^.resulttype:=booldef;
  4303.       end;
  4304.  
  4305.     procedure firstas(var p : ptree);
  4306.  
  4307.       begin
  4308.          firstpass(p^.right);
  4309.          firstpass(p^.left);
  4310.          if (p^.right^.resulttype^.deftype<>classrefdef) then
  4311.            Message(sym_e_type_mismatch);
  4312.  
  4313.          if codegenerror then
  4314.            exit;
  4315.  
  4316.          p^.registersfpu:=max(p^.left^.registersfpu,p^.left^.registersfpu);
  4317.          p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  4318. {$ifdef SUPPORT_MMX}
  4319.          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  4320. {$endif SUPPORT_MMX}
  4321.  
  4322.          { left must be a class }
  4323.          if (p^.left^.resulttype^.deftype<>objectdef) or
  4324.            not(pobjectdef(p^.left^.resulttype)^.isclass) then
  4325.            Message(sym_e_type_mismatch);
  4326.  
  4327.          { the operands must be related }
  4328.          if (not(pobjectdef(p^.left^.resulttype)^.isrelated(
  4329.            pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)))) and
  4330.            (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.isrelated(
  4331.            pobjectdef(p^.left^.resulttype)))) then
  4332.            Message(sym_e_type_mismatch);
  4333.  
  4334.          p^.location:=p^.left^.location;
  4335.          p^.resulttype:=pclassrefdef(p^.right^.resulttype)^.definition;
  4336.       end;
  4337.  
  4338.     procedure firstloadvmt(var p : ptree);
  4339.  
  4340.       begin
  4341.          { resulttype must be set !
  4342.          p^.registersfpu:=0;
  4343.          }
  4344.          p^.registers32:=1;
  4345.          p^.location.loc:=LOC_REGISTER;
  4346.       end;
  4347.  
  4348.     procedure firstraise(var p : ptree);
  4349.  
  4350.       begin
  4351.          p^.resulttype:=voiddef;
  4352.          {
  4353.          p^.registersfpu:=0;
  4354.          p^.registers32:=0;
  4355.          }
  4356.          if assigned(p^.left) then
  4357.            begin
  4358.               firstpass(p^.left);
  4359.  
  4360.               { this must be a _class_ }
  4361.               if (p^.left^.resulttype^.deftype<>objectdef) or
  4362.                 ((pobjectdef(p^.left^.resulttype)^.options and oois_class)=0) then
  4363.                 Message(sym_e_type_mismatch);
  4364.  
  4365.               p^.registersfpu:=p^.left^.registersfpu;
  4366.               p^.registers32:=p^.left^.registers32;
  4367. {$ifdef SUPPORT_MMX}
  4368.               p^.registersmmx:=p^.left^.registersmmx;
  4369. {$endif SUPPORT_MMX}
  4370.               if assigned(p^.right) then
  4371.                 begin
  4372.                    firstpass(p^.right);
  4373.                    p^.right:=gentypeconvnode(p^.right,s32bitdef);
  4374.                    firstpass(p^.right);
  4375.                    p^.registersfpu:=max(p^.left^.registersfpu,
  4376.                      p^.right^.registersfpu);
  4377.                    p^.registers32:=max(p^.left^.registers32,
  4378.                      p^.right^.registers32);
  4379. {$ifdef SUPPORT_MMX}
  4380.                    p^.registersmmx:=max(p^.left^.registersmmx,
  4381.                      p^.right^.registersmmx);
  4382. {$endif SUPPORT_MMX}
  4383.                 end;
  4384.            end;
  4385.       end;
  4386.  
  4387.     procedure firstwith(var p : ptree);
  4388.  
  4389.       begin
  4390.          if assigned(p^.left) and assigned(p^.right) then
  4391.             begin
  4392.                firstpass(p^.left);
  4393.                if codegenerror then
  4394.                  exit;
  4395.  
  4396.                firstpass(p^.right);
  4397.  
  4398.                if codegenerror then
  4399.                  exit;
  4400.  
  4401.                p^.registers32:=max(p^.left^.registers32,
  4402.                  p^.right^.registers32);
  4403.                p^.registersfpu:=max(p^.left^.registersfpu,
  4404.                  p^.right^.registersfpu);
  4405. {$ifdef SUPPORT_MMX}
  4406.                p^.registersmmx:=max(p^.left^.registersmmx,
  4407.                  p^.right^.registersmmx);
  4408. {$endif SUPPORT_MMX}
  4409.                p^.resulttype:=voiddef;
  4410.             end
  4411.          else
  4412.            begin
  4413.               { optimization }
  4414.               disposetree(p);
  4415.               p:=nil;
  4416.            end;
  4417.       end;
  4418.  
  4419. {    procedure firstprocinline(var p : ptree);
  4420.       var old_inline_proc_firsttemp : longint;
  4421.  
  4422.       begin
  4423.          old_inline_proc_firsttemp:=procinfo.firsttemp;
  4424.          procinfo.firsttemp:=procinfo.firsttemp+p^.inlineproc^.definition^.localst^.datasize;
  4425.       end; }
  4426.  
  4427.     type
  4428.        firstpassproc = procedure(var p : ptree);
  4429.  
  4430.     procedure firstpass(var p : ptree);
  4431.  
  4432.       const
  4433.          procedures : array[ttreetyp] of firstpassproc =
  4434.             (firstadd,firstadd,firstadd,firstmoddiv,firstadd,
  4435.              firstmoddiv,firstassignment,firstload,firstrange,
  4436.              firstadd,firstadd,firstadd,firstadd,
  4437.              firstadd,firstadd,firstin,firstadd,
  4438.              firstadd,firstshlshr,firstshlshr,firstadd,
  4439.              firstadd,firstsubscriptn,firstderef,firstaddr,firstdoubleaddr,
  4440.              firstordconst,firsttypeconv,firstcalln,firstnothing,
  4441.              firstrealconst,firstfixconst,firstumminus,firstasm,firstvecn,
  4442.              firststringconst,firstfuncret,firstselfn,
  4443.              firstnot,firstinline,firstniln,firsterror,
  4444.              firsttypen,firsthnewn,firsthdisposen,firstnewn,
  4445.              firstsimplenewdispose,firstnothing,firstsetcons,firstblock,
  4446.              firstnothing,firstnothing,firstif,firstnothing,
  4447.              firstnothing,first_while_repeat,first_while_repeat,firstfor,
  4448.              firstexitn,firstwith,firstcase,firstlabel,
  4449.              firstgoto,firstsimplenewdispose,firsttryexcept,firstraise,
  4450.              firstnothing,firsttryfinally,firstis,firstas,firstadd,
  4451.              firstnothing,firstnothing,firstloadvmt);
  4452.  
  4453.       var
  4454.          oldcodegenerror : boolean;
  4455.          oldswitches : Tcswitches;
  4456.          { there some calls of do_firstpass in the parser }
  4457.          oldis : pinputfile;
  4458.          oldnr : longint;
  4459.  
  4460.       begin
  4461.          { if we save there the whole stuff, }
  4462.          { line numbers become more correct  }
  4463.          oldis:=current_module^.current_inputfile;
  4464.          oldnr:=current_module^.current_inputfile^.line_no;
  4465.          oldcodegenerror:=codegenerror;
  4466.          oldswitches:=aktswitches;
  4467. {$ifdef extdebug}
  4468.         inc(p^.firstpasscount);
  4469. {$endif extdebug}
  4470.  
  4471.          codegenerror:=false;
  4472.          current_module^.current_inputfile:=p^.inputfile;
  4473.          current_module^.current_inputfile^.line_no:=p^.line;
  4474.          aktswitches:=p^.pragmas;
  4475.  
  4476.          if not(p^.error) then
  4477.            begin
  4478.               procedures[p^.treetype](p);
  4479.               p^.error:=codegenerror;
  4480.               codegenerror:=codegenerror or oldcodegenerror;
  4481.            end
  4482.          else codegenerror:=true;
  4483.          aktswitches:=oldswitches;
  4484.          current_module^.current_inputfile:=oldis;
  4485.          current_module^.current_inputfile^.line_no:=oldnr;
  4486.       end;
  4487.  
  4488.     function do_firstpass(var p : ptree) : boolean;
  4489.  
  4490.       begin
  4491.          codegenerror:=false;
  4492.          firstpass(p);
  4493.          do_firstpass:=codegenerror;
  4494.       end;
  4495.  
  4496. end.
  4497. {
  4498.   $Log: pass_1.pas,v $
  4499.   Revision 1.3  1998/03/28 23:09:56  florian
  4500.     * secondin bugfix (m68k and i386)
  4501.     * overflow checking bugfix (m68k and i386) -- pretty useless in
  4502.       secondadd, since everything is done using 32-bit
  4503.     * loading pointer to routines hopefully fixed (m68k)
  4504.     * flags problem with calls to RTL internal routines fixed (still strcmp
  4505.       to fix) (m68k)
  4506.     * #ELSE was still incorrect (didn't take care of the previous level)
  4507.     * problem with filenames in the command line solved
  4508.     * problem with mangledname solved
  4509.     * linking name problem solved (was case insensitive)
  4510.     * double id problem and potential crash solved
  4511.     * stop after first error
  4512.     * and=>test problem removed
  4513.     * correct read for all float types
  4514.     * 2 sigsegv fixes and a cosmetic fix for Internal Error
  4515.     * push/pop is now correct optimized (=> mov (%esp),reg)
  4516.  
  4517.   Revision 1.2  1998/03/26 11:18:31  florian
  4518.     - switch -Sa removed
  4519.     - support of a:=b:=0 removed
  4520.  
  4521.   Revision 1.1.1.1  1998/03/25 11:18:14  root
  4522.   * Restored version
  4523.  
  4524.   Revision 1.41  1998/03/13 22:45:59  florian
  4525.     * small bug fixes applied
  4526.  
  4527.   Revision 1.40  1998/03/10 23:48:36  florian
  4528.     * a couple of bug fixes to get the compiler with -OGaxz compiler, sadly
  4529.       enough, it doesn't run
  4530.  
  4531.   Revision 1.39  1998/03/10 16:27:41  pierre
  4532.     * better line info in stabs debug
  4533.     * symtabletype and lexlevel separated into two fields of tsymtable
  4534.     + ifdef MAKELIB for direct library output, not complete
  4535.     + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  4536.       working
  4537.     + ifdef TESTFUNCRET for setting func result in underfunction, not
  4538.       working
  4539.  
  4540.   Revision 1.38  1998/03/10 01:11:11  peter
  4541.     * removed one of my previous optimizations with string+char, which
  4542.       generated wrong code
  4543.  
  4544.   Revision 1.37  1998/03/09 10:44:38  peter
  4545.     + string='', string<>'', string:='', string:=char optimizes (the first 2
  4546.       were already in cg68k2)
  4547.  
  4548.   Revision 1.36  1998/03/06 00:52:38  peter
  4549.     * replaced all old messages from errore.msg, only ExtDebug and some
  4550.       Comment() calls are left
  4551.     * fixed options.pas
  4552.  
  4553.   Revision 1.35  1998/03/04 08:38:19  florian
  4554.     * problem with unary minus fixed
  4555.  
  4556.   Revision 1.34  1998/03/03 01:08:31  florian
  4557.     * bug0105 and bug0106 problem solved
  4558.  
  4559.   Revision 1.33  1998/03/02 01:48:56  peter
  4560.     * renamed target_DOS to target_GO32V1
  4561.     + new verbose system, merged old errors and verbose units into one new
  4562.       verbose.pas, so errors.pas is obsolete
  4563.  
  4564.   Revision 1.32  1998/03/01 22:46:14  florian
  4565.     + some win95 linking stuff
  4566.     * a couple of bugs fixed:
  4567.       bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
  4568.  
  4569.   Revision 1.31  1998/02/28 17:26:46  carl
  4570.     * bugfix #47 and more checking for aprocdef
  4571.  
  4572.   Revision 1.30  1998/02/13 10:35:20  daniel
  4573.   * Made Motorola version compilable.
  4574.   * Fixed optimizer
  4575.  
  4576.   Revision 1.29  1998/02/12 17:19:16  florian
  4577.     * fixed to get remake3 work, but needs additional fixes (output, I don't like
  4578.       also that aktswitches isn't a pointer)
  4579.  
  4580.   Revision 1.28  1998/02/12 11:50:23  daniel
  4581.   Yes! Finally! After three retries, my patch!
  4582.  
  4583.   Changes:
  4584.  
  4585.   Complete rewrite of psub.pas.
  4586.   Added support for DLL's.
  4587.   Compiler requires less memory.
  4588.   Platform units for each platform.
  4589.  
  4590.   Revision 1.27  1998/02/11 21:56:34  florian
  4591.     * bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
  4592.  
  4593.   Revision 1.26  1998/02/07 23:05:03  florian
  4594.     * once more MMX
  4595.  
  4596.   Revision 1.25  1998/02/07 09:39:24  florian
  4597.     * correct handling of in_main
  4598.     + $D,$T,$X,$V like tp
  4599.  
  4600.   Revision 1.24  1998/02/06 10:34:21  florian
  4601.     * bug0082 and bug0084 fixed
  4602.  
  4603.   Revision 1.23  1998/02/05 21:54:34  florian
  4604.     + more MMX
  4605.  
  4606.   Revision 1.22  1998/02/05 20:54:30  peter
  4607.     * fixed a Sigsegv
  4608.  
  4609.   Revision 1.21  1998/02/04 23:04:21  florian
  4610.     + unary minus for mmx data types added
  4611.  
  4612.   Revision 1.20  1998/02/04 22:00:56  florian
  4613.     + NOT operator for mmx arrays
  4614.  
  4615.   Revision 1.19  1998/02/04 14:38:49  florian
  4616.     * clean up
  4617.     * a lot of potential bugs removed adding some neccessary register allocations
  4618.       (FPU!)
  4619.     + allocation of MMX registers
  4620.  
  4621.   Revision 1.18  1998/02/03 23:07:34  florian
  4622.     * AS and IS do now a correct type checking
  4623.     + is_convertable handles now also instances of classes
  4624.  
  4625.   Revision 1.17  1998/02/01 19:40:51  florian
  4626.     * clean up
  4627.     * bug0029 fixed
  4628.  
  4629.   Revision 1.16  1998/02/01 17:14:04  florian
  4630.     + comparsion of class references
  4631.  
  4632.   Revision 1.15  1998/01/30 21:23:59  carl
  4633.     * bugfix of compiler crash with new/dispose (fourth crash of new bug)
  4634.     * bugfix of write/read compiler crash
  4635.  
  4636.   Revision 1.14  1998/01/25 22:29:00  florian
  4637.     * a lot bug fixes on the DOM
  4638.  
  4639.   Revision 1.13  1998/01/21 22:34:25  florian
  4640.     + comparsion of Delphi classes
  4641.  
  4642.   Revision 1.12  1998/01/21 21:29:55  florian
  4643.     * some fixes for Delphi classes
  4644.  
  4645.   Revision 1.11  1998/01/16 23:34:13  florian
  4646.     + nil is compatible with class variable (tobject(x):=nil)
  4647.  
  4648.   Revision 1.10  1998/01/16 22:34:40  michael
  4649.   * Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
  4650.     in this compiler :)
  4651.  
  4652.   Revision 1.9  1998/01/13 23:11:10  florian
  4653.     + class methods
  4654.  
  4655.   Revision 1.8  1998/01/07 00:17:01  michael
  4656.   Restored released version (plus fixes) as current
  4657.  
  4658.   Revision 1.7  1997/12/10 23:07:26  florian
  4659.   * bugs fixed: 12,38 (also m68k),39,40,41
  4660.   + warning if a system unit is without -Us compiled
  4661.   + warning if a method is virtual and private (was an error)
  4662.   * some indentions changed
  4663.   + factor does a better error recovering (omit some crashes)
  4664.   + problem with @type(x) removed (crashed the compiler)
  4665.  
  4666.   Revision 1.6  1997/12/09 13:54:26  carl
  4667.   + renamed some stuff (real types mostly)
  4668.  
  4669.   Revision 1.5  1997/12/04 12:02:19  pierre
  4670.      + added a counter of max firstpass's for a ptree
  4671.        for debugging only in ifdef extdebug
  4672.  
  4673.   Revision 1.4  1997/12/03 13:53:01  carl
  4674.   + ifdef i386.
  4675.  
  4676.   Revision 1.3  1997/11/29 15:38:43  florian
  4677.   * bug0033 fixed
  4678.   * duplicate strings are now really once generated (there was a bug)
  4679.  
  4680.   Revision 1.2  1997/11/28 11:11:43  pierre
  4681.      negativ real constants are not supported by nasm assembler
  4682.  
  4683.   Revision 1.1.1.1  1997/11/27 08:32:59  michael
  4684.   FPC Compiler CVS start
  4685.  
  4686.  
  4687.   Pre-CVS log:
  4688.  
  4689.     CEC    Carl-Eric Codere
  4690.     FK     Florian Klaempfl
  4691.     PM     Pierre Muller
  4692.     +      feature added
  4693.     -      removed
  4694.     *      bug fixed or changed
  4695.  
  4696.   History:
  4697.        6th september 1997:
  4698.          + added basic support for MC68000   (CEC)
  4699.             (lines: 189,1860,1884 + ifdef m68k)
  4700.       19th september 1997:
  4701.          + added evalution of constant sets  (FK)
  4702.          + empty and constant sets are now compatible with all other
  4703.            set types (FK)
  4704.       20th september 1997:
  4705.          * p^.register32 bug in firstcalln (max with register32 of p^.left i.e. args) (PM)
  4706.       24th september 1997:
  4707.          * line_no and inputfile are now in firstpass saved (FK)
  4708.       25th september 1997:
  4709.          + support of high for open arrays (FK)
  4710.          + the high parameter is now pushed for open arrays (FK)
  4711.       1th october 1997:
  4712.          + added support for unary minus operator and for:=overloading (PM)
  4713.       2nd october 1997:
  4714.          + added handling of in_ord_x (PM)
  4715.            boolean to byte with ord is special because the location may be different
  4716.       3rd october 1997:
  4717.          + renamed ret_in_eax to ret_in_acc (CEC)
  4718.          + find ifdef m68k to find other changes (CEC)
  4719.          * bugfix or calc correct val for regs. for m68k in firstcalln (CEC)
  4720.       4th october 1997:
  4721.          + added code for in_pred_x in_succ_x
  4722.            fails for enums with jumps (PM)
  4723.      25th october 1997:
  4724.          + direct evalution of pred and succ with const parameter (FK)
  4725.       6th november 1997:
  4726.          * added typeconversion for floatdef in write(ln) for text to s64real (PM)
  4727.          + code for str with length arg rewritten (PM)
  4728.       13th november 1997:
  4729.          * floatdef in write(ln) for text for different types in RTL (PM)
  4730.          * bug causing convertability from floatdef to orddef removed (PM)
  4731.          * typecasting from voiddef to any type not allowed anymore (PM)
  4732.          + handling of different real const to diff realtype (PM)
  4733.       18th november 1997:
  4734.          * changed first_type_conv function arg as var p : ptree
  4735.            to be able to change the tree (PM)
  4736. }
  4737.