--- Merging r20158 into '.':

U    compiler/systems/t_emx.pas
U    compiler/systems/t_os2.pas
--- Merging r21425 into '.':
U    rtl/emx/sysdir.inc

# revisions: 20158,21425
r20158 | hajny | 2012-01-23 22:29:00 +0100 (Mon, 23 Jan 2012) | 1 line
Changed paths:
   M /trunk/compiler/systems/t_emx.pas
   M /trunk/compiler/systems/t_os2.pas

  + add previously missing support for link map generation for OS2 and EMX targets
r21425 | hajny | 2012-05-29 01:43:44 +0200 (Tue, 29 May 2012) | 1 line
Changed paths:
   M /trunk/rtl/emx/sysdir.inc

  * compilation fix (EMX was not updated when moving to PChar based *Dir calls)

git-svn-id: branches/fixes_2_6@22649 -

compiler/systems/t_emx.pas

@@ -37,7 +37,7 @@ interface
 implementation
 
   uses
-     sysutils,
+     SysUtils,
      cutils,cfileutl,cclasses,
      globtype,comphook,systems,symconst,symsym,symdef,
      globals,verbose,fmodule,script,ogbase,
@@ -158,6 +158,8 @@ var ar:ar_hdr;        {PackTime is platform independent}
     time:TSystemTime;
     numtime:longint;
     tmp:string[19];
+
+
 begin
     ar_member_size:=size;
     fillchar(ar.ar_name,sizeof(ar.ar_name),' ');
@@ -355,9 +357,9 @@ end;
                 ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
                 AddImport(ImportLibrary.Name,ImportSymbol.OrdNr,
                   ImportSymbol.Name,ImportSymbol.MangledName);
-              end;
-            close(out_file);
          end;
+         close(out_file);
+      end;
       end;
 
 
@@ -379,8 +381,8 @@ begin
   with Info do
    begin
      ExeCmd[1]:='ld $OPT -o $OUT @$RES';
-     ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE $OUT -aim -s$DOSHEAPKB';
-     if source_info.script = script_dos then
+     ExeCmd[2]:='emxbind -b $STRIP $MAP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE $OUT -aim -s$DOSHEAPKB';
+     if Source_Info.Script = script_dos then
       ExeCmd[3]:='del $OUT';
    end;
 end;
@@ -455,19 +457,26 @@ var
   success : boolean;
   i       : longint;
   AppTypeStr,
-  StripStr: string[40];
+  StripStr: string[3];
+  MapStr: shortstring;
+  BaseFilename: TPathStr;
   RsrcStr : string;
-  OutName: string;
+  OutName: TPathStr;
 begin
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
-  OutName := ChangeFileExt(current_module.exefilename^,'.out');
+  BaseFilename := ChangeFileExt(current_module.exefilename^,'');
+  OutName := BaseFilename + '.out';
   if (cs_link_strip in current_settings.globalswitches) then
-   StripStr := '-s'
+   StripStr := '-s '
   else
    StripStr := '';
+  if (cs_link_map in current_settings.globalswitches) then
+   MapStr := '-m' + BaseFileName + ' '
+  else
+   MapStr := '';
   if (usewindowapi) or (AppType = app_gui) then
    AppTypeStr := '-p'
   else if AppType = app_fs then
@@ -497,11 +506,20 @@ begin
         {When an EMX program runs in DOS, the heap and stack share the
          same memory pool. The heap grows upwards, the stack grows downwards.}
         Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+1023) shr 10));
-        Replace(cmdstr,'$STRIP',StripStr);
+        Replace(cmdstr,'$STRIP ', StripStr);
+        Replace(cmdstr,'$MAP ', MapStr);
         Replace(cmdstr,'$APPTYPE',AppTypeStr);
+(*
+   Arrgh!!! The ancient EMX LD.EXE simply dies without saying anything
+   if the full pathname to link.res is quoted!!!!! @#$@@^%@#$^@#$^@^#$
+   This means that name of the output directory cannot contain spaces,
+   but at least it works otherwise...
+
         Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
-        Replace(cmdstr,'$OPT',Info.ExtraOptions);
-        Replace(cmdstr,'$RSRC',RsrcStr);
+*)
+        Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+        Replace(cmdstr,'$OPT ',Info.ExtraOptions);
+        Replace(cmdstr,'$RSRC ',RsrcStr);
         Replace(cmdstr,'$OUT',maybequoted(OutName));
         Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
         if i<>3 then

compiler/systems/t_os2.pas

@@ -396,7 +396,7 @@ begin
   with Info do
    begin
      ExeCmd[1]:='ld $OPT -o $OUT @$RES';
-     ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h1 -o $EXE $OUT -ai -s8';
+     ExeCmd[2]:='emxbind -b $STRIP $MAP $APPTYPE $RSRC -k$STACKKB -h1 -o $EXE $OUT -ai -s8';
      if Source_Info.Script = script_dos then
       ExeCmd[3]:='del $OUT';
    end;
@@ -472,7 +472,9 @@ var
   success : boolean;
   i       : longint;
   AppTypeStr,
-  StripStr: string[40];
+  StripStr: string[3];
+  MapStr: shortstring;
+  BaseFilename: TPathStr;
   RsrcStr : string;
   OutName: TPathStr;
 begin
@@ -480,11 +482,16 @@ begin
    Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
-  OutName := ChangeFileExt(current_module.exefilename^,'.out');
+  BaseFilename := ChangeFileExt(current_module.exefilename^,'');
+  OutName := BaseFilename + '.out';
   if (cs_link_strip in current_settings.globalswitches) then
-   StripStr := '-s'
+   StripStr := '-s '
   else
    StripStr := '';
+  if (cs_link_map in current_settings.globalswitches) then
+   MapStr := '-m' + BaseFileName + ' '
+  else
+   MapStr := '';
   if (usewindowapi) or (AppType = app_gui) then
    AppTypeStr := '-p'
   else if AppType = app_fs then
@@ -514,7 +521,8 @@ begin
         {When an EMX program runs in DOS, the heap and stack share the
          same memory pool. The heap grows upwards, the stack grows downwards.}
         Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+1023) shr 10));
-        Replace(cmdstr,'$STRIP',StripStr);
+        Replace(cmdstr,'$STRIP ', StripStr);
+        Replace(cmdstr,'$MAP ', MapStr);
         Replace(cmdstr,'$APPTYPE',AppTypeStr);
 (*
    Arrgh!!! The ancient EMX LD.EXE simply dies without saying anything
@@ -525,8 +533,8 @@ begin
         Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
 *)
         Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-        Replace(cmdstr,'$OPT',Info.ExtraOptions);
-        Replace(cmdstr,'$RSRC',RsrcStr);
+        Replace(cmdstr,'$OPT ',Info.ExtraOptions);
+        Replace(cmdstr,'$RSRC ',RsrcStr);
         Replace(cmdstr,'$OUT',maybequoted(OutName));
         Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
         if i<>3 then

rtl/emx/sysdir.inc

@@ -19,161 +19,148 @@
                            Directory Handling
 *****************************************************************************}
 
-
-procedure dosdir(func:byte;const s:string);
-
-var buffer:array[0..255] of char;
+procedure DosDir (Func: byte; S: PChar);
 
 begin
-    move(s[1],buffer,length(s));
-    buffer[length(s)]:=#0;
-    DoDirSeparators(Pchar(@buffer));
-    asm
-        leal buffer,%edx
-        movb func,%ah
-        call syscall
-        jnc  .LDOS_DIRS1
-        movw %ax,inoutres
+  DoDirSeparators (S);
+  asm
+    movl S, %edx
+    movb Func, %ah
+    call SysCall
+    jnc .LDOS_DIRS1
+    movw %ax, InOutRes
     .LDOS_DIRS1:
-    end ['eax', 'edx'];
+  end ['eax', 'edx'];
 end;
 
-
-procedure MkDir (const S: string);[IOCHECK];
-
-var buffer:array[0..255] of char;
-    Rc : word;
-
+procedure MkDir (S: pchar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_MKDIR'];
+var 
+  RC: cardinal;
 begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
- if os_mode = osOs2 then
-    begin
-      move(s[1],buffer,length(s));
-      buffer[length(s)]:=#0;
-      DoDirSeparators(Pchar(@buffer));
-      Rc := DosCreateDir(buffer,nil);
-      if Rc <> 0 then
-       begin
-         InOutRes := Rc;
-         Errno2Inoutres;
-       end;
-    end
+  if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
+   Exit;
+
+  if os_mode = osOs2 then
+   begin
+    DoDirSeparators (S);
+    RC := DosCreateDir (S, nil);
+    if RC <> 0 then
+     begin
+      InOutRes := RC;
+      Errno2InOutRes;
+     end;
+   end
   else
    begin
      { Under EMX 0.9d DOS this routine call may sometimes fail   }
      { The syscall documentation indicates clearly that this     }
      { routine was NOT tested.                                   }
-        DosDir ($39, S);
-end;
+    DosDir ($39, S);
+   end;
 end;
 
 
-procedure rmdir(const s : string);[IOCHECK];
-var buffer:array[0..255] of char;
-    Rc : word;
+procedure RmDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_RMDIR'];
+var
+  RC: cardinal;
 begin
-  if (s = '.' ) then
-    InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  if os_mode = osOs2 then
-    begin
-      move(s[1],buffer,length(s));
-      buffer[length(s)]:=#0;
-      DoDirSeparators(Pchar(@buffer));
-      Rc := DosDeleteDir(buffer);
-      if Rc <> 0 then
-       begin
-         InOutRes := Rc;
-         Errno2Inoutres;
-       end;
-    end
-  else
+  if Assigned (S) and (Len <> 0) and (InOutRes = 0) then
    begin
+    if (Len = 1) and (S^ = '.') then
+     InOutRes := 16
+    else
+     if os_mode = osOs2 then
+      begin
+       DoDirSeparators (S);
+       RC := DosDeleteDir (S);
+       if RC <> 0 then
+        begin
+         InOutRes := RC;
+         Errno2InOutRes;
+        end;
+      end
+     else
      { Under EMX 0.9d DOS this routine call may sometimes fail   }
      { The syscall documentation indicates clearly that this     }
      { routine was NOT tested.                                   }
-        DosDir ($3A, S);
+      DosDir ($3A, S);
+   end
 end;
-end;
-
-{$ASMMODE INTEL}
 
-procedure ChDir (const S: string);[IOCheck];
 
-var RC: cardinal;
-    Buffer: array [0..255] of char;
+{$ASMMODE INTEL}
 
+procedure ChDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_CHDIR'];
+var
+  RC: cardinal;
 begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
+  if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
+    exit;
 (* According to EMX documentation, EMX has only one current directory
    for all processes, so we'll use native calls under OS/2. *)
-            if os_Mode = osOS2 then
-                begin
-                    if (Length (S) >= 2) and (S [2] = ':') then
-                        begin
-                            RC := DosSetDefaultDisk ((Ord (S [1]) and
-                                                             not ($20)) - $40);
-                            if RC <> 0 then
-                                InOutRes := RC
-                            else
-                                if Length (S) > 2 then
-                                    begin
-                                        Move (S [1], Buffer, Length (S));
-                                        Buffer [Length (S)] := #0;
-                                        DoDirSeparators (PChar (@Buffer));
-                                        RC := DosSetCurrentDir (@Buffer);
-                                        if RC <> 0 then
-                                         begin
-                                            InOutRes := RC;
-                                            Errno2InOutRes;
-                                         end;
-                                    end;
-                        end
-                    else
-                        begin
-                            Move (S [1], Buffer, Length (S));
-                            Buffer [Length (S)] := #0;
-                            DoDirSeparators (PChar (@Buffer));
-                            RC := DosSetCurrentDir (@Buffer);
-                            if RC <> 0 then
-                             begin
-                                  InOutRes:= RC;
-                                  Errno2InOutRes;
-                             end;
-                        end;
-                end
-            else
-                if (Length (S) >= 2) and (S [2] = ':') then
-                    begin
-                        asm
-                            mov esi, S
-                            mov al, [esi + 1]
-                            and al, not (20h)
-                            sub al, 41h
-                            mov edx, eax
-                            mov ah, 0Eh
-                            call syscall
-                            mov ah, 19h
-                            call syscall
-                            cmp al, dl
-                            jz @LCHDIR
-                            mov InOutRes, 15
+  if os_Mode = osOS2 then
+   begin
+    if (Len >= 2) and (S [1] = ':') then
+     begin
+      RC := DosSetDefaultDisk ((Ord (S^) and not ($20)) - $40);
+      if RC <> 0 then
+       begin
+        InOutRes := RC;
+        Errno2InOutRes;
+       end
+      else
+       if Len > 2 then
+        begin
+         DoDirSeparators (S);
+         RC := DosSetCurrentDir (S);
+         if RC <> 0 then
+          begin
+           InOutRes := RC;
+           Errno2InOutRes;
+          end;
+        end;
+     end
+    else
+     begin
+      DoDirSeparators (S);
+      RC := DosSetCurrentDir (S);
+      if RC <> 0 then
+       begin
+        InOutRes:= RC;
+        Errno2InOutRes;
+       end;
+     end;
+   end
+  else
+   if (Len >= 2) and (S [1] = ':') then
+    begin
+     asm
+      mov esi, S
+      mov al, [esi + 1]
+      and al, not (20h)
+      sub al, 41h
+      mov edx, eax
+      mov ah, 0Eh
+      call syscall
+      mov ah, 19h
+      call syscall
+      cmp al, dl
+      jz @LCHDIR
+      mov InOutRes, 15
 @LCHDIR:
-                        end ['eax','edx','esi'];
-                        if (Length (S) > 2) and (InOutRes <> 0) then
-                            { Under EMX 0.9d DOS this routine may sometime }
-                            { fail or crash the system.                    }
-                            DosDir ($3B, S);
-                    end
-                else
-                    { Under EMX 0.9d DOS this routine may sometime }
-                    { fail or crash the system.                    }
-                    DosDir ($3B, S);
+     end ['eax','edx','esi'];
+     if (Len > 2) and (InOutRes <> 0) then
+      { Under EMX 0.9d DOS this routine may sometime }
+      { fail or crash the system.                    }
+      DosDir ($3B, S);
+    end
+   else
+    { Under EMX 0.9d DOS this routine may sometime }
+    { fail or crash the system.                    }
+    DosDir ($3B, S);
 end;
 
+
 {$ASMMODE ATT}
 
 procedure GetDir (DriveNr: byte; var Dir: ShortString);
@@ -232,6 +219,3 @@ begin
         end;
     if not (FileNameCaseSensitive) then dir:=upcase(dir);
 end;
-
-
-