* smartlinking for sets

  + consts labels are now concated/generated in hcodegen
  * moved some cpu code to cga and some none cpu depended code from cga
    to tree and hcodegen and cleanup of hcodegen
  * assembling .. output reduced for smartlinking ;)

compiler/aasm.pas

@@ -73,10 +73,9 @@ unit aasm;
      type
        { the short name makes typing easier }
        pai = ^tai;
-
        tai = object(tlinkedlist_item)
-          typ : tait;
-          line : longint;
+          typ    : tait;
+          line   : longint;
           infile : pinputfile;
           constructor init;
        end;
@@ -93,9 +92,8 @@ unit aasm;
           destructor done;virtual;
        end;
 
-       pai_symbol = ^tai_symbol;
-
        { generates a common label }
+       pai_symbol = ^tai_symbol;
        tai_symbol = object(tai)
           name : pchar;
           is_global : boolean;
@@ -107,12 +105,11 @@ unit aasm;
        { external types defined for TASM }
        { EXT_ANY for search purposes     }
        texternal_typ = (EXT_ANY,EXT_NEAR, EXT_FAR, EXT_PROC, EXT_BYTE,
-                       EXT_WORD, EXT_DWORD, EXT_CODEPTR, EXT_DATAPTR,
-                       EXT_FWORD, EXT_PWORD, EXT_QWORD, EXT_TBYTE, EXT_ABS);
-
-       pai_external = ^tai_external;
+                        EXT_WORD, EXT_DWORD, EXT_CODEPTR, EXT_DATAPTR,
+                        EXT_FWORD, EXT_PWORD, EXT_QWORD, EXT_TBYTE, EXT_ABS);
 
        { generates an symbol which is marked as external }
+       pai_external = ^tai_external;
        tai_external = object(tai)
           name : pchar;
           exttyp : texternal_typ;
@@ -120,11 +117,9 @@ unit aasm;
           destructor done; virtual;
        end;
 
-       { simple temporary label }
-       pai_label = ^tai_label;
-
        { type for a temporary label }
        { test if used for dispose of unnecessary labels }
+       pai_label = ^tai_label;
        tlabel = record
                 nb : longint;
                 is_used : boolean;
@@ -133,7 +128,6 @@ unit aasm;
                 end;
 
        plabel = ^tlabel;
-
        tai_label = object(tai)
           l : plabel;
           constructor init(_l : plabel);
@@ -147,8 +141,8 @@ unit aasm;
           destructor done; virtual;
        end;
 
-       { to insert a comment into the generated assembler file }
 
+       { to insert a comment into the generated assembler file }
        pai_asm_comment = ^tai_asm_comment;
        tai_asm_comment = object(tai)
           str : pchar;
@@ -156,9 +150,8 @@ unit aasm;
           destructor done; virtual;
        end;
 
-       { alignment for operator }
-
 
+       { alignment for operator }
        pai_align = ^tai_align;
        tai_align = object(tai)
           aligntype: byte;   { 1 = no align, 2 = word align, 4 = dword align }
@@ -168,11 +161,10 @@ unit aasm;
           destructor done;virtual;
        end;
 
-       { Insert a section/segment directive }
 
        tsection=(sec_none,sec_code,sec_data,sec_bss,sec_idata);
 
-
+       { Insert a section/segment directive }
        pai_section = ^tai_section;
        tai_section = object(tai)
           sec      : tsection;
@@ -182,9 +174,9 @@ unit aasm;
           destructor done;virtual;
        end;
 
-       pai_datablock = ^tai_datablock;
 
-       { generates an uninitilizised data block }
+       { generates an uninitializised data block }
+       pai_datablock = ^tai_datablock;
        tai_datablock = object(tai)
           size : longint;
           name : pchar;
@@ -194,9 +186,9 @@ unit aasm;
           destructor done; virtual;
        end;
 
-       pai_const = ^tai_const;
 
        { generates a long integer (32 bit) }
+       pai_const = ^tai_const;
        tai_const = object(tai)
           value : longint;
           constructor init_32bit(_value : longint);
@@ -207,17 +199,17 @@ unit aasm;
           destructor done;virtual;
        end;
 
-       pai_double = ^tai_double;
 
        { generates a double (64 bit real) }
+       pai_double = ^tai_double;
        tai_double = object(tai)
           value : double;
           constructor init(_value : double);
        end;
 
-       pai_comp = ^tai_comp;
 
        { generates an comp (integer over 64 bits) }
+       pai_comp = ^tai_comp;
        tai_comp = object(tai)
           value : bestreal;
           constructor init(_value : bestreal);
@@ -225,24 +217,24 @@ unit aasm;
           constructor init_comp(_value : comp);
        end;
 
-       pai_single = ^tai_single;
 
        { generates a single (32 bit real) }
+       pai_single = ^tai_single;
        tai_single = object(tai)
           value : single;
           constructor init(_value : single);
        end;
 
-       pai_extended = ^tai_extended;
 
        { generates an extended (80 bit real) }
-       { for version above v0_9_8            }
-       { creates a double otherwise          }
+       pai_extended = ^tai_extended;
        tai_extended = object(tai)
           value : bestreal;
           constructor init(_value : bestreal);
        end;
 
+
+       { insert a cut to split into several smaller files }
        pai_cut = ^tai_cut;
        tai_cut = object(tai)
           constructor init;
@@ -251,19 +243,11 @@ unit aasm;
 { for each processor define the best precision }
 { bestreal is defined in globals }
 {$ifdef i386}
-{$ifdef ver_above0_9_8}
 const
        ait_bestreal = ait_real_extended;
 type
        pai_bestreal = pai_extended;
        tai_bestreal = tai_extended;
-{$else ver_above0_9_8}
-const
-       ait_bestreal = ait_real_64bit;
-type
-       pai_bestreal = pai_double;
-       tai_bestreal = tai_double;
-{$endif ver_above0_9_8}
 {$endif i386}
 {$ifdef m68k}
 const
@@ -273,29 +257,31 @@ type
        tai_bestreal = tai_single;
 {$endif m68k}
 
+
        paasmoutput = ^taasmoutput;
        taasmoutput = tlinkedlist;
 
     var
       datasegment,codesegment,bsssegment,
-      internals,externals,debuglist,consts,importssection,
-      exportssection,resourcesection,rttilist : paasmoutput;
+      internals,externals,debuglist,consts,
+      importssection,exportssection,
+      resourcesection,rttilist         : paasmoutput;
 
-   { external symbols without repetition }
+  { external symbols without repetition }
     function search_assembler_symbol(pl : paasmoutput;const _name : string;exttype : texternal_typ) : pai_external;
     procedure concat_external(const _name : string;exttype : texternal_typ);
     procedure concat_internal(const _name : string;exttype : texternal_typ);
 
   implementation
 
-  uses strings,verbose;
+  uses
+    strings,verbose;
 
 {****************************************************************************
                              TAI
  ****************************************************************************}
 
     constructor tai.init;
-
       begin
 {$ifdef GDB}
          infile:=pointer(current_module^.current_inputfile);
@@ -303,6 +289,7 @@ type
            line:=current_module^.current_inputfile^.line_no;
 {$endif GDB}
       end;
+
 {****************************************************************************
                              TAI_SECTION
  ****************************************************************************}
@@ -737,7 +724,14 @@ type
 end.
 {
   $Log$
-  Revision 1.6  1998-05-06 18:36:53  peter
+  Revision 1.7  1998-05-07 00:16:59  peter
+    * smartlinking for sets
+    + consts labels are now concated/generated in hcodegen
+    * moved some cpu code to cga and some none cpu depended code from cga
+      to tree and hcodegen and cleanup of hcodegen
+    * assembling .. output reduced for smartlinking ;)
+
+  Revision 1.6  1998/05/06 18:36:53  peter
     * tai_section extended with code,data,bss sections and enumerated type
     * ident 'compiled by FPC' moved to pmodules
     * small fix for smartlink

compiler/assemble.pas

@@ -175,8 +175,8 @@ begin
   DoAssemble:=true;
   if DoPipe then
    exit;
-  if not externasm then
-   Message1(exec_i_assembling,asmfile);
+  if (smartcnt<=1) and (not externasm) then
+   Message1(exec_i_assembling,name);
   s:=target_asm.asmcmd;
   Replace(s,'$ASM',AsmFile);
   Replace(s,'$OBJ',ObjFile);
@@ -400,7 +400,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  1998-05-04 17:54:24  peter
+  Revision 1.7  1998-05-07 00:17:00  peter
+    * smartlinking for sets
+    + consts labels are now concated/generated in hcodegen
+    * moved some cpu code to cga and some none cpu depended code from cga
+      to tree and hcodegen and cleanup of hcodegen
+    * assembling .. output reduced for smartlinking ;)
+
+  Revision 1.6  1998/05/04 17:54:24  peter
     + smartlinking works (only case jumptable left todo)
     * redesign of systems.pas to support assemblers and linkers
     + Unitname is now also in the PPU-file, increased version to 14
@@ -425,7 +432,4 @@ end.
 
   Revision 1.2  1998/04/08 11:34:18  peter
     * nasm works (linux only tested)
-
-  Revision 1.1.1.1  1998/03/25 11:18:16  root
-  * Restored version
 }

compiler/cga68k.pas

@@ -25,8 +25,7 @@ unit cga68k;
   interface
 
     uses
-       objects,cobjects,verbose,systems,globals,tree,symtable,types,strings,
-       pass_1,hcodegen,aasm,m68k,tgen68k,files,gdb;
+       cobjects,tree,m68k,aasm,symtable;
 
     procedure emitl(op : tasmop;var l : plabel);
     procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister);
@@ -41,7 +40,6 @@ unit cga68k;
     procedure restore(p : ptree);
     procedure emit_push_mem(const ref : treference);
     procedure emitpushreferenceaddr(const ref : treference);
-    procedure swaptree(p: ptree);
     procedure copystring(const dref,sref : treference;len : byte);
     procedure concatcopy(source,dest : treference;size : longint;delsource : boolean);
     { see implementation }
@@ -60,13 +58,9 @@ unit cga68k;
     procedure firstcomplex(p : ptree);
     procedure secondfuncret(var p : ptree);
 
-    { initialize respectively terminates the code generator }
-    { for a new module or procedure                         }
-    procedure codegen_doneprocedure;
-    procedure codegen_donemodule;
-    procedure codegen_newmodule;
-    procedure codegen_newprocedure;
-
+    { generate stackframe for interrupt procedures }
+    procedure generate_interrupt_stackframe_entry;
+    procedure generate_interrupt_stackframe_exit;
     { generate entry code for a procedure.}
     procedure genentrycode(const proc_names:Tstringcontainer;make_global:boolean;
                            stackframe:longint;
@@ -77,6 +71,16 @@ unit cga68k;
 
   implementation
 
+    uses
+       systems,globals,verbose,files,types,pbase,
+       tgenm68k,hcodegen
+{$ifdef GDB}
+       ,gdb
+{$endif}
+       ;
+
+
+
     {
     procedure genconstadd(size : topsize;l : longint;const str : string);
 
@@ -426,17 +430,18 @@ unit cga68k;
            end;
         end;
 
-    procedure swaptree(p:Ptree);
+    procedure generate_interrupt_stackframe_entry;
+      begin
+         { save the registers of an interrupt procedure }
 
-    var swapp:Ptree;
+         { .... also the segment registers }
+      end;
 
-    begin
-        swapp:=p^.right;
-        p^.right:=p^.left;
-        p^.left:=swapp;
-        p^.swaped:=not(p^.swaped);
-    end;
+    procedure generate_interrupt_stackframe_exit;
 
+      begin
+         { restore the registers of an interrupt procedure }
+      end;
 
 procedure genentrycode(const proc_names:Tstringcontainer;make_global:boolean;
                        stackframe:longint;
@@ -1209,161 +1214,21 @@ end;
            end;
       end;
 
-    procedure codegen_newprocedure;
-
-      begin
-         aktbreaklabel:=nil;
-         aktcontinuelabel:=nil;
-         { aktexitlabel:=0; is store in oldaktexitlabel
-           so it must not be reset to zero before this storage !}
-
-         { the type of this lists isn't important }
-         { because the code of this lists is      }
-         { copied to the code segment             }
-         procinfo.aktentrycode:=new(paasmoutput,init);
-         procinfo.aktexitcode:=new(paasmoutput,init);
-         procinfo.aktproccode:=new(paasmoutput,init);
-      end;
-
-    procedure codegen_doneprocedure;
-
-      begin
-         dispose(procinfo.aktentrycode,done);
-         dispose(procinfo.aktexitcode,done);
-         dispose(procinfo.aktproccode,done);
-      end;
-
-    procedure codegen_newmodule;
-
-      begin
-         exprasmlist:=new(paasmoutput,init);
-      end;
-
-    procedure codegen_donemodule;
-
-      begin
-         dispose(exprasmlist,done);
-         dispose(codesegment,done);
-         dispose(bsssegment,done);
-         dispose(datasegment,done);
-         dispose(debuglist,done);
-         dispose(externals,done);
-         dispose(consts,done);
-      end;
-
   end.
 {
   $Log$
-  Revision 1.3  1998-04-29 10:33:46  pierre
+  Revision 1.4  1998-05-07 00:17:00  peter
+    * smartlinking for sets
+    + consts labels are now concated/generated in hcodegen
+    * moved some cpu code to cga and some none cpu depended code from cga
+      to tree and hcodegen and cleanup of hcodegen
+    * assembling .. output reduced for smartlinking ;)
+
+  Revision 1.3  1998/04/29 10:33:46  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output
     + started inline procedures
     + added starstarn : use ** for exponentiation (^ gave problems)
     + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.2  1998/03/28 23:09:54  florian
-    * secondin bugfix (m68k and i386)
-    * overflow checking bugfix (m68k and i386) -- pretty useless in
-      secondadd, since everything is done using 32-bit
-    * loading pointer to routines hopefully fixed (m68k)
-    * flags problem with calls to RTL internal routines fixed (still strcmp
-      to fix) (m68k)
-    * #ELSE was still incorrect (didn't take care of the previous level)
-    * problem with filenames in the command line solved
-    * problem with mangledname solved
-    * linking name problem solved (was case insensitive)
-    * double id problem and potential crash solved
-    * stop after first error
-    * and=>test problem removed
-    * correct read for all float types
-    * 2 sigsegv fixes and a cosmetic fix for Internal Error
-    * push/pop is now correct optimized (=> mov (%esp),reg)
-
-  Revision 1.1.1.1  1998/03/25 11:18:13  root
-  * Restored version
-
-  Revision 1.15  1998/03/22 12:45:38  florian
-    * changes of Carl-Eric to m68k target commit:
-      - wrong nodes because of the new string cg in intel, I had to create
-        this under m68k also ... had to work it out to fix potential alignment
-        problems --> this removes the crash of the m68k compiler.
-      - added absolute addressing in m68k assembler (required for Amiga startup)
-      - fixed alignment problems (because of byte return values, alignment
-        would not be always valid) -- is this ok if i change the offset if odd in
-        setfirsttemp ?? -- it seems ok...
-
-  Revision 1.14  1998/03/10 04:20:37  carl
-    * extdebug problems
-    - removed loadstring as it is not required for the m68k
-
-  Revision 1.13  1998/03/10 01:17:16  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.12  1998/03/09 10:44:35  peter
-    + string='', string<>'', string:='', string:=char optimizes (the first 2
-      were already in cg68k2)
-
-  Revision 1.11  1998/03/06 00:52:03  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.10  1998/03/03 04:12:04  carl
-    * moved generate routines to this unit
-
-  Revision 1.9  1998/03/02 01:48:17  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.8  1998/02/13 10:34:45  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.7  1998/02/12 11:49:50  daniel
-  Yes! Finally! After three retries, my patch!
-
-  Changes:
-
-  Complete rewrite of psub.pas.
-  Added support for DLL's.
-  Compiler requires less memory.
-  Platform units for each platform.
-
-  Revision 1.6  1998/01/11 03:39:02  carl
-  * bugfix of concatcopy , was using wrong reference
-  * bugfix of MOVEQ
-
-  Revision 1.3  1997/12/09 13:30:05  carl
-  + renamed some stuff
-
-  Revision 1.2  1997/12/03 13:59:01  carl
-  + added emitcall as in i386 version.
-
-  Revision 1.1.1.1  1997/11/27 08:32:53  michael
-  FPC Compiler CVS start
-
-
-  Pre-CVS log:
-
-  CEC   Carl-Eric Codere
-  FK    Florian Klaempfl
-  PM    Pierre Muller
-  +     feature added
-  -     removed
-  *     bug fixed or changed
-
-  History:
-  27th september 1997:
-    + first version for MC68000 (using v093 template) (CEC)
-  9th october 1997:
-    * fixed a bug in push_int as well as other routines which used
-      getregister32 while they are not supposed to (because of how
-      the allocation of registers work in parser.pas) (CEC)
-    * Fixed some bugs in the concatcopy routine, was allocating
-      registers which were not supposed to be allocated. (CEC)
-
 }

compiler/cgi386.pas

@@ -20,27 +20,14 @@
 
  ****************************************************************************
 }
-
-{$ifdef tp}
-{$E+,F+,N+,D+,L-,Y+}
+{$ifdef TP}
+  {$E+,F+,N+,D+,L-,Y+}
 {$endif}
 unit cgi386;
-
-
-{***************************************************************************}
 interface
-{***************************************************************************}
 
-uses    verbose,cobjects,systems,globals,tree,
-        symtable,types,strings,pass_1,hcodegen,
-        aasm,i386,tgeni386,files,cgai386
-{$ifdef GDB}
-        ,gdb
-{$endif GDB}
-{$ifdef TP}
-        ,cgi3862
-{$endif TP}
-        ;
+uses
+  tree;
 
 { produces assembler for the expression in variable p }
 { and produces an assembler node at the end           }
@@ -48,27 +35,38 @@ procedure generatecode(var p : ptree);
 
 { produces the actual code }
 function do_secondpass(var p : ptree) : boolean;
-
 procedure secondpass(var p : ptree);
 
+
 {$ifdef test_dest_loc}
-const   { used to avoid temporary assignments }
-        dest_loc_known : boolean = false;
-        in_dest_loc : boolean = false;
-        dest_loc_tree : ptree = nil;
 
-var dest_loc : tlocation;
+const
+  { used to avoid temporary assignments }
+  dest_loc_known : boolean = false;
+  in_dest_loc    : boolean = false;
+  dest_loc_tree  : ptree = nil;
+
+var
+  dest_loc : tlocation;
 
 procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
 {$endif test_dest_loc}
 
 
-
-
-{***************************************************************************}
 implementation
-{***************************************************************************}
+
+   uses
+     verbose,cobjects,systems,globals,files,
+     symtable,types,aasm,i386,
+     pass_1,hcodegen,tgeni386,cgai386
+{$ifdef GDB}
+     ,gdb
+{$endif}
+{$ifdef TP}
+     ,cgi3862
+{$endif}
+     ;
 
     const
        never_copy_const_param : boolean = false;
@@ -610,7 +608,6 @@ implementation
          hp1 : pai;
          lastlabel : plabel;
          found : boolean;
-
       begin
          clear_reference(p^.location.reference);
          lastlabel:=nil;
@@ -628,17 +625,9 @@ implementation
                      begin
                         if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
                           begin
-                             { Florian this caused a internalerror(10)=> no free reg !! }
-                             {if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_80bit) and (pai_extended(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then }
-                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) then
-                               found:=true;
-                             if ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) then
-                               found:=true;
-                             if ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
-                               found:=true;
-                             if found then
+                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
+                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) or
+                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
                                begin
                                   { found! }
                                   p^.labnumber:=lastlabel^.nb;
@@ -654,35 +643,18 @@ implementation
                 begin
                    getlabel(lastlabel);
                    p^.labnumber:=lastlabel^.nb;
+                   concat_constlabel(lastlabel,constreal);
                    case p^.realtyp of
-                     ait_real_64bit : consts^.insert(new(pai_double,init(p^.valued)));
-                     ait_real_32bit : consts^.insert(new(pai_single,init(p^.valued)));
-                     ait_real_extended : consts^.insert(new(pai_extended,init(p^.valued)));
-                     else
-                       internalerror(10120);
-                   end;
-                   if smartlink then
-                    begin
-                      consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
-                        +'$real_const'+tostr(p^.labnumber))));
-                      consts^.insert(new(pai_cut,init));
-                    end
-                   else if current_module^.output_format in [of_nasm,of_obj] then
-                     consts^.insert(new(pai_symbol,init('$real_const'+tostr(p^.labnumber))))
+                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.valued)));
+                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.valued)));
+                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.valued)));
                    else
-                     consts^.insert(new(pai_label,init(lastlabel)));
+                     internalerror(10120);
+                   end;
                 end;
            end;
          stringdispose(p^.location.reference.symbol);
-         if smartlink then
-          begin
-            p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
-                +'$real_const'+tostr(p^.labnumber));
-          end
-         else if current_module^.output_format in [of_nasm,of_obj] then
-           p^.location.reference.symbol:=stringdup('$real_const'+tostr(p^.labnumber))
-         else
-           p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
+         p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,constreal));
       end;
 
     procedure secondfixconst(var p : ptree);
@@ -773,44 +745,25 @@ implementation
                    pc:=getpcharcopy(p);
 {$endif UseAnsiString}
 
-                   { we still will have a problem if there is a #0 inside the pchar }
-{$ifndef UseAnsiString}
-                   consts^.insert(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
+                   concat_constlabel(lastlabel,conststring);
+{$ifdef UseAnsiString}
+  {$ifdef debug}
+                   consts^.concat(new(pai_asm_comment,init('Header of ansistring')));
+  {$endif debug}
+                   consts^.concat(new(pai_const,init_32bit(p^.length)));
+                   consts^.concat(new(pai_const,init_32bit(p^.length)));
+                   consts^.concat(new(pai_const,init_32bit(-1)));
                    { to overcome this problem we set the length explicitly }
                    { with the ending null char }
+                   consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
 {$else UseAnsiString}
-                   consts^.insert(new(pai_string,init_length_pchar(pc,p^.length+1)));
-{$endif UseAnsiString}
-                   if smartlink then
-                    begin
-                      consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
-                        +'$string_const'+tostr(p^.labstrnumber))));
-                      consts^.insert(new(pai_cut,init));
-                    end
-                   else
-                    begin
-                       consts^.insert(new(pai_label,init(lastlabel)));
-                       if current_module^.output_format in [of_nasm,of_obj] then
-                         consts^.insert(new(pai_symbol,init('$string_const'+tostr(p^.labstrnumber))));
-                    end;
-{$ifdef UseAnsiString}
-                   consts^.insert(new(pai_const,init_32bit(-1)));
-                   consts^.insert(new(pai_const,init_32bit(p^.length)));
-                   consts^.insert(new(pai_const,init_32bit(p^.length)));
-{$ifdef debug}
-                   consts^.insert(new(pai_asm_comment,init('Header of ansistring')));
-{$endif debug}
+                   { we still will have a problem if there is a #0 inside the pchar }
+                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
 {$endif UseAnsiString}
                 end;
            end;
          stringdispose(p^.location.reference.symbol);
-         if smartlink then
-           p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
-                     +'$string_const'+tostr(p^.labstrnumber))
-         else if current_module^.output_format in [of_nasm,of_obj] then
-           p^.location.reference.symbol:=stringdup('$string_const'+tostr(p^.labstrnumber))
-         else
-           p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
+         p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,conststring));
          p^.location.loc := LOC_MEM;
       end;
 
@@ -1614,9 +1567,6 @@ implementation
 
     procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
 
-      var
-         pushedregs : tpushed;
-
       begin
 {$ifdef UseAnsiString}
          if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
@@ -2207,7 +2157,6 @@ implementation
          opsize : topsize;
          otlabel,hlabel,oflabel : plabel;
          hregister : tregister;
-         use_strconcat : boolean;
          loc : tloc;
 
       begin
@@ -3446,7 +3395,6 @@ implementation
          opsize : topsize;
          asmop : tasmop;
          pushed : tpushed;
-         dummycoll : tdefcoll;
 
       { produces code for READ(LN) and WRITE(LN) }
 
@@ -3767,10 +3715,9 @@ implementation
       procedure handle_str;
 
         var
-           hp,node,lentree,paratree : ptree;
+           hp,node : ptree;
            dummycoll : tdefcoll;
            is_real,has_length : boolean;
-           real_type : byte;
 
           begin
            pushusedregisters(pushed,$ff);
@@ -4339,7 +4286,7 @@ implementation
 
       var
          l : plabel;
-         i,smallsetvalue : longint;
+         i : longint;
          hp : ptree;
          href,sref : treference;
 
@@ -4351,21 +4298,13 @@ implementation
          clear_reference(href);
          getlabel(l);
          stringdispose(p^.location.reference.symbol);
-         if not (current_module^.output_format in [of_nasm,of_obj]) then
-           begin
-              href.symbol:=stringdup(lab2str(l));
-              datasegment^.concat(new(pai_label,init(l)));
-           end
-         else
-           begin
-              href.symbol:=stringdup('$set_const'+tostr(l^.nb));
-              datasegment^.concat(new(pai_symbol,init('$set_const'+tostr(l^.nb))));
-           end;
+         href.symbol:=stringdup(constlabel2str(l,constseta));
+         concat_constlabel(l,constseta);
            {if psetdef(p^.resulttype)=smallset then
            begin
               smallsetvalue:=(p^.constset^[3]*256)+p^.constset^[2];
               smallsetvalue:=((smallset*256+p^.constset^[1])*256+p^.constset^[1];
-              datasegment^.concat(new(pai_const,init_32bit(smallsetvalue)));
+              consts^.concat(new(pai_const,init_32bit(smallsetvalue)));
               hp:=p^.left;
               if assigned(hp) then
                 begin
@@ -4391,7 +4330,7 @@ implementation
          else    }
            begin
            for i:=0 to 31 do
-             datasegment^.concat(new(pai_const,init_8bit(p^.constset^[i])));
+             consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
          hp:=p^.left;
          if assigned(hp) then
            begin
@@ -6043,7 +5982,14 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.21  1998-05-06 08:38:36  pierre
+  Revision 1.22  1998-05-07 00:17:00  peter
+    * smartlinking for sets
+    + consts labels are now concated/generated in hcodegen
+    * moved some cpu code to cga and some none cpu depended code from cga
+      to tree and hcodegen and cleanup of hcodegen
+    * assembling .. output reduced for smartlinking ;)
+
+  Revision 1.21  1998/05/06 08:38:36  pierre
     * better position info with UseTokenInfo
       UseTokenInfo greatly simplified
     + added check for changed tree after first time firstpass
@@ -6130,304 +6076,4 @@ end.
       in MEM parsing for go32v2
       better external symbol creation
       support for rhgdb.exe (lowercase file names)
-
-  Revision 1.3  1998/03/28 23:09:55  florian
-    * secondin bugfix (m68k and i386)
-    * overflow checking bugfix (m68k and i386) -- pretty useless in
-      secondadd, since everything is done using 32-bit
-    * loading pointer to routines hopefully fixed (m68k)
-    * flags problem with calls to RTL internal routines fixed (still strcmp
-      to fix) (m68k)
-    * #ELSE was still incorrect (didn't take care of the previous level)
-    * problem with filenames in the command line solved
-    * problem with mangledname solved
-    * linking name problem solved (was case insensitive)
-    * double id problem and potential crash solved
-    * stop after first error
-    * and=>test problem removed
-    * correct read for all float types
-    * 2 sigsegv fixes and a cosmetic fix for Internal Error
-    * push/pop is now correct optimized (=> mov (%esp),reg)
-
-  Revision 1.2  1998/03/26 11:18:30  florian
-    - switch -Sa removed
-    - support of a:=b:=0 removed
-
-  Revision 1.1.1.1  1998/03/25 11:18:13  root
-  * Restored version
-
-  Revision 1.58  1998/03/24 21:48:30  florian
-    * just a couple of fixes applied:
-         - problem with fixed16 solved
-         - internalerror 10005 problem fixed
-         - patch for assembler reading
-         - small optimizer fix
-         - mem is now supported
-
-  Revision 1.57  1998/03/16 22:42:19  florian
-    * some fixes of Peter applied:
-      ofs problem, profiler support
-
-  Revision 1.56  1998/03/13 22:45:57  florian
-    * small bug fixes applied
-
-  Revision 1.55  1998/03/11 22:22:51  florian
-    * Fixed circular unit uses, when the units are not in the current dir (from Peter)
-    * -i shows correct info, not <lf> anymore (from Peter)
-    * linking with shared libs works again (from Peter)
-
-  Revision 1.54  1998/03/10 23:48:35  florian
-    * a couple of bug fixes to get the compiler with -OGaxz compiler, sadly
-      enough, it doesn't run
-
-  Revision 1.53  1998/03/10 16:27:37  pierre
-    * better line info in stabs debug
-    * symtabletype and lexlevel separated into two fields of tsymtable
-    + ifdef MAKELIB for direct library output, not complete
-    + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
-      working
-    + ifdef TESTFUNCRET for setting func result in underfunction, not
-      working
-
-  Revision 1.52  1998/03/10 01:17:16  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.51  1998/03/09 10:44:37  peter
-    + string='', string<>'', string:='', string:=char optimizes (the first 2
-      were already in cg68k2)
-
-  Revision 1.50  1998/03/06 00:52:10  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.49  1998/03/04 01:34:56  peter
-    * messages for unit-handling and assembler/linker
-    * the compiler compiles without -dGDB, but doesn't work yet
-    + -vh for Hint
-
-  Revision 1.48  1998/03/03 20:36:51  florian
-    * bug in second_smaller fixed
-
-  Revision 1.47  1998/03/03 01:08:24  florian
-    * bug0105 and bug0106 problem solved
-
-  Revision 1.46  1998/03/02 01:48:24  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.45  1998/03/01 22:46:06  florian
-    + some win95 linking stuff
-    * a couple of bugs fixed:
-      bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
-
-  Revision 1.44  1998/02/24 16:49:57  peter
-    * stackframe ommiting generated 'ret $-4'
-    + timer.pp bp7 version
-    * innr.inc are now the same files
-
-  Revision 1.43  1998/02/22 23:03:12  peter
-    * renamed msource->mainsource and name->unitname
-    * optimized filename handling, filename is not seperate anymore with
-      path+name+ext, this saves stackspace and a lot of fsplit()'s
-    * recompiling of some units in libraries fixed
-    * shared libraries are working again
-    + $LINKLIB <lib> to support automatic linking to libraries
-    + libraries are saved/read from the ppufile, also allows more libraries
-      per ppufile
-
-  Revision 1.42  1998/02/21 04:09:13  carl
-    * stupid syntax error fix
-
-  Revision 1.41  1998/02/20 20:35:14  carl
-    * Fixed entry and exit code which was ALL messed up
-
-  Revision 1.40  1998/02/19 12:15:08  daniel
-  * Optimized a statement that did pain to my eyes.
-
-  Revision 1.39  1998/02/17 21:20:40  peter
-    + Script unit
-    + __EXIT is called again to exit a program
-    - target_info.link/assembler calls
-    * linking works again for dos
-    * optimized a few filehandling functions
-    * fixed stabs generation for procedures
-
-  Revision 1.38  1998/02/15 21:16:12  peter
-    * all assembler outputs supported by assemblerobject
-    * cleanup with assembleroutputs, better .ascii generation
-    * help_constructor/destructor are now added to the externals
-    - generation of asmresponse is not outputformat depended
-
-  Revision 1.37  1998/02/14 01:45:15  peter
-    * more fixes
-    - pmode target is removed
-    - search_as_ld is removed, this is done in the link.pas/assemble.pas
-    + findexe() to search for an executable (linker,assembler,binder)
-
-  Revision 1.36  1998/02/13 22:26:19  peter
-    * fixed a few SigSegv's
-    * INIT$$ was not written for linux!
-    * assembling and linking works again for linux and dos
-    + assembler object, only attasmi3 supported yet
-    * restore pp.pas with AddPath etc.
-
-  Revision 1.35  1998/02/13 10:34:50  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.34  1998/02/12 17:18:57  florian
-    * fixed to get remake3 work, but needs additional fixes (output, I don't like
-      also that aktswitches isn't a pointer)
-
-  Revision 1.33  1998/02/12 11:49:56  daniel
-  Yes! Finally! After three retries, my patch!
-
-  Changes:
-
-  Complete rewrite of psub.pas.
-  Added support for DLL's.
-  Compiler requires less memory.
-  Platform units for each platform.
-
-  Revision 1.23  1998/02/01 19:39:50  florian
-    * clean up
-    * bug0029 fixed
-
-  Revision 1.22  1998/01/27 22:02:29  florian
-    * small bug fix to the compiler work, I forgot a not(...):(
-
-  Revision 1.21  1998/01/27 10:49:15  florian
-  *** empty log message ***
-
-  Revision 1.20  1998/01/26 17:29:14  florian
-    * Peter's fix for bug0046 applied
-
-  Revision 1.19  1998/01/25 22:28:55  florian
-    * a lot bug fixes on the DOM
-
-  Revision 1.18  1998/01/21 21:29:50  florian
-    * some fixes for Delphi classes
-
-  Revision 1.17  1998/01/20 23:53:04  carl
-    * bugfix 74 (FINAL, the one from Pierre was incomplete under BP)
-
-  Revision 1.16  1998/01/19 10:25:14  pierre
-    * bug in object function call in main program or unit init fixed
-
-  Revision 1.15  1998/01/16 22:34:29  michael
-  * Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
-    in this compiler :)
-
-  Revision 1.14  1998/01/16 18:03:11  florian
-    * small bug fixes, some stuff of delphi styled constructores added
-
-  Revision 1.13  1998/01/13 23:11:05  florian
-    + class methods
-
-  Revision 1.12  1998/01/07 00:16:44  michael
-  Restored released version (plus fixes) as current
-
-  Revision 1.10  1997/12/13 18:59:42  florian
-  + I/O streams are now also declared as external, if neccessary
-  * -Aobj generates now a correct obj file via nasm
-
-  Revision 1.9  1997/12/10 23:07:16  florian
-  * bugs fixed: 12,38 (also m68k),39,40,41
-  + warning if a system unit is without -Us compiled
-  + warning if a method is virtual and private (was an error)
-  * some indentions changed
-  + factor does a better error recovering (omit some crashes)
-  + problem with @type(x) removed (crashed the compiler)
-
-  Revision 1.8  1997/12/09 13:35:47  carl
-  + renamed pai_labeled386 to pai_labeled
-  + renamed S_T to S_X
-
-  Revision 1.7  1997/12/04 10:39:11  pierre
-    + secondadd separated in file cgi386ad.inc
-
-  Revision 1.5  1997/11/29 15:41:45  florian
-  only small changes
-
-  Revision 1.3  1997/11/28 15:43:15  florian
-  Fixed stack ajustment bug, 0.9.8 compiles now 0.9.8 without problems.
-
-  Revision 1.2  1997/11/28 14:26:19  florian
-  Fixed some bugs
-
-  Revision 1.1.1.1  1997/11/27 08:32:54  michael
-  FPC Compiler CVS start
-
-
-  Pre-CVS log:
-
-  FK     Florian Klaempfl
-  PM     Pierre Muller
-  +      feature added
-  -      removed
-  *      bug fixed or changed
-
-  History (started with version 0.9.0):
-      23th october 1996:
-           + some emit calls replaced (FK)
-      24th october 1996:
-         * for bug fixed (FK)
-      26th october 1996:
-         * english comments (FK)
-       5th november 1996:
-         * new init and terminate code (FK)
-
-      ...... some items missed
-
-      19th september 1997:
-         * a call to a function procedure a;[ C ]; doesn't crash the stack
-           furthermore (FK)
-         * bug in var_reg assignment fixed
-           did not keep p^.register32 registers free ! (PM)
-      22th september 1997:
-         * stack layout for nested procedures in methods modified:
-           ESI is no more pushed (must be loaded via framepointer) (FK)
-      24th september 1997:
-         + strings constants in consts list to check for existing strings (PM)
-      24th september 1997:
-         * constructor bug removed (FK)
-         * source splitted (into cgi386 and cgi3862 for FPC) (FK)
-         * line_no and inputfile are now in secondpass saved (FK)
-         * patching error removed (the switch -Ox was always used
-           because of a misplaced end) (FK)
-         + strings constants in consts list to check for existing strings (PM)
-      25th september 1997:
-         + secondload provides now the informations for open arrays (FK)
-         + support of high for open arrays (FK)
-         + the high parameter is now pushed for open arrays (FK)
-      3th october 1997:
-         + function second_bool_to_byte for ord(boolean) (PM)
-      4th october 1997:
-         + code for in_pred_x in_succ_x no bound check (PM)
-      13th october 1997:
-         + added code for static modifier for objects variables and methods (PM)
-      14th october 1997:
-         + second_bool_to_byte handles now also LOC_JUMP (FK)
-      28th october 1997:
-         * in secondcallparan bug with param from read/write while nil defcoll^.data
-           fixed (PM)
-      3rd november 1997:
-         + added code for symdif for sets (PM)
-      28th october 1997:
-         * in secondcallparan bug with param from read/write while nil defcoll^.data
-           fixed (PM)
-      3rd november 1997:
-         + added code for symdif for sets (PM)
-      12th november 1997:
-         + added text write for boolean (PM)
-         * bug in secondcallparan for LOC_FPU (assumed that the type was double) (PM)
-      13th november 1997:
-         + added partial code for u32bit support (PM)
-      22th november 1997:
-         * bug in stack alignment found (PM)
-
 }

compiler/hcodegen.pas

@@ -24,32 +24,25 @@ unit hcodegen;
 
   interface
 
-     uses
-        cobjects,systems,globals,tree,symtable,types,strings,aasm
+    uses
+      aasm,tree,symtable
 {$ifdef i386}
-       ,i386
+      ,i386
 {$endif}
 {$ifdef m68k}
-       ,m68k
+      ,m68k
 {$endif}
-       ;
+      ;
 
     const
-       { set, if the procedure uses asm }
-       pi_uses_asm = $1;
-       { set, if the procedure is exported by an unit }
-       pi_is_global = $2;
-       { set, if the procedure does a call }
-       { this is for the optimizer         }
-       pi_do_call = $4;
-       { if the procedure is an operator   }
-       pi_operator = $8;
-       { set, if the procedure is an external C function }
-       pi_C_import = $10;
+       pi_uses_asm  = $1;       { set, if the procedure uses asm }
+       pi_is_global = $2;       { set, if the procedure is exported by an unit }
+       pi_do_call   = $4;       { set, if the procedure does a call }
+       pi_operator  = $8;       { set, if the procedure is an operator   }
+       pi_C_import  = $10;      { set, if the procedure is an external C function }
 
     type
        pprocinfo = ^tprocinfo;
-
        tprocinfo = record
           { pointer to parent in nested procedures }
           parent : pprocinfo;
@@ -79,10 +72,8 @@ unit hcodegen;
           { register used as frame pointer }
           framepointer : tregister;
 
-{$ifdef GDB}
           { true, if the procedure is exported by an unit }
           globalsymbol : boolean;
-{$endif * GDB *}
 
           { true, if the procedure should be exported (only OS/2) }
           exported : boolean;
@@ -97,152 +88,198 @@ unit hcodegen;
        { info about the current sub routine }
        procinfo : tprocinfo;
 
-       { Die Nummer der Label die bei BREAK bzw CONTINUE }
-       { angesprungen werden sollen }
+       { labels for BREAK and CONTINUE }
        aktbreaklabel,aktcontinuelabel : plabel;
 
-       { truelabel wird angesprungen, wenn ein Ausdruck true ist, falselabel }
-       { entsprechend                                                        }
+       { label when the result is true or false }
        truelabel,falselabel : plabel;
 
-       { Nr des Labels welches zum Verlassen eines Unterprogramm }
-       { angesprungen wird                                       }
+       { label to leave the sub routine }
        aktexitlabel : plabel;
 
-       { also an exit label, only used we need to clear only the }
-       { stack                                                   }
+       { also an exit label, only used we need to clear only the stack }
        aktexit2label : plabel;
 
        { only used in constructor for fail or if getmem fails }
        quickexitlabel : plabel;
 
-       { this asm list contains the debug info }
-       {debuginfos : paasmoutput;  debuglist is enough }
-
        { Boolean, wenn eine loadn kein Assembler erzeugt hat }
        simple_loadn : boolean;
 
-       { enth„lt die gesch„tzte Durchlaufanzahl*100 f�r den }
-       { momentan bearbeiteten Baum                         }
+       { tries to hold the amount of times which the current tree is processed  }
        t_times : longint;
 
        { true, if an error while code generation occurs }
        codegenerror : boolean;
 
-    { some support routines for the case instruction }
+    { initialize respectively terminates the code generator }
+    { for a new module or procedure                         }
+    procedure codegen_doneprocedure;
+    procedure codegen_donemodule;
+    procedure codegen_newmodule;
+    procedure codegen_newprocedure;
+
+
 
     { counts the labels }
     function case_count_labels(root : pcaserecord) : longint;
-
     { searches the highest label }
     function case_get_max(root : pcaserecord) : longint;
-
     { searches the lowest label }
     function case_get_min(root : pcaserecord) : longint;
 
-    { concates the ASCII string to the data segment }
-    procedure generate_ascii(hs : string);
 
-    { inserts the ASCII string to the data segment }
-    procedure generate_ascii_insert(hs : string);
-
-    { concates the ASCII string from pchar to the data  segment }
+    { concates/inserts the ASCII string to the data segment }
+    procedure generate_ascii(const hs : string);
+    procedure generate_ascii_insert(const hs : string);
+    { concates/inserts the ASCII string from pchar to the data  segment }
     { WARNING : if hs has no #0 and strlen(hs)=length           }
     { the terminal zero is not written                          }
     procedure generate_pascii(hs : pchar;length : longint);
+    procedure generate_pascii_insert(hs : pchar;length : longint);
 
 
-    { inserts the ASCII string from pchar to the data segment }
-    { see WARNING above                                       }
-    procedure generate_pascii_insert(hs : pchar;length : longint);
+    { convert/concats a label for constants in the consts section }
+    function constlabel2str(p:plabel;ctype:tconsttype):string;
+    procedure concat_constlabel(p:plabel;ctype:tconsttype);
 
-    procedure generate_interrupt_stackframe_entry;
-    procedure generate_interrupt_stackframe_exit;
 
-  implementation
+implementation
 
-{$ifdef i386}
-    procedure generate_interrupt_stackframe_entry;
+     uses
+        cobjects,globals,files,strings;
+
+{*****************************************************************************
+         initialize/terminate the codegen for procedure and modules
+*****************************************************************************}
 
+    procedure codegen_newprocedure;
       begin
-         { save the registers of an interrupt procedure }
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
-
-         { .... also the segment registers }
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_W,R_DS)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_W,R_ES)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_W,R_FS)));
-         procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_W,R_GS)));
+         aktbreaklabel:=nil;
+         aktcontinuelabel:=nil;
+         { aktexitlabel:=0; is store in oldaktexitlabel
+           so it must not be reset to zero before this storage !}
+         { the type of this lists isn't important }
+         { because the code of this lists is      }
+         { copied to the code segment             }
+         procinfo.aktentrycode:=new(paasmoutput,init);
+         procinfo.aktexitcode:=new(paasmoutput,init);
+         procinfo.aktproccode:=new(paasmoutput,init);
+         procinfo.aktlocaldata:=new(paasmoutput,init);
       end;
 
-    procedure generate_interrupt_stackframe_exit;
 
+
+    procedure codegen_doneprocedure;
       begin
-         { restore the registers of an interrupt procedure }
-         { this was all with entrycode instead of exitcode !!}
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_L,R_EBX)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
-
-         { .... also the segment registers }
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_W,R_DS)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_W,R_ES)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_W,R_FS)));
-         procinfo.aktexitcode^.concat(new(pai386,op_reg(A_POP,S_W,R_GS)));
-
-        { this restores the flags }
-         procinfo.aktexitcode^.concat(new(pai386,op_none(A_IRET,S_NO)));
+         dispose(procinfo.aktentrycode,done);
+         dispose(procinfo.aktexitcode,done);
+         dispose(procinfo.aktproccode,done);
+         dispose(procinfo.aktlocaldata,done);
       end;
-{$endif}
-{$ifdef m68k}
-    procedure generate_interrupt_stackframe_entry;
+
+
+
+    procedure codegen_newmodule;
       begin
-         { save the registers of an interrupt procedure }
+         exprasmlist:=new(paasmoutput,init);
+         datasegment:=new(paasmoutput,init);
+         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;
+      end;
+
 
-         { .... also the segment registers }
+
+    procedure codegen_donemodule;
+      begin
+         dispose(exprasmlist,done);
+         dispose(codesegment,done);
+         dispose(bsssegment,done);
+         dispose(datasegment,done);
+         dispose(debuglist,done);
+         dispose(externals,done);
+         dispose(consts,done);
+         dispose(rttilist,done);
+         if assigned(importssection) then
+          dispose(importssection,done);
+         if assigned(exportssection) then
+          dispose(exportssection,done);
+         if assigned(resourcesection) then
+          dispose(resourcesection,done);
       end;
 
-    procedure generate_interrupt_stackframe_exit;
+        
+{*****************************************************************************
+                              Case Helpers
+*****************************************************************************}
+
+    function case_count_labels(root : pcaserecord) : longint;
+      var
+         _l : longint;
+
+      procedure count(p : pcaserecord);
+        begin
+           inc(_l);
+           if assigned(p^.less) then
+             count(p^.less);
+           if assigned(p^.greater) then
+             count(p^.greater);
+        end;
 
       begin
-         { restore the registers of an interrupt procedure }
+         _l:=0;
+         count(root);
+         case_count_labels:=_l;
       end;
-{$endif}
 
-    procedure generate_ascii(hs : string);
 
+    function case_get_max(root : pcaserecord) : longint;
+      var
+         hp : pcaserecord;
       begin
-         while length(hs)>32 do
-           begin
-              datasegment^.concat(new(pai_string,init(copy(hs,1,32))));
-              delete(hs,1,32);
-           end;
-         datasegment^.concat(new(pai_string,init(hs)))
+         hp:=root;
+         while assigned(hp^.greater) do
+           hp:=hp^.greater;
+         case_get_max:=hp^._high;
       end;
 
-    procedure generate_ascii_insert(hs : string);
+
+    function case_get_min(root : pcaserecord) : longint;
+      var
+         hp : pcaserecord;
+      begin
+         hp:=root;
+         while assigned(hp^.less) do
+           hp:=hp^.less;
+         case_get_min:=hp^._low;
+      end;
 
 
+{*****************************************************************************
+                              String Helpers
+*****************************************************************************}
+
+    procedure generate_ascii(const hs : string);
+      begin
+         datasegment^.concat(new(pai_string,init(hs)))
+      end;
+
+
+    procedure generate_ascii_insert(const hs : string);
       begin
-         while length(hs)>32 do
-           begin
-              datasegment^.insert(new(pai_string,init(copy(hs,length(hs)-32+1,length(hs)))));
-              { should be avoid very slow }
-              delete(hs,length(hs)-32+1,length(hs));
-           end;
          datasegment^.insert(new(pai_string,init(hs)));
       end;
 
-    function strnew(p : pchar;length : longint) : pchar;
 
+    function strnew(p : pchar;length : longint) : pchar;
       var
          pc : pchar;
       begin
@@ -251,12 +288,13 @@ unit hcodegen;
          strnew:=pc;
       end;
 
+
+
     { concates the ASCII string from pchar to the const segment }
     procedure generate_pascii(hs : pchar;length : longint);
       var
          real_end,current_begin,current_end : pchar;
          c :char;
-
       begin
          if assigned(hs) then
            begin
@@ -284,7 +322,6 @@ unit hcodegen;
       var
          real_end,current_begin,current_end : pchar;
          c :char;
-
       begin
          if assigned(hs) then
            begin
@@ -308,56 +345,54 @@ unit hcodegen;
       end;
 
 
-    function case_count_labels(root : pcaserecord) : longint;
-
-      var
-         _l : longint;
-
-      procedure count(p : pcaserecord);
+{*****************************************************************************
+                              Const Helpers
+*****************************************************************************}
 
-        begin
-           inc(_l);
-           if assigned(p^.less) then
-             count(p^.less);
-           if assigned(p^.greater) then
-             count(p^.greater);
-        end;
-
-      begin
-         _l:=0;
-         count(root);
-         case_count_labels:=_l;
-      end;
-
-    function case_get_max(root : pcaserecord) : longint;
-
-      var
-         hp : pcaserecord;
+    const
+      consttypestr : array[tconsttype] of string[6]=
+        ('ord','string','real','bool','int','char','set');
 
+    function constlabel2str(p:plabel;ctype:tconsttype):string;
       begin
-         hp:=root;
-         while assigned(hp^.greater) do
-           hp:=hp^.greater;
-         case_get_max:=hp^._high;
+        if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
+         constlabel2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb)
+        else
+         constlabel2str:=lab2str(p);
       end;
 
-    function case_get_min(root : pcaserecord) : longint;
 
+    procedure concat_constlabel(p:plabel;ctype:tconsttype);
       var
-         hp : pcaserecord;
-
+        s : string;
       begin
-         hp:=root;
-         while assigned(hp^.less) do
-           hp:=hp^.less;
-         case_get_min:=hp^._low;
+        if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
+         begin
+           s:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb);
+           if smartlink then
+            begin
+              consts^.concat(new(pai_cut,init));
+              consts^.concat(new(pai_symbol,init_global(s)))
+            end
+           else
+            consts^.concat(new(pai_symbol,init_global(s)));
+         end
+        else
+         consts^.concat(new(pai_label,init(p)));
       end;
 
 end.
 
 {
   $Log$
-  Revision 1.3  1998-05-06 08:38:40  pierre
+  Revision 1.4  1998-05-07 00:17:01  peter
+    * smartlinking for sets
+    + consts labels are now concated/generated in hcodegen
+    * moved some cpu code to cga and some none cpu depended code from cga
+      to tree and hcodegen and cleanup of hcodegen
+    * assembling .. output reduced for smartlinking ;)
+
+  Revision 1.3  1998/05/06 08:38:40  pierre
     * better position info with UseTokenInfo
       UseTokenInfo greatly simplified
     + added check for changed tree after first time firstpass
@@ -372,51 +407,4 @@ end.
     + started inline procedures
     + added starstarn : use ** for exponentiation (^ gave problems)
     + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.1.1.1  1998/03/25 11:18:13  root
-  * Restored version
-
-  Revision 1.6  1998/03/10 16:27:38  pierre
-    * better line info in stabs debug
-    * symtabletype and lexlevel separated into two fields of tsymtable
-    + ifdef MAKELIB for direct library output, not complete
-    + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
-      working
-    + ifdef TESTFUNCRET for setting func result in underfunction, not
-      working
-
-  Revision 1.5  1998/03/10 01:17:19  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.4  1998/03/02 01:48:37  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.3  1998/02/13 10:35:03  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.2  1998/01/16 18:03:15  florian
-    * small bug fixes, some stuff of delphi styled constructores added
-
-  Revision 1.1.1.1  1997/11/27 08:32:56  michael
-  FPC Compiler CVS start
-
-  Pre-CVS log:
-
-  CEC   Carl-Eric Codere
-  FK    Florian Klaempfl
-  PM    Pierre Muller
-  +     feature added
-  -     removed
-  *     bug fixed or changed
-
-  History:
-       5th september 1997:
-         + added support for MC68000 (CEC)
-      22th september 1997:
-         + added tprocinfo member parent (FK)
 }

compiler/tree.pas

@@ -276,6 +276,7 @@ unit tree;
 
     function equal_trees(t1,t2 : ptree) : boolean;
 
+    procedure swaptree(p:Ptree);
     procedure disposetree(p : ptree);
     procedure putnode(p : ptree);
     function getnode : ptree;
@@ -464,6 +465,19 @@ unit tree;
          dispose(p);
       end;
 
+    procedure swaptree(p:Ptree);
+
+    var swapp:Ptree;
+
+    begin
+        swapp:=p^.right;
+        p^.right:=p^.left;
+        p^.left:=swapp;
+        p^.swaped:=not(p^.swaped);
+    end;
+
+
+
     procedure disposetree(p : ptree);
 
       begin
@@ -1522,7 +1536,14 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.7  1998-05-06 15:04:21  pierre
+  Revision 1.8  1998-05-07 00:17:01  peter
+    * smartlinking for sets
+    + consts labels are now concated/generated in hcodegen
+    * moved some cpu code to cga and some none cpu depended code from cga
+      to tree and hcodegen and cleanup of hcodegen
+    * assembling .. output reduced for smartlinking ;)
+
+  Revision 1.7  1998/05/06 15:04:21  pierre
     + when trying to find source files of a ppufile
       check the includepathlist for included files
       the main file must still be in the same directory
@@ -1557,95 +1578,5 @@ end.
   Revision 1.2  1998/04/07 22:45:05  florian
     * bug0092, bug0115 and bug0121 fixed
     + packed object/class/array
-
-  Revision 1.1.1.1  1998/03/25 11:18:13  root
-  * Restored version
-
-  Revision 1.15  1998/03/24 21:48:36  florian
-    * just a couple of fixes applied:
-         - problem with fixed16 solved
-         - internalerror 10005 problem fixed
-         - patch for assembler reading
-         - small optimizer fix
-         - mem is now supported
-
-  Revision 1.14  1998/03/10 16:27:46  pierre
-    * better line info in stabs debug
-    * symtabletype and lexlevel separated into two fields of tsymtable
-    + ifdef MAKELIB for direct library output, not complete
-    + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
-      working
-    + ifdef TESTFUNCRET for setting func result in underfunction, not
-      working
-
-  Revision 1.13  1998/03/10 01:17:30  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.12  1998/03/02 01:49:37  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.11  1998/02/27 09:26:18  daniel
-  * Changed symtable handling so no junk symtable is put on the symtablestack.
-
-  Revision 1.10  1998/02/13 10:35:54  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.9  1998/02/12 11:50:51  daniel
-  Yes! Finally! After three retries, my patch!
-
-  Changes:
-
-  Complete rewrite of psub.pas.
-  Added support for DLL's.
-  Compiler requires less memory.
-  Platform units for each platform.
-
-  Revision 1.8  1998/02/04 14:39:31  florian
-    * small clean up
-
-  Revision 1.7  1998/01/13 23:11:16  florian
-    + class methods
-
-  Revision 1.6  1998/01/11 04:16:36  carl
-  + correct floating point support for m68k
-
-  Revision 1.5  1998/01/07 00:17:11  michael
-  Restored released version (plus fixes) as current
-
-  Revision 1.3  1997/12/04 12:02:15  pierre
-     + added a counter of max firstpass's for a ptree
-       for debugging only in ifdef extdebug
-
-  Revision 1.2  1997/11/29 15:43:08  florian
-  * some minor changes
-
-  Revision 1.1.1.1  1997/11/27 08:33:03  michael
-  FPC Compiler CVS start
-
-  Pre-CVS log:
-
-    CEC    Carl-Eric Codere
-    FK     Florian Klaempfl
-    PM     Pierre Muller
-    +      feature added
-    -      removed
-    *      bug fixed or changed
-
-    History:
-        19th october 1996:
-            + adapted to version 0.9.0
-         6th september 1997:
-            + added support for MC68000 (CEC)
-         3rd october 1997:
-            + added tc_bool_2_u8bit for in_ord_x (PM)
-         3rd november1997:
-            + added symdifn for sets (PM)
-         13th november 1997:
-            + added partial code for u32bit support (PM)
 }