+ new scanner

  * $makelib -> if smartlink
  * small filename fixes pmodule.setfilename
  * moved import from files.pas -> import.pas

compiler/aasm.pas

@@ -48,26 +48,21 @@ unit aasm;
           ait_comp,
           ait_external,
           ait_align,
-
           { the following is only used by the win32 version of the compiler }
           { and only the GNU AS Win32 is able to write it                   }
           ait_section,
           ait_const_rva,
-          { the following must is system depended }
 {$ifdef GDB}
           ait_stabn,
           ait_stabs,
           ait_stab_function_name,
 {$endif GDB}
-{$ifdef MAKELIB}
-          { used to split unit into tiny assembler files }
-          ait_cut,
-{$endif MAKELIB}
-          { never used, makes insertation of new ait_ easier to type }
+          ait_cut, { used to split into tiny assembler files }
 {$ifdef REGALLOC}
           ait_regalloc,
           ait_regdealloc,
 {$endif REGALLOC}
+          { never used, makes insertation of new ait_ easier to type }
           ait_dummy);
 
      type
@@ -215,13 +210,11 @@ unit aasm;
           value : bestreal;
           constructor init(_value : bestreal);
        end;
-{$ifdef MAKELIB}
-       pai_cut = ^tai_cut;
 
+       pai_cut = ^tai_cut;
        tai_cut = object(tai)
           constructor init;
        end;
-{$endif MAKELIB}
 
 { for each processor define the best precision }
 { bestreal is defined in globals }
@@ -661,23 +654,26 @@ type
          inherited done;
       end;
 
-{$ifdef MAKELIB}
 {****************************************************************************
                               TAI_CUT
  ****************************************************************************}
 
      constructor tai_cut.init;
-
        begin
           inherited init;
           typ:=ait_cut;
        end;
-{$endif MAKELIB}
 
 end.
 {
   $Log$
-  Revision 1.2  1998-04-09 15:46:37  florian
+  Revision 1.3  1998-04-27 23:10:27  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.2  1998/04/09 15:46:37  florian
     + register allocation tracing stuff added
 
   Revision 1.1.1.1  1998/03/25 11:18:16  root

compiler/assemble.pas

@@ -33,7 +33,7 @@ const
 {$else}
   AsmOutSize=10000;
 {$endif}
-
+  SmartExt='.sl';
 
 {$ifdef i386}
 { tof = (of_none,of_o,of_obj,of_masm,of_att,of_nasm,of_win32) }
@@ -48,38 +48,39 @@ const
 type
   PAsmList=^TAsmList;
   TAsmList=object
-    outcnt  : longint;
-    outbuf  : array[0..AsmOutSize-1] of char;
-    outfile : file;
-    constructor Init;
-    destructor Done;
+  {filenames}
+    path     : dirstr;
+    name     : namestr;
+    asmfile,
+    objfile,
+    srcfile,
+    as_bin   : string;
+    smartcnt : longint;
+  {outfile}
+    outcnt   : longint;
+    outbuf   : array[0..AsmOutSize-1] of char;
+    outfile  : file;
+    Constructor Init(const fn:string);
+    Destructor Done;
+    Function  FindAssembler(curr_of:tof):string;
+    Function  CallAssembler(const command,para:string):Boolean;
+    Function  DoAssemble:boolean;
+    Procedure RemoveAsm;
+    procedure NextSmartName;
     Procedure AsmFlush;
     Procedure AsmWrite(const s:string);
     Procedure AsmWritePChar(p:pchar);
     Procedure AsmWriteLn(const s:string);
     Procedure AsmLn;
-    procedure OpenAsmList(const fn,fn2:string);
-    procedure CloseAsmList;
+    procedure AsmCreate;
+    procedure AsmClose;
     procedure WriteTree(p:paasmoutput);virtual;
     procedure WriteAsmList;virtual;
   end;
 
-  PAsmFile=^TAsmFile;
-  TAsmFile=object
-    asmlist : pasmlist;
-    path:dirstr;
-    asmfile,
-    objfile,
-    srcfile,
-    as_bin  : string;
-    Constructor Init(const fn:string);
-    Destructor Done;
-    Function FindAssembler(curr_of:tof):string;
-    Procedure WriteAsmSource;
-    Function CallAssembler(const command,para:string):Boolean;
-    Procedure RemoveAsm;
-    Function DoAssemble:boolean;
-  end;
+Procedure GenerateAsm(const fn:string);
+Procedure OnlyAsm(const fn:string);
+
 
 Implementation
 
@@ -100,12 +101,149 @@ uses
 
 Function DoPipe:boolean;
 begin
-  DoPipe:=use_pipe and (not writeasmfile) and (current_module^.output_format=of_o);
+  DoPipe:=use_pipe and (not WriteAsmFile) and (current_module^.output_format=of_o);
+end;
+
+
+{*****************************************************************************
+                       TAsmList Calling and Name
+*****************************************************************************}
+
+const
+  last_of  : tof=of_none;
+var
+  LastASBin : string;
+Function TAsmList.FindAssembler(curr_of:tof):string;
+var
+  asfound : boolean;
+begin
+  if last_of<>curr_of then
+   begin
+     last_of:=curr_of;
+     LastASBin:=FindExe(asbin[curr_of],asfound);
+     if (not asfound) and (not externasm) then
+      begin
+        Message1(exec_w_assembler_not_found,LastASBin);
+        externasm:=true;
+      end;
+     if asfound then
+      Message1(exec_u_using_assembler,LastASBin);
+   end;
+  FindAssembler:=LastASBin;
+end;
+
+
+Function TAsmList.CallAssembler(const command,para:string):Boolean;
+begin
+  if not externasm then
+   begin
+     swapvectors;
+     exec(command,para);
+     swapvectors;
+     if (dosexitcode<>0) then
+      begin
+        Message(exec_w_error_while_assembling);
+        callassembler:=false;
+        exit;
+      end
+     else
+      if (doserror<>0) then
+       begin
+         Message(exec_w_cant_call_assembler);
+         externasm:=true;
+       end;
+   end;
+  if externasm then
+   AsmRes.AddAsmCommand(command,para,asmfile);
+  callassembler:=true;
+end;
+
+
+procedure TAsmList.RemoveAsm;
+var
+  g : file;
+  i : word;
+begin
+  if writeasmfile then
+   exit;
+  if ExternAsm then
+   AsmRes.AddDeleteCommand(asmfile)
+  else
+   begin
+     assign(g,asmfile);
+     {$I-}
+      erase(g);
+     {$I+}
+     i:=ioresult;
+   end;
+end;
+
+
+Function TAsmList.DoAssemble:boolean;
+begin
+  if DoPipe then
+   exit;
+  if not externasm then
+   Message1(exec_i_assembling,asmfile);
+  case current_module^.output_format of
+{$ifdef i386}
+   of_att : begin
+              externasm:=true; {Force Extern Asm}
+              if CallAssembler(FindAssembler(of_att),' -D -o '+objfile+' '+AsmFile) then
+               RemoveAsm;
+            end;
+     of_o : begin
+              if CallAssembler(FindAssembler(of_o),'-D -o '+objfile+' '+AsmFile) then
+               RemoveAsm;
+            end;
+ of_win32 : begin
+              if CallAssembler(FindAssembler(of_win32),'-D -o '+objfile+' '+AsmFile) then
+               RemoveAsm;
+            end;
+  of_nasm : begin
+            {$ifdef linux}
+              if CallAssembler(FindAssembler(of_nasm),' -f elf -o '+objfile+' '+AsmFile) then
+               RemoveAsm;
+            {$else}
+              if CallAssembler(FindAssembler(of_nasm),' -f coff -o '+objfile+' '+AsmFile) then
+               RemoveAsm;
+            {$endif}
+            end;
+   of_obj : begin
+              if CallAssembler(FindAssembler(of_nasm),' -f obj -o '+objfile+' '+AsmFile) then
+               RemoveAsm;
+            end;
+  of_masm : begin
+            { !! Nothing yet !! }
+            end;
+{$endif}
+{$ifdef m68k}
+     of_o,
+   of_mot,
+   of_mit,
+   of_gas : begin
+            { !! Nothing yet !! }
+            end;
+{$endif}
+  else
+   internalerror(30000);
+  end;
+  DoAssemble:=true;
+end;
+
+
+procedure TAsmList.NextSmartName;
+begin
+  inc(smartcnt);
+  if smartcnt>999999 then
+   Comment(V_Fatal,'Too many assembler files');
+  AsmFile:=Path+FixFileName('as'+tostr(smartcnt)+target_info.asmext);
+  ObjFile:=Path+FixFileName('as'+tostr(smartcnt)+target_info.objext);
 end;
 
 
 {*****************************************************************************
-                                  TASMLIST
+                       TAsmList AsmFile Writing
 *****************************************************************************}
 
 Procedure TAsmList.AsmFlush;
@@ -153,45 +291,45 @@ begin
 end;
 
 
-
-
 Procedure TAsmList.AsmLn;
 begin
   if OutCnt>=AsmOutSize-2 then
    AsmFlush;
   OutBuf[OutCnt]:=target_info.newline[1];
-  inc(OutCnt); 
+  inc(OutCnt);
   if length(target_info.newline)>1 then
    begin
      OutBuf[OutCnt]:=target_info.newline[2];
-     inc(OutCnt); 
+     inc(OutCnt);
    end;
 end;
 
 
-procedure TAsmList.OpenAsmList(const fn,fn2:string);
+procedure TAsmList.AsmCreate;
 begin
+  if SmartLink then
+   NextSmartName;
 {$ifdef linux}
   if DoPipe then
    begin
-     Message1(exec_i_assembling_pipe,fn);
-     POpen(outfile,'as -o '+fn2,'W');
+     Message1(exec_i_assembling_pipe,asmfile);
+     POpen(outfile,'as -o '+objfile,'W');
    end
   else
 {$endif}
    begin
-     Assign(outfile,fn);
+     Assign(outfile,asmfile);
      {$I-}
       Rewrite(outfile,1);
      {$I+}
      if ioresult<>0 then
-      Message1(exec_d_cant_create_asmfile,fn);
+      Message1(exec_d_cant_create_asmfile,asmfile);
    end;
   outcnt:=0;
 end;
 
 
-procedure TAsmList.CloseAsmList;
+procedure TAsmList.AsmClose;
 var
   f : file;
   l : longint;
@@ -207,7 +345,9 @@ begin
      if Assigned(current_module^.ppufilename) then
       begin
         Assign(f,current_module^.ppufilename^);
-        reset(f,1);
+        {$I-}
+         reset(f,1);
+        {$I+}
         if ioresult=0 then
          begin
            getftime(f,l);
@@ -231,194 +371,106 @@ begin
 end;
 
 
-constructor TAsmList.Init;
+Constructor TAsmList.Init(const fn:string);
+var
+  ext : extstr;
+  i   : word;
 begin
+{Create filenames for easier access}
+  fsplit(fn,path,name,ext);
+  srcfile:=fn;
+  asmfile:=path+name+target_info.asmext;
+  objfile:=path+name+target_info.objext;
   OutCnt:=0;
+{Smartlinking}
+  smartcnt:=0;
+  if smartlink then
+   begin
+     path:=FixPath(path)+FixFileName(name+smartext);
+     {$I-}
+      mkdir(path);
+     {$I+}
+     i:=ioresult;
+   end;
+  path:=FixPath(path);
 end;
 
 
-destructor TAsmList.Done;
+Destructor TAsmList.Done;
 begin
 end;
 
 
 {*****************************************************************************
-                                  TASMFILE
+                     Generate Assembler Files Main Procedure
 *****************************************************************************}
 
-Constructor TAsmFile.Init(const fn:string);
+Procedure GenerateAsm(const fn:string);
 var
-  name:namestr;
-  ext:extstr;
+  a : PAsmList;
 begin
-{Create filenames for easier access}
-  fsplit(fn,path,name,ext);
-  srcfile:=fn;
-  asmfile:=path+name+target_info.asmext;
-  objfile:=path+name+target_info.objext;
-{Init output format}
   case current_module^.output_format of
 {$ifdef i386}
      of_o,
-     of_win32,
-     of_att:
-       asmlist:=new(pi386attasmlist,Init);
-     of_obj,
-     of_masm,
-     of_nasm:
-       asmlist:=new(pi386intasmlist,Init);
+ of_win32,
+   of_att : a:=new(pi386attasmlist,Init(fn));
+   of_obj,
+  of_masm,
+  of_nasm : a:=new(pi386intasmlist,Init(fn));
 {$endif}
 {$ifdef m68k}
      of_o,
-   of_gas : asmlist:=new(pm68kgasasmlist,Init);
-   of_mot : asmlist:=new(pm68kmotasmlist,Init);
-   of_mit : asmlist:=new(pm68kmitasmlist,Init);
+   of_gas : a:=new(pm68kgasasmlist,Init(fn));
+   of_mot : a:=new(pm68kmotasmlist,Init(fn));
+   of_mit : a:=new(pm68kmitasmlist,Init(fn));
 {$endif}
   else
    internalerror(30000);
   end;
+  a^.AsmCreate;
+  a^.WriteAsmList;
+  a^.AsmClose;
+  a^.DoAssemble;
+  dispose(a,Done);
 end;
 
 
-Destructor TAsmFile.Done;
-begin
-end;
-
-
-Procedure TAsmFile.WriteAsmSource;
-begin
-  asmlist^.OpenAsmList(asmfile,objfile);
-  asmlist^.WriteAsmList;
-  asmlist^.CloseAsmList;
-end;
-
-
-const
-  last_of  : tof=of_none;
-var
-  LastASBin : string;
-Function TAsmFile.FindAssembler(curr_of:tof):string;
-var
-  asfound : boolean;
-begin
-  if last_of<>curr_of then
-   begin
-     last_of:=curr_of;
-     LastASBin:=FindExe(asbin[curr_of],asfound);
-     if (not asfound) and (not externasm) then
-      begin
-        Message1(exec_w_assembler_not_found,LastASBin);
-        externasm:=true;
-      end;
-     if asfound then
-      Message1(exec_u_using_assembler,LastASBin);
-   end;
-  FindAssembler:=LastASBin;
-end;
-
-
-Function TAsmFile.CallAssembler(const command,para:string):Boolean;
-begin
-  if not externasm then
-   begin
-     swapvectors;
-     exec(command,para);
-     swapvectors;
-     if (dosexitcode<>0) then
-      begin
-        Message(exec_w_error_while_assembling);
-        callassembler:=false;
-        exit;
-      end
-     else
-      if (doserror<>0) then
-       begin
-         Message(exec_w_cant_call_assembler);
-         externasm:=true;
-       end;
-   end;
-  if externasm then
-   AsmRes.AddAsmCommand(command,para,asmfile);
-  callassembler:=true;
-end;
-
-
-procedure TAsmFile.RemoveAsm;
+Procedure OnlyAsm(const fn:string);
 var
-  g : file;
-  i : word;
+  a : PAsmList;
 begin
-  if writeasmfile then
-   exit;
-  if ExternAsm then
-   AsmRes.AddDeleteCommand (AsmFile)
-  else
-   begin
-     assign(g,asmfile);
-     {$I-}
-      erase(g);
-     {$I+}
-     i:=ioresult;
-   end;
-end;
-
-
-Function TAsmFile.DoAssemble:boolean;
-begin
-  if DoPipe then
-   exit;
-  if not externasm then
-   Message1(exec_i_assembling,asmfile);
   case current_module^.output_format of
 {$ifdef i386}
-   of_att : begin
-              externasm:=true; {Force Extern Asm}
-              if CallAssembler(FindAssembler(of_att),' -D -o '+objfile+' '+asmfile) then
-               RemoveAsm;
-            end;
-     of_o : begin
-              if CallAssembler(FindAssembler(of_o),'-D -o '+objfile+' '+asmfile) then
-               RemoveAsm;
-            end;
- of_win32 : begin
-              if CallAssembler(FindAssembler(of_win32),'-D -o '+objfile+' '+asmfile) then
-               RemoveAsm;
-            end;
-  of_nasm : begin
-            {$ifdef linux}
-              if CallAssembler(FindAssembler(of_nasm),' -f elf -o '+objfile+' '+asmfile) then
-               RemoveAsm;
-            {$else}
-              if CallAssembler(FindAssembler(of_nasm),' -f coff -o '+objfile+' '+asmfile) then
-               RemoveAsm;
-            {$endif}
-            end;
-   of_obj : begin
-              if CallAssembler(FindAssembler(of_nasm),' -f obj -o '+objfile+' '+asmfile) then
-               RemoveAsm;
-            end;
-  of_masm : begin
-            { !! Nothing yet !! }
-            end;
+     of_o,
+ of_win32,
+   of_att : a:=new(pi386attasmlist,Init(fn));
+   of_obj,
+  of_masm,
+  of_nasm : a:=new(pi386intasmlist,Init(fn));
 {$endif}
 {$ifdef m68k}
      of_o,
-   of_mot,
-   of_mit,
-   of_gas : begin
-            { !! Nothing yet !! }
-            end;
+   of_gas : a:=new(pm68kgasasmlist,Init(fn));
+   of_mot : a:=new(pm68kmotasmlist,Init(fn));
+   of_mit : a:=new(pm68kmitasmlist,Init(fn));
 {$endif}
   else
    internalerror(30000);
   end;
-  DoAssemble:=true;
+  a^.DoAssemble;
+  dispose(a,Done);
 end;
 
 end.
 {
   $Log$
-  Revision 1.3  1998-04-10 14:41:43  peter
+  Revision 1.4  1998-04-27 23:10:27  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.3  1998/04/10 14:41:43  peter
     * removed some Hints
     * small speed optimization for AsmLn
 

compiler/cgi386.pas

@@ -22,7 +22,7 @@
 }
 
 {$ifdef tp}
-{$E+,F+,N+,D-,L+,Y+}
+{$E+,F+,N+,D+,L-,Y+}
 {$endif}
 unit cgi386;
 
@@ -647,23 +647,25 @@ implementation
                      ait_real_extended : consts^.insert(new(pai_extended,init(p^.valued)));
                      else
                        internalerror(10120);
-                     end;
-{$ifndef MAKELIB}
-                   consts^.insert(new(pai_label,init(lastlabel)));
-{$else MAKELIB}
-                   consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
-                     +'$real_const'+tostr(p^.labnumber))));
-                   consts^.insert(new(pai_cut,init));
-{$endif MAKELIB}
-                end;
+                   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
+                    consts^.insert(new(pai_label,init(lastlabel)));
+               end;
            end;
          stringdispose(p^.location.reference.symbol);
-{$ifndef MAKELIB}
-         p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
-{$else MAKELIB}
-         p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
-                     +'$real_const'+tostr(p^.labnumber));
-{$endif MAKELIB}
+         if smartlink then
+          begin
+            p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
+                +'$real_const'+tostr(p^.labnumber));
+          end
+         else
+          p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
       end;
 
     procedure secondfixconst(var p : ptree);
@@ -749,22 +751,22 @@ implementation
                    { to overcome this problem we set the length explicitly }
                    { with the ending null char }
                    pai_string(consts^.first)^.len:=length(p^.values^)+2;
-{$ifndef MAKELIB}
-                   consts^.insert(new(pai_label,init(lastlabel)));
-{$else MAKELIB}
-                   consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
-                     +'$string_const'+tostr(p^.labstrnumber))));
-                   consts^.insert(new(pai_cut,init));
-{$endif MAKELIB}
-                end;
+                   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
+                    consts^.insert(new(pai_label,init(lastlabel)));
+               end;
            end;
          stringdispose(p^.location.reference.symbol);
-{$ifndef MAKELIB}
-         p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
-{$else MAKELIB}
-         p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
-                     +'$string_const'+tostr(p^.labstrnumber));
-{$endif MAKELIB}
+         if smartlink then
+           p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
+                     +'$string_const'+tostr(p^.labstrnumber))
+         else
+           p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
          p^.location.loc := LOC_MEM;
       end;
 
@@ -5875,7 +5877,13 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.16  1998-04-23 21:52:08  florian
+  Revision 1.17  1998-04-27 23:10:27  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.16  1998/04/23 21:52:08  florian
     * fixes of Jonas applied
 
   Revision 1.15  1998/04/22 21:06:49  florian

compiler/cobjects.pas

@@ -193,11 +193,6 @@ unit cobjects;
            { closes the file and releases the buffer }
            procedure close;
 
-{$ifdef MAKELIB}
-           { used for making tiny files for libs }
-           procedure changename(filename : string);
-{$endif MAKELIB}
-
            { goto the given position }
            procedure seek(l : longint);
 
@@ -986,18 +981,17 @@ end;
               iomode:=0;
            end;
       end;
-{$ifdef MAKELIB}
-    procedure tbufferedfile.changename(filename : string);
 
-      begin
-         close;
-         assign(f,filename);
-      end;
-{$endif MAKELIB}
 end.
 {
   $Log$
-  Revision 1.2  1998-04-07 11:09:04  peter
+  Revision 1.3  1998-04-27 23:10:28  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.2  1998/04/07 11:09:04  peter
     + filemode is set correct in tbufferedfile.reset
 
   Revision 1.1.1.1  1998/03/25 11:18:15  root

compiler/files.pas

@@ -31,50 +31,39 @@ unit files;
     const
 {$ifdef FPC}
        maxunits = 1024;
+       extbufsize = 65535;
 {$else}
        maxunits = 128;
+       extbufsize = 2000;
 {$endif}
 
     type
-       pextfile = ^textfile;
-
        { this isn't a text file, this is t-ext-file }
-       { which means a extended file                }
-       { this files can be handled by a file        }
-       { manager                                    }
+       { which means a extended file this files can }
+       { be handled by a file manager               }
+       pextfile = ^textfile;
        textfile = object(tbufferedfile)
           path,name,ext : pstring;
-          { this is because there is a name conflict }
-          { with the older next from tinputstack     }
-          _next : pextfile;
-          { 65000 input files for a unit should be enough !! }
-          ref_index : word;
-
+          _next      : pextfile; { else conflicts with tinputstack }
+          ref_index  : word;     { 65000 input files for a unit should be enough !! }
           { p must be the complete path (with ending \ (or / for unix ...) }
           constructor init(const p,n,e : string);
           destructor done;virtual;
        end;
 
        pinputfile = ^tinputfile;
-
        tinputfile = object(textfile)
           filenotatend : boolean;
-          line_no : longint;
-          { second counter for unimportant tokens }
-          line_count : longint;
-          { next input file in the stack of input files }
-          next : pinputfile;
-          { to handle the browser refs }
-          ref_count : longint;
-
+          line_no      : longint;
+          line_count   : longint;    { second counter for unimportant tokens }
+          next         : pinputfile; { next input file in the stack of input files }
+          ref_count    : longint;    { to handle the browser refs }
           constructor init(const p,n,e : string);
-          { writes the file name and line number to t }
-          procedure write_file_line(var t : text);
-          function get_file_line : string;
+          procedure write_file_line(var t : text); { writes the file name and line number to t }
+          function  get_file_line : string;
        end;
 
        pfilemanager = ^tfilemanager;
-
        tfilemanager = object
           files : pextfile;
           last_ref_index : word;
@@ -84,109 +73,64 @@ unit files;
           procedure register_file(f : pextfile);
        end;
 
-       pimported_procedure = ^timported_procedure;
-
-       timported_procedure = object(tlinkedlist_item)
-          ordnr : word;
-          name,func : pstring;
-          { should be plabel, but this gaves problems with circular units }
-          lab : pointer;
-          constructor init(const n,s : string;o : word);
-          destructor done;virtual;
-       end;
-
-       pimportlist = ^timportlist;
-
-       timportlist = object(tlinkedlist_item)
-          dllname : pstring;
-          imported_procedures : plinkedlist;
-          constructor init(const n : string);
-          destructor done;virtual;
-       end;
-
     type
-       pmodule = ^tmodule;
-       pused_unit = ^tused_unit;
-
-       tused_unit = object(tlinkedlist_item)
-          u : pmodule;
-          in_uses, in_interface, is_stab_written : boolean;
-          unitid : word;
-          constructor init(_u : pmodule;f : byte);
-          destructor done;virtual;
-       end;
-
        tunitmap = array[0..maxunits-1] of pointer;
        punitmap = ^tunitmap;
 
+       pmodule = ^tmodule;
        tmodule = object(tlinkedlist_item)
-
-          { the PPU file }
-          ppufile : pextfile;
-          { used for global switches - in_main section after uses clause }
-          { then TRUE else false.                                        }
-          in_main : boolean;
-          { mapping of all used units }
-          map : punitmap;
-          { local unit counter }
-          unitcount : word;
-          { this is a pointer because symtable uses this unit }
-          { it should be psymtable                            }
-          symtable : pointer;
-
-          { PPU version, handle different versions }
-          ppuversion : longint;
-
-          { check sum written to the file }
-          crc : longint;
-
-          { flags }
-          flags : byte;
-
-          {Set if the module imports from DLL's.}
-          uses_imports:boolean;
-
-          imports : plinkedlist;
-
-          { how to write this file }
-          output_format : tof;
-
-          { for interpenetrated units }
-          in_implementation,
-          compiled,
-          do_assemble,
-          do_compile,              { true, if it's needed to compile the sources }
-          sources_avail : boolean; { true, if all sources are reachable }
-
-          { only used, if the module is compiled by this compiler call }
-          sourcefiles : tfilemanager;
+          ppufile       : pextfile; { the PPU file }
+          ppuversion,               { PPU version, handle different versions }
+          crc,                      { check sum written to the file }
+          flags         : longint;  { flags }
+
+          compiled,                 { unit is already compiled }
+          do_assemble,              { only assemble the object, don't recompile }
+          do_compile,               { need to compile the sources }
+          sources_avail,            { if all sources are reachable }
+          in_implementation,        { processing the implementation part? }
+          in_main       : boolean;  { global, after uses else false }
+
+          map           : punitmap; { mapping of all used units }
+          unitcount     : word;     { local unit counter }
+          symtable      : pointer;  { pointer to the psymtable of this unit }
+          output_format : tof;      { how to write this file }
+
+          uses_imports  : boolean;  { Set if the module imports from DLL's.}
+          imports       : plinkedlist;
+
+          sourcefiles   : tfilemanager;
           linklibfiles,
-          linkofiles  : tstringcontainer;
-          used_units  : tlinkedlist;
+          linkofiles    : tstringcontainer;
+          used_units    : tlinkedlist;
           current_inputfile : pinputfile;
 
-          unitname,               { name of the (unit) module }
-          objfilename,            { fullname of the objectfile }
-          asmfilename,            { fullname of the assemblerfile }
-          ppufilename,            { fullname of the ppufile }
-          mainsource   : pstring; { name of the main sourcefile }
+          unitname,                 { name of the (unit) module in uppercase }
+          objfilename,              { fullname of the objectfile }
+          asmfilename,              { fullname of the assemblerfile }
+          ppufilename,              { fullname of the ppufile }
+          arfilename,               { fullname of the archivefile }
+          mainsource    : pstring;  { name of the main sourcefile }
 
           constructor init(const s:string;is_unit:boolean);
-          { this is to be called only when compiling again }
-          destructor special_done;virtual;
+          destructor special_done;virtual; { this is to be called only when compiling again }
 
-          function load_ppu(const unit_path,n,ext : string):boolean;
+          procedure setfilename(const path,name:string);
+          function  load_ppu(const unit_path,n,ext:string):boolean;
           procedure search_unit(const n : string);
        end;
 
-    const
-       main_module : pmodule = nil;
-       current_module : pmodule = nil;
-
-    var
-       loaded_units : tlinkedlist;
+       pused_unit = ^tused_unit;
+       tused_unit = object(tlinkedlist_item)
+          u               : pmodule;
+          in_uses,
+          in_interface,
+          is_stab_written : boolean;
+          unitid          : word;
+          constructor init(_u : pmodule;f : byte);
+          destructor done;virtual;
+       end;
 
-    type
        tunitheader = array[0..19] of char;
 
     const
@@ -207,7 +151,6 @@ unit files;
                                    {  |                              }
                                    {  start of machine language      }
 
-    const
        ibloadunit      = 1;
        iborddef        = 2;
        ibpointerdef    = 3;
@@ -253,6 +196,14 @@ unit files;
        uf_big_endian     = $20;
        uf_smartlink      = $40;
 
+    const
+       main_module    : pmodule = nil;
+       current_module : pmodule = nil;
+
+    var
+       loaded_units   : tlinkedlist;
+
+
   implementation
 
   uses
@@ -266,11 +217,7 @@ unit files;
     constructor textfile.init(const p,n,e : string);
 
       begin
-{$ifdef FPC}
-         inherited init(p+n+e,65536);
-{$else}
-         inherited init(p+n+e,10000);
-{$endif}
+         inherited init(p+n+e,extbufsize);
          path:=stringdup(p);
          name:=stringdup(n);
          ext:=stringdup(e);
@@ -353,50 +300,26 @@ unit files;
       end;
 
 {****************************************************************************
-                           Imports stuff
+                                  TMODULE
  ****************************************************************************}
 
-
-    constructor timported_procedure.init(const n,s : string;o : word);
-
-      begin
-         inherited init;
-         func:=stringdup(n);
-         name:=stringdup(s);
-         ordnr:=o;
-         lab:=nil;
-      end;
-
-    destructor timported_procedure.done;
-
-      begin
-         stringdispose(name);
-         inherited done;
-      end;
-
-    constructor timportlist.init(const n : string);
-
-      begin
-         inherited init;
-         dllname:=stringdup(n);
-         imported_procedures:=new(plinkedlist,init);
-      end;
-
-    destructor timportlist.done;
-
+    procedure tmodule.setfilename(const path,name:string);
+      var
+        s : string;
       begin
-         dispose(imported_procedures,done);
-         stringdispose(dllname);
+         stringdispose(objfilename);
+         stringdispose(asmfilename);
+         stringdispose(ppufilename);
+         stringdispose(arfilename);
+         s:=FixFileName(FixPath(path)+name);
+         objfilename:=stringdup(s+target_info.objext);
+         asmfilename:=stringdup(s+target_info.asmext);
+         ppufilename:=stringdup(s+target_info.unitext);
+         arfilename:=stringdup(s+target_info.arext);
       end;
 
-{****************************************************************************
-                                  TMODULE
- ****************************************************************************}
-
-{$I-}
-
     function tmodule.load_ppu(const unit_path,n,ext : string):boolean;
-    var
+      var
          header  : tunitheader;
          count   : longint;
          temp,hs : string;
@@ -457,10 +380,22 @@ unit files;
       crc:=plongint(@header[10])^;
       Message1(unit_d_ppu_crc,tostr(crc));
 
+    { read name if its there }
+      ppufile^.read_data(b,1,count);
+{$IFDEF UNITNAME}
+      if b=ibunitname then
+       begin
+         ppufile^.read_data(hs[0],1,count);
+         ppufile^.read_data(hs[1],ord(hs[0]),count);
+         stringdispose(unitname);
+         unitname:=stringdup(hs);
+         ppufile^.read_data(b,1,count);
+       end;
+{$ENDIF UNITNAME}
+
     { search source files there is at least one source file }
       do_compile:=false;
       sources_avail:=true;
-      ppufile^.read_data(b,1,count);
       while b<>ibend do
        begin
          ppufile^.read_data(hs[0],1,count);
@@ -533,7 +468,7 @@ unit files;
          Path,
          filename  : string;
          found     : boolean;
-         start,pos : longint;
+         start,i   : longint;
 
          Function UnitExists(const ext:string):boolean;
          begin
@@ -541,19 +476,6 @@ unit files;
            UnitExists:=FileExists(Singlepathstring+FileName+ext);
          end;
 
-         Procedure SetFileNames;
-         begin
-           stringdispose(mainsource);
-           stringdispose(objfilename);
-           stringdispose(asmfilename);
-           stringdispose(ppufilename);
-           mainsource:=stringdup(SinglePathString+FileName+ext);
-           objfilename:=stringdup(SinglePathString+FileName+target_info.objext);
-           asmfilename:=stringdup(SinglePathString+FileName+target_info.asmext);
-           ppufilename:=stringdup(SinglePathString+FileName+target_info.unitext);
-         end;
-
-
        begin
          start:=1;
          filename:=FixFileName(n);
@@ -561,21 +483,20 @@ unit files;
          Found:=false;
          repeat
          {Create current path to check}
-           pos:=system.pos(';',path);
-           if pos=0 then
-            pos:=length(path)+1;
-           singlepathstring:=FixPath(copy(path,start,pos-start));
-           delete(path,start,pos-start+1);
+           i:=pos(';',path);
+           if i=0 then
+            i:=length(path)+1;
+           singlepathstring:=FixPath(copy(path,start,i-start));
+           delete(path,start,i-start+1);
          { Check for PPL file }
            if not (cs_link_static in aktswitches) then
             begin
               Found:=UnitExists(target_info.libext);
               if Found then
                Begin
-                 SetFileNames;
+                 SetFileName(SinglePathString,FileName);
                  Found:=Load_PPU(singlepathstring,filename,target_info.libext);
                End;
-
              end;
          { Check for PPU file }
            if not (cs_link_dynamic in aktswitches) and not Found then
@@ -583,10 +504,9 @@ unit files;
               Found:=UnitExists(target_info.unitext);
               if Found then
                Begin
-                 SetFileNames;
+                 SetFileName(SinglePathString,FileName);
                  Found:=Load_PPU(singlepathstring,filename,target_info.unitext);
                End;
-
             end;
          { Check for Sources }
            if not Found then
@@ -604,34 +524,35 @@ unit files;
                  if Found then
                   Ext:=target_info.pasext;
                end;
+              stringdispose(mainsource);
               if Found then
                begin
                  sources_avail:=true;
                {Load Filenames when found}
-                 SetFilenames;
+	         mainsource:=StringDup(SinglePathString+FileName+Ext);
+                 SetFileName(SinglePathString,FileName);
                end
               else
-               begin
-                 sources_avail:=false;
-                 stringdispose(mainsource);
-               end;
+               sources_avail:=false;
             end;
          until Found or (path='');
       end;
 
+
     constructor tmodule.init(const s:string;is_unit:boolean);
       var
-        p:dirstr;
-        n:namestr;
-        e:extstr;
+        p : dirstr;
+        n : namestr;
+        e : extstr;
       begin
          FSplit(s,p,n,e);
-         n:=Upper(n);
-         unitname:=stringdup(n);
+         unitname:=stringdup(Upper(n));
+         mainsource:=stringdup(s);
          objfilename:=nil;
          asmfilename:=nil;
+         arfilename:=nil;
          ppufilename:=nil;
-         mainsource:=stringdup(s);
+         setfilename(p,n);
          used_units.init;
          sourcefiles.init;
          linkofiles.init;
@@ -659,7 +580,8 @@ unit files;
     destructor tmodule.special_done;
 
       begin
-         if assigned(map) then dispose(map);
+         if assigned(map) then
+           dispose(map);
          { cannot remove that because it is linked
          in the global chain of used_objects
          used_units.done; }
@@ -689,16 +611,20 @@ unit files;
       end;
 
     destructor tused_unit.done;
-
       begin
          inherited done;
       end;
-{$I+}
 
 end.
 {
   $Log$
-  Revision 1.2  1998-04-21 10:16:47  peter
+  Revision 1.3  1998-04-27 23:10:28  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.2  1998/04/21 10:16:47  peter
     * patches from strasbourg
     * objects is not used anymore in the fpc compiled version
 

compiler/import.pas

@@ -22,15 +22,36 @@
 unit import;
 interface
 
+uses
+  cobjects;
+
 type
-  pimportlib=^timportlib;
-  timportlib=object
-    constructor Init;
-    destructor Done;
-    procedure preparelib(const s:string);virtual;
-    procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
-    procedure generatelib;virtual;
-  end;
+   pimported_procedure = ^timported_procedure;
+   timported_procedure = object(tlinkedlist_item)
+      ordnr : word;
+      name,func : pstring;
+      lab : pointer; { should be plabel, but this gaves problems with circular units }
+      constructor init(const n,s : string;o : word);
+      destructor done;virtual;
+   end;
+
+   pimportlist = ^timportlist;
+   timportlist = object(tlinkedlist_item)
+      dllname : pstring;
+      imported_procedures : plinkedlist;
+      constructor init(const n : string);
+      destructor done;virtual;
+   end;
+
+   pimportlib=^timportlib;
+   timportlib=object
+      constructor Init;
+      destructor Done;
+      procedure preparelib(const s:string);virtual;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
+      procedure generatelib;virtual;
+   end;
+
 var
   importlib : pimportlib;
 
@@ -42,6 +63,48 @@ uses
   systems,verbose,
   os2_targ,win_targ;
 
+{****************************************************************************
+                           TImported_procedure
+****************************************************************************}
+
+constructor timported_procedure.init(const n,s : string;o : word);
+begin
+  inherited init;
+  func:=stringdup(n);
+  name:=stringdup(s);
+  ordnr:=o;
+  lab:=nil;
+end;
+
+destructor timported_procedure.done;
+begin
+  stringdispose(name);
+  inherited done;
+end;
+
+
+{****************************************************************************
+                              TImportlist
+****************************************************************************}
+
+constructor timportlist.init(const n : string);
+begin
+  inherited init;
+  dllname:=stringdup(n);
+  imported_procedures:=new(plinkedlist,init);
+end;
+
+destructor timportlist.done;
+begin
+  dispose(imported_procedures,done);
+  stringdispose(dllname);
+end;
+
+
+{****************************************************************************
+                              TImportLib
+****************************************************************************}
+
 constructor timportlib.Init;
 begin
 end;
@@ -83,8 +146,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:12  root
-  Initial revision
+  Revision 1.2  1998-04-27 23:10:28  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.1.1.1  1998/03/25 11:18:12  root
+  * Restored version
 
   Revision 1.3  1998/03/10 01:17:19  peter
     * all files have the same header

compiler/parser.pas

@@ -132,8 +132,8 @@ unit parser;
          oldpreprocstack : ppreprocstack;
          oldorgpattern,oldprocprefix : string;
          old_block_type : tblock_type;
-         oldinputbuffer : pchar;
-         oldinputpointer : longint;
+         oldinputbuffer,
+         oldinputpointer : pchar;
          olds_point,oldparse_only : boolean;
          oldc : char;
          oldcomment_level : word;
@@ -209,8 +209,6 @@ unit parser;
            set_macro('FPC_PATCH',patch_nr);
         end;
 
-      var
-         a : PAsmFile;
       label
          done;
 
@@ -403,15 +401,12 @@ unit parser;
              if current_module^.uses_imports then
               importlib^.generatelib;
 
-             a:=new(PAsmFile,Init(filename));
-             a^.WriteAsmSource;
-             a^.DoAssemble;
-             dispose(a,Done);
+             GenerateAsm(filename);
 
              { Check linking  => we are at first level in compile }
              if (compile_level=1) then
               begin
-	        if Linker.ExeName='' then
+                if Linker.ExeName='' then
                  Linker.SetFileName(FileName);
                 if (comp_unit) then
                  begin
@@ -530,7 +525,13 @@ done:
 end.
 {
   $Log$
-  Revision 1.6  1998-04-21 10:16:48  peter
+  Revision 1.7  1998-04-27 23:10:28  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.6  1998/04/21 10:16:48  peter
     * patches from strasbourg
     * objects is not used anymore in the fpc compiled version
 

compiler/pdecl.pas

@@ -963,9 +963,8 @@ unit pdecl;
          testcurobject:=0;
          curobjectname:='';
 
-{$ifdef MAKELIB}
-        datasegment^.concat(new(pai_cut,init));
-{$endif MAKELIB}
+         if smartlink then
+           datasegment^.concat(new(pai_cut,init));
 {$ifdef GDB}
          { generate the VMT }
          if cs_debuginfo in aktswitches then
@@ -1736,7 +1735,13 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.9  1998-04-10 21:36:56  florian
+  Revision 1.10  1998-04-27 23:10:28  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.9  1998/04/10 21:36:56  florian
     + some stuff to support method pointers (procedure of object) added
       (declaration, parameter handling)
 

compiler/pmodules.pas

@@ -196,7 +196,6 @@ unit pmodules;
          st : punitsymtable;
          old_current_module,hp,nextmodule : pmodule;
          pu : pused_unit;
-         a  : pasmfile;
          hs : pstring;
       begin
          old_current_module:=current_module;
@@ -255,11 +254,7 @@ unit pmodules;
                 begin
                 { only reassemble ? }
                   if (hp^.do_assemble) then
-                   begin
-                     a:=new(PAsmFile,Init(hp^.asmfilename^));
-                     a^.DoAssemble;
-                     dispose(a,Done);
-                   end;
+                   OnlyAsm(hp^.asmfilename^);
                  { we should know there the PPU file else it's an error and
                    we can't load the unit }
                   if hp^.ppufile^.name^<>'' then
@@ -416,71 +411,66 @@ unit pmodules;
     procedure proc_unit;
 
       var
-         unitname : stringid;
 {$ifdef GDB}
          { several defs to simulate more or less C++ objects for GDB }
-         vmtdef : precdef;
-         pvmtdef : ppointerdef;
+         vmtdef      : precdef;
+         pvmtdef     : ppointerdef;
          vmtarraydef : parraydef;
          vmtsymtable : psymtable;
 {$endif GDB}
-         names:Tstringcontainer;
-         p : psymtable;
+         names  : Tstringcontainer;
+         p      : psymtable;
          unitst : punitsymtable;
-         pu : pused_unit;
-         { the output ppufile is written to this path }
-         s1,s2,s3:^string; {Saves stack space, but only eats heap
-                            space when there is a lot of heap free.}
-
+         pu     : pused_unit;
+         s1,s2  : ^string; {Saves stack space}
       begin
          consume(_UNIT);
 
-         stringdispose(current_module^.objfilename);
-         stringdispose(current_module^.ppufilename);
-       { create filenames and check unit name }
-         new(s1);
-         new(s2);
-         new(s3);
-         s1^:=FixFileName(current_module^.current_inputfile^.path^+current_module^.current_inputfile^.name^);
-         current_module^.objfilename:=stringdup(s1^+target_info.objext);
-         current_module^.ppufilename:=stringdup(s1^+target_info.unitext);
-
-         s1^:=upper(pattern);
-         s2^:=upper(target_info.system_unit);
-         s3^:=upper(current_module^.current_inputfile^.name^);
-         if (cs_compilesystem in aktswitches)  then
+         if token=ID then
           begin
-            if (cs_check_unit_name in aktswitches) and
-               ((length(pattern)>8) or (s1^<>s2^) or (s1^<>s3^)) then
-                Message1(unit_e_illegal_unit_name,s1^);
-          end
-         else
-          if (s1^=s2^) then
-           Message(unit_w_switch_us_missed);
-         dispose(s3);
-         dispose(s2);
-         dispose(s1);
-
-       { add object }
-         Linker.AddObjectFile(current_module^.objfilename^);
-
-         unitname:=pattern;
-
+          { create filenames and unit name }
+             current_module^.SetFileName(current_module^.current_inputfile^.path^,current_module^.current_inputfile^.name^);
+             current_module^.unitname:=stringdup(upper(pattern));
+
+          { check for system unit }
+             new(s1);
+             new(s2);
+             s1^:=upper(target_info.system_unit);
+             s2^:=upper(current_module^.current_inputfile^.name^);
+             if (cs_compilesystem in aktswitches)  then
+              begin
+                if (cs_check_unit_name in aktswitches) and
+                   ((length(current_module^.unitname^)>8) or
+                    (current_module^.unitname^<>s1^) or
+                    (current_module^.unitname^<>s2^)) then
+                  Message1(unit_e_illegal_unit_name,s1^);
+              end
+             else
+              if (current_module^.unitname^=s1^) then
+               Message(unit_w_switch_us_missed);
+             dispose(s2);
+             dispose(s1);
+	     
+	  { Add Object File }     
+             Linker.AddObjectFile(current_module^.objfilename^);
+             current_module^.linkofiles.insert(current_module^.objfilename^);
+          end;
+	  
          consume(ID);
          consume(SEMICOLON);
          consume(_INTERFACE);
 
          { this should be placed after uses !!}
 {$ifndef UseNiceNames}
-         procprefix:='_'+unitname+'$$';
+         procprefix:='_'+current_module^.unitname^+'$$';
 {$else UseNiceNames}
-         procprefix:='_'+tostr(length(unitname))+lowercase(unitname)+'_';
+         procprefix:='_'+tostr(length(current_module^.unitname^))+lowercase(current_module^.unitname^)+'_';
 {$endif UseNiceNames}
 
          parse_only:=true;
 
          { generate now the global symboltable }
-         p:=new(punitsymtable,init(globalsymtable,unitname));
+         p:=new(punitsymtable,init(globalsymtable,current_module^.unitname^));
          refsymtable:=p;
          unitst:=punitsymtable(p);
 
@@ -491,7 +481,6 @@ unit pmodules;
          { a unit compiled at command line must be inside the loaded_unit list }
          if (compile_level=1) then
            begin
-              current_module^.unitname:=stringdup(unitname);
               loaded_units.insert(current_module);
               if cs_unit_to_lib in initswitches then
                 begin
@@ -646,14 +635,14 @@ unit pmodules;
          only_calculate_crc:=false;
          }
          { generates static symbol table }
-         p:=new(punitsymtable,init(staticsymtable,unitname));
+         p:=new(punitsymtable,init(staticsymtable,current_module^.unitname^));
          refsymtable:=p;
 
          {Generate a procsym.}
-         aktprocsym:=new(Pprocsym,init(unitname+'_init'));
+         aktprocsym:=new(Pprocsym,init(current_module^.unitname^+'_init'));
          aktprocsym^.definition:=new(Pprocdef,init);
          aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
-         aktprocsym^.definition^.setmangledname(unitname+'_init');
+         aktprocsym^.definition^.setmangledname(current_module^.unitname^+'_init');
 
          {The generated procsym has a local symtable. Discard it and turn
           it into the static one.}
@@ -661,7 +650,8 @@ unit pmodules;
          aktprocsym^.definition^.localst:=p;
 
          names.init;
-         names.insert(unitname+'_init');
+         names.insert(current_module^.unitname^+'_init');
+         names.insert('INIT$$'+current_module^.unitname^);
 
          { testing !!!!!!!!! }
          { we set the interface part as a unitsymtable  }
@@ -673,13 +663,6 @@ unit pmodules;
 
          parse_uses(unitst);
 
-         { duplicated here to be sure }
-{$ifndef UseNiceNames}
-         procprefix:='_'+unitname+'$$';
-{$else UseNiceNames}
-         procprefix:='_'+tostr(length(unitname))+lowercase(unitname)+'_';
-{$endif UseNiceNames}
-
          { but reinsert the global symtable as lasts }
          unitst^.next:=symtablestack;
          symtablestack:=unitst;
@@ -696,28 +679,22 @@ unit pmodules;
               allow_special:=true;
               Switch_to_temp_heap;
            end;
-{$endif Splitheap}
-
-{$ifdef Splitheap}
          { it will report all crossings }
          allow_special:=false;
 {$endif Splitheap}
+
          { set some informations }
          procinfo.retdef:=voiddef;
          procinfo._class:=nil;
          procinfo.call_offset:=8;
-
          { for temporary values }
          procinfo.framepointer:=frame_pointer;
-
          { clear flags }
          procinfo.flags:=0;
 
          {Reset the codegenerator.}
          codegen_newprocedure;
 
-         names.insert('INIT$$'+unitname);
-
          compile_proc_body(names,true,false);
 
          codegen_doneprocedure;
@@ -779,12 +756,14 @@ unit pmodules;
          { fatal error (avoids pointer problems)}
          { when referencing the non-existant    }
          { system unit.                         }
-         if (cs_compilesystem in aktswitches) then
+
+         { System Unit should be compiled using proc_unit !! (PFV) }
+{         if (cs_compilesystem in aktswitches) then
          Begin
            if token<>_UNIT then
             Message1(scan_f_syn_expected,'UNIT');
            consume(_UNIT);
-         end;
+         end;}
 
          parse_only:=false;
          programname:='';
@@ -799,7 +778,7 @@ unit pmodules;
          else
            { is there an program head ? }
            if token=_PROGRAM then
-           begin
+            begin
               consume(_PROGRAM);
               programname:=pattern;
               consume(ID);
@@ -810,7 +789,7 @@ unit pmodules;
                    consume(RKLAMMER);
                 end;
               consume(SEMICOLON);
-           end;
+            end;
 
          { insert after the unit symbol tables the static symbol table }
          { of the program                                              }
@@ -826,9 +805,6 @@ unit pmodules;
          dispose(aktprocsym^.definition^.localst,done);
          aktprocsym^.definition^.localst:=st;
 
-         names.init;
-         names.insert('program_init');
-
          refsymtable:=st;
 
          {Insert the symbols of the system unit into the stack of symbol
@@ -838,7 +814,8 @@ unit pmodules;
          refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
 
          {Load the units used by the program we compile.}
-         if token=_USES then loadunits;
+         if token=_USES then
+	   loadunits;
 
          {Insert the name of the main program into the symbol table.}
          if programname<>'' then
@@ -865,27 +842,31 @@ unit pmodules;
          procprefix:='';
          in_except_block:=false;
 
-
          {The program intialization needs an alias, so it can be called
           from the bootstrap code.}
+         names.init;
+         names.insert('program_init');
+         names.insert('PASCALMAIN');
          case target_info.target of
-            target_GO32V1,
-            target_GO32V2,
-            target_OS2,
-            target_WIN32:
-              names.insert('_main');
-            target_LINUX:
-              names.insert('main');
+          target_GO32V1,
+          target_GO32V2,
+             target_OS2,
+           target_WIN32 : names.insert('_main');
+           target_LINUX : names.insert('main');
          end;
-         names.insert('PASCALMAIN');
 
          compile_proc_body(names,true,false);
 
          codegen_doneprocedure;
 
-         Linker.AddObjectFile(current_module^.unitname^);
-         current_module^.linkofiles.insert(current_module^.unitname^);
+         Linker.AddObjectFile(current_module^.objfilename^);
+         current_module^.linkofiles.insert(current_module^.objfilename^);
 
+         if smartlink then
+           begin
+             bsssegment^.concat(new(pai_cut,init));
+             datasegment^.concat(new(pai_cut,init));
+           end;
         { On the Macintosh Classic M68k Architecture   }
         { The Heap variable is simply a POINTER to the }
         { real HEAP. The HEAP must be set up by the RTL }
@@ -936,7 +917,13 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.5  1998-04-14 23:27:03  florian
+  Revision 1.6  1998-04-27 23:10:28  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.5  1998/04/14 23:27:03  florian
     + exclude/include with constant second parameter added
 
   Revision 1.4  1998/04/10 14:41:43  peter