* merged

compiler/globals.pas

@@ -60,13 +60,13 @@ unit globals;
 
        delphimodeswitches : tmodeswitches=
          [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
-          m_pointer_2_procedure,m_autoderef,m_tp_procvar];
+          m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal];
        fpcmodeswitches    : tmodeswitches=
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
-          m_cvar_support];
+          m_cvar_support,m_initfinal];
        objfpcmodeswitches : tmodeswitches=
-         [m_fpc,m_all,m_objpas,m_class,m_result,m_string_pchar,m_nested_comment,
-          m_repeat_forward,m_cvar_support];
+         [m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
+          m_repeat_forward,m_cvar_support,m_initfinal];
        tpmodeswitches     : tmodeswitches=
          [m_tp,m_all,m_tp_procvar];
        gpcmodeswitches    : tmodeswitches=
@@ -184,7 +184,8 @@ unit globals;
     function min(a,b : longint) : longint;
     function max(a,b : longint) : longint;
     function align(i,a:longint):longint;
-    procedure Replace(var s:string;const s1,s2:string);
+    procedure Replace(var s:string;s1:string;const s2:string);
+    procedure ReplaceCase(var s:string;const s1,s2:string);
     function upper(const s : string) : string;
     function lower(const s : string) : string;
     function trimspace(const s:string):string;
@@ -204,6 +205,8 @@ unit globals;
     function gettimestr:string;
     function filetimestring( t : longint) : string;
 
+    procedure DefaultReplacements(var s:string);
+
     function path_absolute(const s : string) : boolean;
     Function FileExists ( Const F : String) : Boolean;
     Function RemoveFile(const f:string):boolean;
@@ -363,21 +366,44 @@ unit globals;
       end;
 
 
-    procedure Replace(var s:string;const s1,s2:string);
-    {
-      replace all s1 with s2 in string s
-    }
+    procedure Replace(var s:string;s1:string;const s2:string);
       var
+         last,
          i  : longint;
       begin
+        s1:=upper(s1);
+        last:=0;
+        repeat
+          i:=pos(s1,upper(s));
+          if i=last then
+           i:=0;
+          if (i>0) then
+           begin
+             Delete(s,i,length(s1));
+             Insert(s2,s,i);
+             last:=i;
+           end;
+        until (i=0);
+      end;
+
+
+    procedure ReplaceCase(var s:string;const s1,s2:string);
+      var
+         last,
+         i  : longint;
+      begin
+        last:=0;
         repeat
           i:=pos(s1,s);
-          if i>0 then
+          if i=last then
+           i:=0;
+          if (i>0) then
            begin
              Delete(s,i,length(s1));
              Insert(s2,s,i);
+             last:=i;
            end;
-        until i=0;
+        until (i=0);
       end;
 
 
@@ -680,6 +706,19 @@ unit globals;
        filetimestring:=L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
      end;
 
+{****************************************************************************
+                          Default Macro Handling
+****************************************************************************}
+
+     procedure DefaultReplacements(var s:string);
+       begin
+         { Replace some macro's }
+         Replace(s,'$FPCVER',full_version_string);
+         Replace(s,'$FPCDATE',date_string);
+         Replace(s,'$FPCTARGET',target_cpu_string);
+         Replace(s,'$TARGET',target_path);
+       end;
+
 
 {****************************************************************************
                                File Handling
@@ -832,14 +871,18 @@ unit globals;
       var
         i : longint;
       begin
+        { Fix separator }
         for i:=1 to length(s) do
          if s[i] in ['/','\'] then
           s[i]:=DirSep;
+        { Fix ending / }
         if (length(s)>0) and (s[length(s)]<>DirSep) and
            (s[length(s)]<>':') then
          s:=s+DirSep;
+        { Remove ./ }
         if (not allowdot) and (s='.'+DirSep) then
          s:='';
+        { return }
         FixPath:=s;
       end;
 
@@ -893,7 +936,9 @@ unit globals;
      begin
        if s='' then
         exit;
-     {Fix List}
+     { Support default macro's }
+       DefaultReplacements(s);
+     { Fix List }
        if (length(list)>0) and (list[length(list)]<>';') then
         list:=list+';';
        GetDir(0,CurrentDir);
@@ -1162,7 +1207,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  1999-07-06 21:48:16  florian
+  Revision 1.11  1999-07-10 10:26:18  peter
+    * merged
+
+  Revision 1.8.2.2  1999/07/10 10:03:04  peter
+    * fixed initialization/finalization in fpc mode
+    * allow $TARGET also in search paths
+
+  Revision 1.8.2.1  1999/07/07 07:53:21  michael
+  + Merged patches from florian
+
+  Revision 1.10  1999/07/06 21:48:16  florian
     * a lot bug fixes:
        - po_external isn't any longer necessary for procedure compatibility
        - m_tp_procvar is in -Sd now available

compiler/globtype.pas

@@ -98,11 +98,18 @@ interface
          { generic }
          m_fpc,m_delphi,m_tp,m_gpc,
          { more specific }
-         m_class,m_objpas,m_result,m_string_pchar,m_cvar_support,
-         m_nested_comment,m_tp_procvar,m_repeat_forward,
+         m_class,               { delphi class model }
+         m_objpas,              { load objpas unit }
+         m_result,              { result in functions }
+         m_string_pchar,        { pchar 2 string conversion }
+         m_cvar_support,        { cvar variable directive }
+         m_nested_comment,      { nested comments }
+         m_tp_procvar,          { tp style procvars (no @ needed) }
+         m_repeat_forward,      { repeating forward declarations is needed }
          m_pointer_2_procedure, { allows the assignement of pointers to
                                   procedure variables                     }
-         m_autoderef            { does auto dereferencing of struct. vars }
+         m_autoderef,           { does auto dereferencing of struct. vars }
+         m_initfinal            { initialization/finalization for units }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -142,10 +149,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  1999-07-03 00:29:49  peter
+  Revision 1.12  1999-07-10 10:26:19  peter
+    * merged
+
+  Revision 1.11  1999/07/03 00:29:49  peter
     * new link writing to the ppu, one .ppu is needed for all link types,
       static (.o) is now always created also when smartlinking is used
 
+  Revision 1.10.2.1  1999/07/10 10:03:06  peter
+    * fixed initialization/finalization in fpc mode
+    * allow $TARGET also in search paths
+
   Revision 1.10  1999/05/17 14:30:39  pierre
    + cs_checkpointer
 

compiler/systems.pas

@@ -234,6 +234,7 @@ unit systems;
        target_link : tlinkinfo;
        target_ar   : tarinfo;
        target_res  : tresinfo;
+       target_path : string[12]; { for rtl/<X>/,fcl/<X>/, etc. }
        source_os   : tosinfo;
 
     function set_target_os(t:tos):boolean;
@@ -1217,6 +1218,26 @@ begin
 {$endif}
 end;
 
+function lower(const s : string) : string;
+var
+  i : longint;
+begin
+  for i:=1 to length(s) do
+   if s[i] in ['A'..'Z'] then
+    lower[i]:=char(byte(s[i])+32)
+   else
+    lower[i]:=s[i];
+  {$ifndef TP}
+    {$ifopt H+}
+      setlength(lower,length(s));
+    {$else}
+      lower[0]:=s[0];
+    {$endif}
+  {$else}
+    lower[0]:=s[0];
+  {$endif}
+end;
+
 
 function set_target_os(t:tos):boolean;
 var
@@ -1308,6 +1329,7 @@ begin
       set_target_link(target_info.link);
       set_target_ar(target_info.ar);
       set_target_res(target_info.res);
+      target_path:=lower(target_info.short_name);
       target_cpu:=target_info.cpu;
       set_target_info:=true;
       exit;
@@ -1329,13 +1351,7 @@ begin
   for i:=1 to targetcnt do
    if target_infos[i].short_name=s then
     begin
-      target_info:=target_infos[i];
-      set_target_os(target_info.os);
-      set_target_asm(target_info.assem);
-      set_target_link(target_info.link);
-      set_target_ar(target_info.ar);
-      set_target_res(target_info.res);
-      target_cpu:=target_info.cpu;
+      set_target_info(target_infos[i].target);
       set_string_target:=true;
       exit;
     end;
@@ -1500,7 +1516,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.82  1999-06-08 11:50:28  peter
+  Revision 1.83  1999-07-10 10:26:20  peter
+    * merged
+
+  Revision 1.82.2.2  1999/07/10 10:03:16  peter
+    * fixed initialization/finalization in fpc mode
+    * allow $TARGET also in search paths
+
+  Revision 1.82.2.1  1999/07/02 12:52:58  pierre
+   * pecoff still buggy, as_I386_asw again default
+
+  Revision 1.82  1999/06/08 11:50:28  peter
     * 2mb again for go32v2/v1
 
   Revision 1.81  1999/06/02 20:46:39  peter

compiler/tokens.pas

@@ -265,7 +265,7 @@ const
       (str:'IN'            ;special:false;keyword:m_all),
       (str:'IS'            ;special:false;keyword:m_class),
       (str:'OF'            ;special:false;keyword:m_all),
-      (str:'ON'            ;special:false;keyword:m_objpas),
+      (str:'ON'            ;special:false;keyword:m_class),
       (str:'OR'            ;special:false;keyword:m_all),
       (str:'TO'            ;special:false;keyword:m_all),
       (str:'AND'           ;special:false;keyword:m_all),
@@ -281,7 +281,7 @@ const
       (str:'SET'           ;special:false;keyword:m_all),
       (str:'SHL'           ;special:false;keyword:m_all),
       (str:'SHR'           ;special:false;keyword:m_all),
-      (str:'TRY'           ;special:false;keyword:m_objpas),
+      (str:'TRY'           ;special:false;keyword:m_class),
       (str:'VAR'           ;special:false;keyword:m_all),
       (str:'XOR'           ;special:false;keyword:m_all),
       (str:'CASE'          ;special:false;keyword:m_all),
@@ -311,12 +311,12 @@ const
       (str:'FALSE'         ;special:false;keyword:m_all),
       (str:'INDEX'         ;special:false;keyword:m_none),
       (str:'LABEL'         ;special:false;keyword:m_all),
-      (str:'RAISE'         ;special:false;keyword:m_objpas),
+      (str:'RAISE'         ;special:false;keyword:m_class),
       (str:'UNTIL'         ;special:false;keyword:m_all),
       (str:'WHILE'         ;special:false;keyword:m_all),
       (str:'WRITE'         ;special:false;keyword:m_none),
       (str:'DOWNTO'        ;special:false;keyword:m_all),
-      (str:'EXCEPT'        ;special:false;keyword:m_objpas),
+      (str:'EXCEPT'        ;special:false;keyword:m_class),
       (str:'EXPORT'        ;special:false;keyword:m_none),
       (str:'INLINE'        ;special:false;keyword:m_none),
       (str:'OBJECT'        ;special:false;keyword:m_all),
@@ -335,7 +335,7 @@ const
       (str:'DISPOSE'       ;special:false;keyword:m_all),
       (str:'DYNAMIC'       ;special:false;keyword:m_none),
       (str:'EXPORTS'       ;special:false;keyword:m_all),
-      (str:'FINALLY'       ;special:false;keyword:m_objpas),
+      (str:'FINALLY'       ;special:false;keyword:m_class),
       (str:'FORWARD'       ;special:false;keyword:m_none),
       (str:'IOCHECK'       ;special:false;keyword:m_none),
       (str:'LIBRARY'       ;special:false;keyword:m_all),
@@ -366,16 +366,16 @@ const
       (str:'PROCEDURE'     ;special:false;keyword:m_all),
       (str:'PROTECTED'     ;special:false;keyword:m_none),
       (str:'PUBLISHED'     ;special:false;keyword:m_none),
-      (str:'THREADVAR'     ;special:false;keyword:m_objpas),
+      (str:'THREADVAR'     ;special:false;keyword:m_class),
       (str:'DESTRUCTOR'    ;special:false;keyword:m_all),
       (str:'INTERNPROC'    ;special:false;keyword:m_none),
       (str:'OPENSTRING'    ;special:false;keyword:m_none),
       (str:'CONSTRUCTOR'   ;special:false;keyword:m_all),
       (str:'INTERNCONST'   ;special:false;keyword:m_none),
       (str:'SHORTSTRING'   ;special:false;keyword:m_none),
-      (str:'FINALIZATION'  ;special:false;keyword:m_class),
+      (str:'FINALIZATION'  ;special:false;keyword:m_initfinal),
       (str:'IMPLEMENTATION';special:false;keyword:m_all),
-      (str:'INITIALIZATION';special:false;keyword:m_class)
+      (str:'INITIALIZATION';special:false;keyword:m_initfinal)
   );
 
 implementation
@@ -383,7 +383,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  1999-05-24 08:55:30  florian
+  Revision 1.8  1999-07-10 10:26:21  peter
+    * merged
+
+  Revision 1.7.2.1  1999/07/10 10:03:18  peter
+    * fixed initialization/finalization in fpc mode
+    * allow $TARGET also in search paths
+
+  Revision 1.7  1999/05/24 08:55:30  florian
     * non working safecall directiv implemented, I don't know if we
       need it
 

compiler/verbose.pas

@@ -67,7 +67,6 @@ procedure SetRedirectFile(const fn:string);
 function  SetVerbosity(const s:string):boolean;
 
 procedure LoadMsgFile(const fn:string);
-procedure UpdateReplacement(var s:string);
 
 procedure Stop;
 procedure ShowStatus;
@@ -247,14 +246,6 @@ begin
 end;
 
 
-procedure UpdateReplacement(var s:string);
-begin
-  Replace(s,'$FPCVER',full_version_string);
-  Replace(s,'$FPCDATE',date_string);
-  Replace(s,'$FPCTARGET',target_cpu_string);
-end;
-
-
 var
   lastfileidx,
   lastmoduleidx : longint;
@@ -341,7 +332,7 @@ begin
 { Create status info }
   UpdateStatus;
 { Fix replacements }
-  UpdateReplacement(s);
+  DefaultReplacements(s);
 { show comment }
   if do_comment(l,s) or dostop then
    stop;
@@ -408,7 +399,7 @@ begin
 { fix status }
   UpdateStatus;
 { Fix replacements }
-  UpdateReplacement(s);
+  DefaultReplacements(s);
 { show comment }
   if do_comment(v,s) or dostop then
    stop;
@@ -515,9 +506,16 @@ end.
 
 {
   $Log$
-  Revision 1.40  1999-06-18 11:03:09  peter
+  Revision 1.41  1999-07-10 10:26:22  peter
     * merged
 
+  Revision 1.40  1999/06/18 11:03:09  peter
+    * merged
+
+  Revision 1.39.2.2  1999/07/10 10:03:19  peter
+    * fixed initialization/finalization in fpc mode
+    * allow $TARGET also in search paths
+
   Revision 1.39.2.1  1999/06/18 10:55:32  peter
     * version fixes
     * EXTRAUNITS to set extra units that are build and needs to be cleaned