* made it again compilable

compiler/new/cg386.pas

@@ -82,7 +82,8 @@ unit cg386;
        offset : longint);
 
        begin
-          list^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol(s,offset))));
+          list^.concat(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol(s))));
+          {!!!!!!!!!1 offset is ignored }
        end;
 
      procedure tcg386.a_push_reg(list : paasmoutput;r : tregister);
@@ -118,7 +119,10 @@ unit cg386;
 end.
 {
   $Log$
-  Revision 1.2  1999-01-23 23:29:43  florian
+  Revision 1.3  1999-08-01 18:22:31  florian
+   * made it again compilable
+
+  Revision 1.2  1999/01/23 23:29:43  florian
     * first running version of the new code generator
     * when compiling exceptions under Linux fixed
 

compiler/new/cgbase.pas

@@ -103,19 +103,19 @@ unit cgbase;
        procinfo : tprocinfo;
 
        { labels for BREAK and CONTINUE }
-       aktbreaklabel,aktcontinuelabel : plabel;
+       aktbreaklabel,aktcontinuelabel : pasmlabel;
 
        { label when the result is true or false }
-       truelabel,falselabel : plabel;
+       truelabel,falselabel : pasmlabel;
 
        { label to leave the sub routine }
-       aktexitlabel : plabel;
+       aktexitlabel : pasmlabel;
 
        { also an exit label, only used we need to clear only the stack }
-       aktexit2label : plabel;
+       aktexit2label : pasmlabel;
 
        { only used in constructor for fail or if getmem fails }
-       quickexitlabel : plabel;
+       quickexitlabel : pasmlabel;
 
        { Boolean, wenn eine loadn kein Assembler erzeugt hat }
        simple_loadn : boolean;
@@ -262,13 +262,13 @@ unit cgbase;
          codesegment:=new(paasmoutput,init);
          bsssegment:=new(paasmoutput,init);
          debuglist:=new(paasmoutput,init);
-         externals:=new(paasmoutput,init);
-         internals:=new(paasmoutput,init);
          consts:=new(paasmoutput,init);
          rttilist:=new(paasmoutput,init);
          importssection:=nil;
          exportssection:=nil;
          resourcesection:=nil;
+         asmsymbollist:=new(pasmsymbollist,init);
+         asmsymbollist^.usehash;
       end;
 
 
@@ -279,8 +279,6 @@ unit cgbase;
          dispose(bsssegment,done);
          dispose(datasegment,done);
          dispose(debuglist,done);
-         dispose(externals,done);
-         dispose(internals,done);
          dispose(consts,done);
          dispose(rttilist,done);
          if assigned(importssection) then
@@ -289,6 +287,9 @@ unit cgbase;
           dispose(exportssection,done);
          if assigned(resourcesection) then
           dispose(resourcesection,done);
+         if assigned(resourcestringlist) then
+          dispose(resourcestringlist,done);
+         dispose(asmsymbollist,done);
       end;
 
 
@@ -358,7 +359,7 @@ unit cgbase;
       begin
         if ((loc.loc=LOC_MEM) or (loc.loc=LOC_REFERENCE)) and
            assigned(loc.reference.symbol) then
-          stringdispose(loc.reference.symbol);
+          dispose(loc.reference.symbol,done);
         loc.loc:=LOC_INVALID;
       end;
 
@@ -368,13 +369,13 @@ unit cgbase;
          { this is needed if you want to be able to delete }
          { the string with the nodes                       }
          if assigned(destloc.reference.symbol) then
-           stringdispose(destloc.reference.symbol);
+           dispose(destloc.reference.symbol,done);
          destloc:= sourceloc;
          if sourceloc.loc in [LOC_MEM,LOC_REFERENCE] then
            begin
               if assigned(sourceloc.reference.symbol) then
                 destloc.reference.symbol:=
-                  stringdup(sourceloc.reference.symbol^);
+                  sourceloc.reference.symbol;
            end
          else
            destloc.reference.symbol:=nil;
@@ -394,7 +395,10 @@ unit cgbase;
 end.
 {
   $Log$
-  Revision 1.4  1999-01-23 23:29:45  florian
+  Revision 1.5  1999-08-01 18:22:32  florian
+   * made it again compilable
+
+  Revision 1.4  1999/01/23 23:29:45  florian
     * first running version of the new code generator
     * when compiling exceptions under Linux fixed
 

compiler/new/cgobj.pas

@@ -38,7 +38,7 @@ unit cgobj;
           destructor done;virtual;
 
           procedure a_call_name_ext(list : paasmoutput;const s : string;
-            offset : longint;m : texternal_typ);
+            offset : longint);
 
           {************************************************}
           { code generation for subroutine entry/exit code }
@@ -46,11 +46,11 @@ unit cgobj;
           { helper routines }
           procedure g_initialize_data(p : psym);
           procedure g_incr_data(p : psym);
-          procedure g_finalize_data(p : psym);
+          procedure g_finalize_data(p : pnamedindexobject);
 {$ifndef VALUEPARA}
-          procedure g_copyopenarrays(p : psym);
+          procedure g_copyopenarrays(p : pnamedindexobject);
 {$else}
-          procedure g_copyvalueparas(p : psym);
+          procedure g_copyvalueparas(p : pnamedindexobject);
 {$endif}
 
           procedure g_entrycode(list : paasmoutput;
@@ -179,15 +179,15 @@ unit cgobj;
 
       begin
          a_param_const32(list,stackframesize,1);
-         a_call_name_ext(list,'FPC_STACKCHECK',0,EXT_NEAR);
+         a_call_name_ext(list,'FPC_STACKCHECK',0);
       end;
 
     procedure tcg.a_call_name_ext(list : paasmoutput;const s : string;
-      offset : longint;m : texternal_typ);
+      offset : longint);
 
       begin
          a_call_name(list,s,offset);
-         concat_external(s,m);
+         { concat_external(s,m); }
       end;
 
 {*****************************************************************************
@@ -319,7 +319,7 @@ unit cgobj;
       end;
 
     { generates the code for finalisation of local data }
-    procedure tcg.g_finalize_data(p : psym);
+    procedure tcg.g_finalize_data(p : pnamedindexobject);
 
       var
          hr : treference;
@@ -369,9 +369,9 @@ unit cgobj;
 
     { generates the code to make local copies of the value parameters }
   {$ifndef VALUEPARA}
-    procedure tcg.g_copyopenarrays(p : psym);
+    procedure tcg.g_copyopenarrays(p : pnamedindexobject);
   {$else}
-    procedure tcg.g_copyvalueparas(p : psym);
+    procedure tcg.g_copyvalueparas(p : pnamedindexobject);
   {$endif}
       var
   {$ifdef VALUEPARA}
@@ -516,27 +516,27 @@ unit cgobj;
     { wrappers for the methods, because TP doesn't know procedures }
     { of objects                                                   }
 
-    procedure _copyopenarrays(s : psym);{$ifndef FPC}far;{$endif}
+    procedure _copyopenarrays(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
 
       begin
          cg^.g_copyopenarrays(s);
       end;
 
-    procedure _finalize_data(s : psym);{$ifndef FPC}far;{$endif}
+    procedure _finalize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
 
       begin
          cg^.g_finalize_data(s);
       end;
 
-    procedure _incr_data(s : psym);{$ifndef FPC}far;{$endif}
+    procedure _incr_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
 
       begin
-         cg^.g_incr_data(s);
+         cg^.g_incr_data(psym(s));
       end;
-    procedure _initialize_data(s : psym);{$ifndef FPC}far;{$endif}
+    procedure _initialize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
 
       begin
-         cg^.g_initialize_data(s);
+         cg^.g_initialize_data(psym(s));
       end;
 
     { generates the entry code for a procedure }
@@ -568,7 +568,7 @@ unit cgobj;
          { save registers on cdecl }
          if ((aktprocsym^.definition^.options and pocdecl)<>0) then
            begin
-              for r:=firstregister to lastregister do
+              for r:=firstreg to lastreg do
                 begin
                    if (r in registers_saved_on_cdecl) then
                      if (r in general_registers) then
@@ -617,12 +617,12 @@ unit cgobj;
               { needs the target a console flags ? }
               if tf_needs_isconsole in target_info.flags then
                 begin
-                   hr.symbol:=stringdup('U_'+target_info.system_unit+'_ISCONSOLE');
+                   hr.symbol:=newasmsymbol('U_'+target_info.system_unit+'_ISCONSOLE');
                    if apptype=at_cui then
                      a_load_const8_ref(list,1,hr)
                    else
                      a_load_const8_ref(list,0,hr);
-                   stringdispose(hr.symbol);
+                   dispose(hr.symbol,done);
                 end;
 
               hp:=pused_unit(usedunits.first);
@@ -631,7 +631,7 @@ unit cgobj;
                    { call the unit init code and make it external }
                    if (hp^.u^.flags and uf_init)<>0 then
                      a_call_name_ext(list,
-                       'INIT$$'+hp^.u^.modulename^,0,EXT_NEAR);
+                       'INIT$$'+hp^.u^.modulename^,0);
                     hp:=Pused_unit(hp^.next);
                 end;
            end;
@@ -641,18 +641,18 @@ unit cgobj;
            begin
              if procinfo._class^.isclass then
                begin
-                 list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
-                 list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
-                   newcsymbol('FPC_NEW_CLASS',0))));
-                 concat_external('FPC_NEW_CLASS',EXT_NEAR);
+                 list^.insert(new(pai386,op_cond_sym(A_Jcc,C_Z,S_NO,quickexitlabel)));
+                 list^.insert(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol('FPC_NEW_CLASS'))));
                end
              else
                begin
+                 {
                  list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
                  list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
                    newcsymbol('FPC_HELP_CONSTRUCTOR',0))));
                  list^.insert(new(pai386,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI)));
                  concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR);
+                 }
                end;
            end;
 
@@ -703,9 +703,9 @@ unit cgobj;
               while hs<>'' do
                 begin
                    if make_global then
-                     list^.insert(new(pai_symbol,init_global(hs)))
+                     exprasmlist^.insert(new(pai_symbol,initname_global(hs,0)))
                    else
-                     list^.insert(new(pai_symbol,init(hs)));
+                     exprasmlist^.insert(new(pai_symbol,initname(hs,0)));
 
   {$ifdef GDB}
                    if (cs_debuginfo in aktmoduleswitches) then
@@ -931,7 +931,10 @@ unit cgobj;
 end.
 {
   $Log$
-  Revision 1.5  1999-01-23 23:29:46  florian
+  Revision 1.6  1999-08-01 18:22:33  florian
+   * made it again compilable
+
+  Revision 1.5  1999/01/23 23:29:46  florian
     * first running version of the new code generator
     * when compiling exceptions under Linux fixed
 

compiler/new/cpuunit.inc

@@ -21,7 +21,8 @@
  ****************************************************************************
 }
 {$ifdef i386}
-       ,i386
+       ,i386base
+       ,i386asm
 {$endif}
 {$ifdef m68k}
        ,m68k
@@ -44,7 +45,10 @@
 {$endif}
 {
   $Log$
-  Revision 1.1  1998-12-15 22:16:03  florian
+  Revision 1.2  1999-08-01 18:22:34  florian
+   * made it again compilable
+
+  Revision 1.1  1998/12/15 22:16:03  florian
     * first version, all planned processors (?) added
 
 }

compiler/new/nmem.pas

@@ -46,7 +46,7 @@ unit nmem;
   implementation
 
     uses
-       cobjects,aasm,cgbase,cgobj
+       cobjects,aasm,cgbase,cgobj,types,verbose
 {$I cpuunit.inc}
 {$I tempgen.inc}
        ;
@@ -106,8 +106,7 @@ unit nmem;
                        location.reference.offset:=pabsolutesym(symtableentry)^.address;
                      end
                     else
-                     location.reference.symbol:=stringdup(symtableentry^.mangledname);
-                    maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
+                     location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
                  end;
               varsym :
                  begin
@@ -115,9 +114,7 @@ unit nmem;
                     { C variable }
                     if (pvarsym(symtableentry)^.var_options and vo_is_C_var)<>0 then
                       begin
-                         location.reference.symbol:=stringdup(symtableentry^.mangledname);
-                         if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
-                           maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
+                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
                       end
 
 {$ifdef i386}
@@ -126,13 +123,10 @@ unit nmem;
                     else if (pvarsym(symtableentry)^.var_options and vo_is_dll_var)<>0 then
                       begin
                          hregister:=getregister32;
-                         stringdispose(location.reference.symbol);
-                         location.reference.symbol:=stringdup(symtableentry^.mangledname);
+                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(location.reference),hregister)));
-                         stringdispose(location.reference.symbol);
+                         location.reference.symbol:=nil;
                          location.reference.base:=hregister;
-                         if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
-                           maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
                       end
 {$endif i386}
                     else
@@ -153,10 +147,8 @@ unit nmem;
                                 begin
                                    location.reference.base:=procinfo.framepointer;
                                    location.reference.offset:=pvarsym(symtableentry)^.address;
-                                   if (symtabletype=localsymtable) or (symtabletype=inlinelocalsymtable) then
+                                   if (symtabletype in [localsymtable,inlinelocalsymtable]) then
                                      location.reference.offset:=-location.reference.offset;
-                                   if (symtabletype=parasymtable) or (symtabletype=inlineparasymtable) then
-                                     inc(location.reference.offset,symtable^.call_offset);
                                    if (lexlevel>(symtable^.symtablelevel)) then
                                      begin
                                         hregister:=getregister32;
@@ -184,10 +176,7 @@ unit nmem;
                                 case symtabletype of
                                    unitsymtable,globalsymtable,
                                    staticsymtable : begin
-                                                       stringdispose(location.reference.symbol);
-                                                       location.reference.symbol:=stringdup(symtableentry^.mangledname);
-                                                       if symtabletype=unitsymtable then
-                                                         concat_external(symtableentry^.mangledname,EXT_NEAR);
+                                                       location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
                                                     end;
                                    stt_exceptsymtable:
                                      begin
@@ -198,11 +187,7 @@ unit nmem;
                                      begin
                                         if (pvarsym(symtableentry)^.properties and sp_static)<>0 then
                                           begin
-                                             stringdispose(location.reference.symbol);
-                                             location.reference.symbol:=
-                                                stringdup(symtableentry^.mangledname);
-                                             if symtable^.defowner^.owner^.symtabletype=unitsymtable then
-                                               concat_external(symtableentry^.mangledname,EXT_NEAR);
+                                             location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
                                           end
                                         else
                                           begin
@@ -230,14 +215,10 @@ unit nmem;
                            end;
                          { in case call by reference, then calculate: }
                          if (pvarsym(symtableentry)^.varspez=vs_var) or
+                            is_open_array(pvarsym(symtableentry)^.definition) or
+                            is_array_of_const(pvarsym(symtableentry)^.definition) or
                             ((pvarsym(symtableentry)^.varspez=vs_const) and
-{$ifndef VALUEPARA}
-                             dont_copy_const_param(pvarsym(symtableentry)^.definition)) or
-                             { call by value open arrays are also indirect addressed }
-                             is_open_array(pvarsym(symtableentry)^.definition) then
-{$else}
                              push_addr_param(pvarsym(symtableentry)^.definition)) then
-{$endif}
                            begin
                               simple_loadn:=false;
                               if hregister=R_NO then
@@ -270,51 +251,30 @@ unit nmem;
                                      newreference(location.reference),
                                      hregister)));
                                 end;
-                              clear_reference(location.reference);
+                              reset_reference(location.reference);
                               location.reference.base:=hregister;
                           end;
                       end;
                  end;
               procsym:
                  begin
-                    if is_methodpointer then
-                      begin
-                         secondpass(left);
-                         stringdispose(location.reference.symbol);
-                         { virtual method ? }
-                         if (pprocsym(symtableentry)^.definition^.options and povirtualmethod)<>0 then
-                           begin
-                           end
-                         else
-                           begin
-                              location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
-                              maybe_concat_external(symtable,symtableentry^.mangledname);
-                           end;
-                      end
-                    else
-                      begin
-                         {!!!!! Be aware, work on virtual methods too }
-                         stringdispose(location.reference.symbol);
-                         location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
-                         maybe_concat_external(symtable,symtableentry^.mangledname);
-                      end;
+                    {!!!!!!!!!!}
                  end;
               typedconstsym :
                  begin
-                    stringdispose(location.reference.symbol);
-                    location.reference.symbol:=stringdup(symtableentry^.mangledname);
-                    maybe_concat_external(symtable,symtableentry^.mangledname);
+                    location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
                  end;
               else internalerror(4);
          end;
       end;
 
-      end;
-
 end.
 {
   $Log$
-  Revision 1.1  1999-01-24 22:32:36  florian
+  Revision 1.2  1999-08-01 18:22:35  florian
+   * made it again compilable
+
+  Revision 1.1  1999/01/24 22:32:36  florian
     * well, more changes, especially parts of secondload ported
 
 }

compiler/new/pass_1.pas

@@ -29,7 +29,8 @@ interface
     uses
        tree;
 
-    procedure firstpass(p : pnode);
+    procedure firstpass(p : ptree);
+    procedure firstpassnode(p : pnode);
     function  do_firstpass(var p : ptree) : boolean;
     function  do_firstpassnode(var p : pnode) : boolean;
 
@@ -44,12 +45,7 @@ implementation
       htypechk,tcadd,tccal,tccnv,tccon,tcflw,
       tcinl,tcld,tcmat,tcmem,tcset
       }
-{$ifdef i386}
-      ,i386,tgeni386
-{$endif}
-{$ifdef m68k}
-      ,m68k,tgen68k
-{$endif}
+      {$I cpuunit.inc}
       ;
 
 {*****************************************************************************
@@ -116,7 +112,7 @@ implementation
 
 {$endif dummy}
 
-    procedure firstpass(p : pnode);
+    procedure firstpassnode(p : pnode);
 
       var
          oldcodegenerror  : boolean;
@@ -208,11 +204,17 @@ implementation
          do_firstpass:=codegenerror;
       end;
 
+    procedure firstpass(p : ptree);
+
+      begin
+         codegenerror:=false;
+      end;
+
     function do_firstpassnode(var p : pnode) : boolean;
 
       begin
          codegenerror:=false;
-         firstpass(p);
+         firstpassnode(p);
          do_firstpassnode:=codegenerror;
       end;
 
@@ -220,7 +222,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1999-01-23 23:29:48  florian
+  Revision 1.4  1999-08-01 18:22:36  florian
+   * made it again compilable
+
+  Revision 1.3  1999/01/23 23:29:48  florian
     * first running version of the new code generator
     * when compiling exceptions under Linux fixed
 

compiler/new/pp.pas

@@ -159,24 +159,14 @@ uses
   {$O os2_targ}
   {$O win_targ}
 {$endif i386}
-  {$O asmutils}
   {$ifdef gdb}
         {$O gdb}
   {$endif gdb}
   {$ifdef i386}
         {$O opts386}
-        {$O i386}
-        {$O cgai386}
+        {$O i386base}
+        {$O i386asm}
         {$O tgeni386}
-        {$O cg386add}
-        {$O cg386cal}
-        {$O cg386cnv}
-        {$O cg386con}
-        {$O cg386flw}
-        {$O cg386ld}
-        {$O cg386inl}
-        {$O cg386mat}
-        {$O cg386set}
         {$ifndef NOOPT}
           {$O aopt386}
         {$endif}
@@ -265,7 +255,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  1998-12-26 15:20:31  florian
+  Revision 1.2  1999-08-01 18:22:37  florian
+   * made it again compilable
+
+  Revision 1.1  1998/12/26 15:20:31  florian
     + more changes for the new version
 
 }

compiler/new/psub.pas

@@ -54,7 +54,7 @@ uses
   ,gdb
 {$endif GDB}
 {$ifdef i386}
-  ,i386,tgeni386
+  ,i386base,tgeni386
   {$ifndef NoOpt}
   ,aopt386
   {$endif}
@@ -195,7 +195,6 @@ begin
            vs:=new(Pvarsym,init('val'+s,p));
            vs^.fileinfo:=filepos;
            vs^.varspez:=varspez;
-           vs^.localaddress:=l;
            aktprocsym^.definition^.parast^.insert(vs);
          end
        else
@@ -315,7 +314,7 @@ begin
 {$ifndef UseNiceNames}
   if assigned(procinfo._class) then
     if (pos('_$$_',procprefix)=0) then
-      hs:=procprefix+'_$$_'+procinfo._class^.name^+'_'+sp
+      hs:=procprefix+'_$$_'+procinfo._class^.name+'_'+sp
     else
       hs:=procprefix+'_$'+sp;
 {$else UseNiceNames}
@@ -695,7 +694,6 @@ begin
          { external shouldn't override the cdecl/system name }
          if (aktprocsym^.definition^.options and poclearstack)=0 then
            aktprocsym^.definition^.setmangledname(aktprocsym^.name);
-         externals^.concat(new(pai_external,init(aktprocsym^.mangledname,EXT_NEAR)));
        end;
     end;
 end;
@@ -924,7 +922,7 @@ begin
                     end;
                  { manglednames are equal? }
                    if (m_repeat_forward in aktmodeswitches) or
-                      assigned(aktprocsym^.definition^.parast^.root) then
+                      aktprocsym^.definition^.haspara then
                     if (hd^.mangledname<>aktprocsym^.definition^.mangledname) then
                      begin
                        if (aktprocsym^.definition^.options and poexternal)=0 then
@@ -950,29 +948,9 @@ begin
                            exit;
                          end;
 
-                       ad:=hd^.parast^.root;
-                       fd:=aktprocsym^.definition^.parast^.root;
-                       if assigned(ad) and assigned(fd) then
-                         begin
-                           while assigned(ad) and assigned(fd) do
-                             begin
-                               if ad^.name<>fd^.name then
-                                 begin
-                                   Message3(parser_e_header_different_var_names,
-                                     aktprocsym^.name,ad^.name,fd^.name);
-                                   break;
-                                 end;
-                             { it is impossible to have a nil pointer }
-                             { for only one parameter - since they    }
-                             { have the same number of parameters.    }
-                             { Left = next parameter.                 }
-                               ad:=ad^.left;
-                               fd:=fd^.left;
-                             end;
-                         end;
                      end;
                  { also the call_offset }
-                   hd^.parast^.call_offset:=aktprocsym^.definition^.parast^.call_offset;
+                   hd^.parast^.address_fixup:=aktprocsym^.definition^.parast^.address_fixup;
 
                  { remove pd^.nextoverloaded from the list }
                  { and add aktprocsym^.definition }
@@ -989,7 +967,7 @@ begin
                        hd^.extnumber:=aktprocsym^.definition^.extnumber;
                    { switch parast for warning in implementation  PM }
                    if (m_repeat_forward in aktmodeswitches) or
-                      assigned(aktprocsym^.definition^.parast^.root) then
+                      aktprocsym^.definition^.haspara then
                      begin
                         storeparast:=hd^.parast;
                         hd^.parast:=aktprocsym^.definition^.parast;
@@ -1040,7 +1018,7 @@ procedure compile_proc_body(const proc_names : tstringcontainer;
   Compile the body of a procedure
 }
 var
-   oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
+   oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
    _class,hp:Pobjectdef;
    { switches can change inside the procedure }
    entryswitches, exitswitches : tlocalswitches;
@@ -1413,7 +1391,7 @@ begin
       inc(procinfo.call_offset,target_os.size_of_pointer);
     end;
    { allows to access the parameters of main functions in nested functions }
-   aktprocsym^.definition^.parast^.call_offset:=procinfo.call_offset;
+   aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
 
 { compile procedure when a body is needed }
    if (pdflags and pd_body)<>0 then
@@ -1448,7 +1426,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  1999-01-13 22:52:39  florian
+  Revision 1.3  1999-08-01 18:22:38  florian
+   * made it again compilable
+
+  Revision 1.2  1999/01/13 22:52:39  florian
     + YES, finally the new code generator is compilable, but it doesn't run yet :(
 
   Revision 1.1  1998/12/26 15:20:31  florian

compiler/new/tree.pas

@@ -144,7 +144,8 @@ unit tree;
           tc_fix_2_real,
           tc_proc_2_procvar,
           tc_arrayconstructor_2_set,
-          tc_load_smallset
+          tc_load_smallset,
+          tc_bool_2_bool
        );
 
       { different assignment types }
@@ -158,10 +159,10 @@ unit tree;
           _low,_high : longint;
 
           { only used by gentreejmp }
-          _at : plabel;
+          _at : pasmlabel;
 
           { label of instruction }
-          statement : plabel;
+          statement : pasmlabel;
 
           { is this the first of an case entry, needed to release statement
             label (PFV) }
@@ -207,7 +208,6 @@ unit tree;
 {$endif EXTDEBUG}
        end;
 
-{$ifndef nooldtree}
        { allows to determine which elementes are to be replaced }
        tdisposetyp = (dt_nothing,dt_leftright,dt_left,
                       dt_mbleft,dt_typeconv,dt_inlinen,
@@ -217,8 +217,7 @@ unit tree;
        ttree = record
           error : boolean;
           disposetyp : tdisposetyp;
-          { is true, if the
-           right and left operand are swaped }
+          { is true, if the right and left operand are swaped }
           swaped : boolean;
 
           { the location of the result of this node }
@@ -233,41 +232,45 @@ unit tree;
           resulttype : pdef;
           fileinfo : tfileposinfo;
           localswitches : tlocalswitches;
-{$ifdef EXTDEBUG}
+{$ifdef extdebug}
           firstpasscount : longint;
-{$endif EXTDEBUG}
+{$endif extdebug}
+{$ifdef TEMPS_NOT_PUSH}
+          temp_offset : longint;
+{$endif TEMPS_NOT_PUSH}
           case treetype : ttreetyp of
              addn : (use_strconcat : boolean;string_typ : tstringtype);
-             callparan : (is_colon_para : boolean;exact_match_found : boolean);
+             callparan : (is_colon_para : boolean;exact_match_found,
+                          convlevel1found,convlevel2found:boolean;hightree:ptree);
              assignn : (assigntyp : tassigntyp;concat_string : boolean);
              loadn : (symtableentry : psym;symtable : psymtable;
-                      is_absolute,is_first,is_methodpointer : boolean);
-             calln : (symtableprocentry : psym;
-                      symtableproc : psymtable;procdefinition : pprocdef;
+                      is_absolute,is_first : boolean);
+             calln : (symtableprocentry : pprocsym;
+                      symtableproc : psymtable;procdefinition : pabstractprocdef;
                       methodpointer : ptree;
-                      no_check,unit_specific,return_value_used : boolean);
+                      no_check,unit_specific,
+                      return_value_used,static_call : boolean);
              ordconstn : (value : longint);
-             realconstn : (value_real : bestreal;lab_real : plabel;realtyp : tait);
+             realconstn : (value_real : bestreal;lab_real : pasmlabel);
              fixconstn : (value_fix: longint);
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean;callunique : boolean);
-             stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
+             stringconstn : (value_str : pchar;length : longint; lab_str : pasmlabel;stringtype : tstringtype);
              typeconvn : (convtyp : tconverttype;explizit : boolean);
-             typen : (typenodetype : pdef);
+             typen : (typenodetype : pdef;typenodesym:ptypesym);
              inlinen : (inlinenumber : byte;inlineconst:boolean);
-             procinlinen : (inlineprocdef : pprocdef;
-                            retoffset,para_offset,para_size : longint);
-             setconstn : (value_set : pconstset;lab_set:plabel);
+             procinlinen : (inlinetree:ptree;inlineprocsym:pprocsym;retoffset,para_offset,para_size : longint);
+             setconstn : (value_set : pconstset;lab_set:pasmlabel);
              loopn : (t1,t2 : ptree;backward : boolean);
              asmn : (p_asm : paasmoutput;object_preserved : boolean);
              casen : (nodes : pcaserecord;elseblock : ptree);
-             labeln,goton : (labelnr : plabel);
-             withn : (withsymtable : psymtable;tablecount : longint);
+             labeln,goton : (labelnr : pasmlabel);
+             withn : (withsymtable : pwithsymtable;tablecount : longint;withreference:preference;islocal:boolean);
              onn : (exceptsymtable : psymtable;excepttype : pobjectdef);
              arrayconstructn : (cargs,cargswap: boolean);
            end;
-{$endif}
+
           punarynode = ^tunarynode;
           tunarynode = object(tnode)
              left : pnode;
@@ -320,7 +323,7 @@ unit tree;
 {$endif dummy}
 
     function gennode(t : ttreetyp;l,r : ptree) : ptree;
-    function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
+    function genlabelnode(t : ttreetyp;nr : pasmlabel) : ptree;
     function genloadnode(v : pvarsym;st : psymtable) : ptree;
     function genloadcallnode(v: pprocsym;st: psymtable): ptree;
     function gensinglenode(t : ttreetyp;l : ptree) : ptree;
@@ -328,11 +331,12 @@ unit tree;
     function genordinalconstnode(v : longint;def : pdef) : ptree;
     function genfixconstnode(v : longint;def : pdef) : ptree;
     function gentypeconvnode(node : ptree;t : pdef) : ptree;
-    function gentypenode(t : pdef) : ptree;
+    function gentypenode(t : pdef;sym:ptypesym) : ptree;
     function gencallparanode(expr,next : ptree) : ptree;
-    function genrealconstnode(v : bestreal) : ptree;
+    function genrealconstnode(v : bestreal;def : pdef) : ptree;
     function gencallnode(v : pprocsym;st : psymtable) : ptree;
     function genmethodcallnode(v : pprocsym;st : psymtable;mp : ptree) : ptree;
+    function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
 
     { allow pchar or string for defining a pchar node }
     function genstringconstnode(const s : string) : ptree;
@@ -438,7 +442,7 @@ unit tree;
          { reference info }
          if (location.loc in [LOC_MEM,LOC_REFERENCE]) and
             assigned(location.reference.symbol) then
-           stringdispose(location.reference.symbol);
+           dispose(location.reference.symbol,done);
 {$ifdef EXTDEBUG}
          if firstpasscount>maxfirstpasscount then
             maxfirstpasscount:=firstpasscount;
@@ -740,7 +744,7 @@ unit tree;
                    begin
                       if assigned(symt) then
                         begin
-                           p^.withsymtable:=symt^.next;
+                           p^.withsymtable:=pwithsymtable(symt^.next);
                            dispose(symt,done);
                         end;
                       symt:=p^.withsymtable;
@@ -798,7 +802,7 @@ unit tree;
          { reference info }
          if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
             assigned(p^.location.reference.symbol) then
-           stringdispose(p^.location.reference.symbol);
+           dispose(p^.location.reference.symbol,done);
 {$ifdef extdebug}
          if p^.firstpasscount>maxfirstpasscount then
             maxfirstpasscount:=p^.firstpasscount;
@@ -815,7 +819,7 @@ unit tree;
          hp:=getnode;
          hp^:=p^;
          if assigned(p^.location.reference.symbol) then
-           hp^.location.reference.symbol:=stringdup(p^.location.reference.symbol^);
+           hp^.location.reference.symbol:=p^.location.reference.symbol;
          case p^.disposetyp of
             dt_leftright :
               begin
@@ -887,7 +891,6 @@ unit tree;
          p^.symtableentry:=v;
          p^.symtable:=st;
          p^.is_first := False;
-         p^.is_methodpointer:=false;
          { method pointer load nodes can use the left subtree }
          p^.disposetyp:=dt_left;
          p^.left:=nil;
@@ -913,7 +916,7 @@ unit tree;
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
          p^.resulttype:=nil;
-         p^.withsymtable:=symtable;
+         p^.withsymtable:=pwithsymtable(symtable);
          p^.tablecount:=count;
          set_file_line(l,p);
          genwithnode:=p;
@@ -1058,8 +1061,8 @@ unit tree;
          genenumnode:=p;
       end;
 
+    function genrealconstnode(v : bestreal;def : pdef) : ptree;
 
-    function genrealconstnode(v : bestreal) : ptree;
 
       var
          p : ptree;
@@ -1069,24 +1072,14 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=realconstn;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
-{$ifdef i386}
-         p^.resulttype:=c64floatdef;
-         p^.value_real:=v;
-         { default value is double }
-         p^.realtyp:=ait_real_64bit;
-{$endif}
-{$ifdef m68k}
-         p^.resulttype:=new(pfloatdef,init(s32real));
+         p^.resulttype:=def;
          p^.value_real:=v;
-         { default value is double }
-         p^.realtyp:=ait_real_32bit;
-{$endif}
          p^.lab_real:=nil;
          genrealconstnode:=p;
       end;
@@ -1275,27 +1268,6 @@ unit tree;
          gentypeconvnode:=p;
       end;
 
-    function gentypenode(t : pdef) : ptree;
-
-      var
-         p : ptree;
-
-      begin
-         p:=getnode;
-         p^.disposetyp:=dt_nothing;
-         p^.treetype:=typen;
-         p^.registers32:=0;
-{         p^.registers16:=0;
-         p^.registers8:=0; }
-         p^.registersfpu:=0;
-{$ifdef SUPPORT_MMX}
-         p^.registersmmx:=0;
-{$endif SUPPORT_MMX}
-         p^.resulttype:=generrordef;
-         p^.typenodetype:=t;
-         gentypenode:=p;
-      end;
-
     function gencallnode(v : pprocsym;st : psymtable) : ptree;
 
       var
@@ -1392,7 +1364,7 @@ unit tree;
          genzeronode:=p;
       end;
 
-   function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
+   function genlabelnode(t : ttreetyp;nr : pasmlabel) : ptree;
 
       var
          p : ptree;
@@ -1459,30 +1431,58 @@ unit tree;
       end;
 
 
-      { uses the callnode to create the new procinline node }
-    function genprocinlinenode(callp,code : ptree) : ptree;
+    function gentypenode(t : pdef;sym:ptypesym) : ptree;
+      var
+         p : ptree;
+      begin
+         p:=getnode;
+         p^.disposetyp:=dt_nothing;
+         p^.treetype:=typen;
+         p^.registers32:=0;
+{        p^.registers16:=0;
+         p^.registers8:=0; }
+         p^.registersfpu:=0;
+{$ifdef SUPPORT_MMX}
+         p^.registersmmx:=0;
+{$endif SUPPORT_MMX}
+         p^.resulttype:=generrordef;
+         p^.typenodetype:=t;
+         p^.typenodesym:=sym;
+         gentypenode:=p;
+      end;
 
+    function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
       var
          p : ptree;
 
       begin
          p:=getnode;
-         p^.disposetyp:=dt_left;
-         p^.treetype:=procinlinen;
-         p^.inlineprocdef:=callp^.procdefinition;
-         p^.retoffset:=-4; { less dangerous as zero (PM) }
-         p^.para_offset:=0;
-         p^.para_size:=p^.inlineprocdef^.para_size;
-         if ret_in_param(p^.inlineprocdef^.retdef) then
-           p^.para_size:=p^.para_size+target_os.size_of_pointer;
-         { copy args }
-         p^.left:=getcopy(code);
-         p^.registers32:=code^.registers32;
-         p^.registersfpu:=code^.registersfpu;
+         p^.registers32:=0;
+{        p^.registers16:=0;
+         p^.registers8:=0; }
+         p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
-         p^.resulttype:=p^.inlineprocdef^.retdef;
+         p^.treetype:=loadn;
+         p^.left:=nil;
+         p^.resulttype:=v^.definition;
+         p^.symtableentry:=v;
+         p^.symtable:=st;
+         p^.is_first := False;
+         p^.disposetyp:=dt_left;
+         p^.left:=mp;
+         genloadmethodcallnode:=p;
+      end;
+
+
+      { uses the callnode to create the new procinline node }
+    function genprocinlinenode(callp,code : ptree) : ptree;
+
+      var
+         p : ptree;
+
+      begin
          genprocinlinenode:=p;
       end;
 
@@ -1734,11 +1734,6 @@ unit tree;
                      comment(v_warning,'labnumber field different');
                      error_found:=true;
                   end;
-                  if oldp^.realtyp<>p^.realtyp then
-                  begin
-                     comment(v_warning,'realtyp field different');
-                     error_found:=true;
-                  end;
                end;
            end;
          if not error_found then
@@ -1896,7 +1891,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.6  1999-01-24 22:32:36  florian
+  Revision 1.7  1999-08-01 18:22:39  florian
+   * made it again compilable
+
+  Revision 1.6  1999/01/24 22:32:36  florian
     * well, more changes, especially parts of secondload ported
 
   Revision 1.5  1999/01/23 23:29:49  florian