Tomas Hajny пре 22 година
родитељ
комит
8e7124f9f8

+ 8 - 1
compiler/compiler.pas

@@ -164,7 +164,11 @@ uses
   ,i_nwm
 {$endif nwm}
 {$ifdef os2}
+ {$ifdef emx}
+  ,i_emx
+ {$else emx}
   ,i_os2
+ {$endif emx}
 {$endif os2}
 {$ifdef palmos}
   ,i_palmos
@@ -386,7 +390,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.36  2003-02-02 19:25:54  carl
+  Revision 1.37  2003-03-23 23:20:38  hajny
+    + emx target added
+
+  Revision 1.36  2003/02/02 19:25:54  carl
     * Several bugfixes for m68k target (register alloc., opcode emission)
     + VIS target
     + Generic add more complete (still not verified)

+ 5 - 2
compiler/comprsrc.pas

@@ -134,7 +134,7 @@ var
   hr : presourcefile;
 begin
   { OS/2 (EMX) must be processed elsewhere (in the linking/binding stage). }
-  if target_info.system<>system_i386_os2 then
+  if not (target_info.system in [system_i386_os2,system_i386_emx]) then
    While not current_module.ResourceFiles.Empty do
     begin
       case target_info.system of
@@ -154,7 +154,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.17  2003-01-30 21:45:40  peter
+  Revision 1.18  2003-03-23 23:20:38  hajny
+    + emx target added
+
+  Revision 1.17  2003/01/30 21:45:40  peter
     * path fix (merged)
 
   Revision 1.16  2003/01/12 15:42:23  peter

+ 5 - 2
compiler/gendef.pas

@@ -113,7 +113,7 @@ begin
    exit;
 {$ifdef i386}
   case target_info.system of
-    system_i386_Os2 :
+    system_i386_Os2, system_i386_emx:
       begin
         write(t,'NAME '+inputfile);
         if usewindowapi then
@@ -160,7 +160,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.11  2002-07-26 21:15:38  florian
+  Revision 1.12  2003-03-23 23:20:38  hajny
+    + emx target added
+
+  Revision 1.11  2002/07/26 21:15:38  florian
     * rewrote the system handling
 
   Revision 1.10  2002/05/18 13:34:08  peter

+ 6 - 2
compiler/globals.pas

@@ -496,7 +496,8 @@ implementation
       begin
         { these operating systems have dos type drives }
         if source_info.system in [system_m68k_atari,system_i386_go32v2,
-                                  system_i386_win32,system_i386_os2] then
+                                  system_i386_win32,system_i386_os2,
+                                  system_i386_emx,system_i386_wdosx] then
         Begin
           if (Length(f)=3) and (F[2]=':') and (F[3] in ['/','\']) then
             begin
@@ -1526,7 +1527,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.83  2003-01-30 21:45:53  peter
+  Revision 1.84  2003-03-23 23:21:42  hajny
+    + emx target added
+
+  Revision 1.83  2003/01/30 21:45:53  peter
     * amiga path fix (merged)
 
   Revision 1.82  2003/01/12 15:42:23  peter

+ 6 - 2
compiler/msg/errord.msg

@@ -1815,10 +1815,14 @@ option_help_pages=11025_[
 3*3Op2_Optimierungen f�r Pentium/PentiumMMX (R)
 3*3Op3_Optimierungen f�r PPro/PII/c6x86/K6 (R)
 3*1T<x>_Ziel-Betriebssystem
+3*2TEMX_OS/2 via EMX (EMX/RSX extender inclusive)
 3*2TGO32V2_Version 2 von DJ Delorie's DOS extender
 3*2TLINUX_Linux
-3*2TOS2_OS/2 2.x
-3*2TWin32_Windows 32 Bit
+3*2TNETWARE_Novell Netware Module (experimental)
+3*2TOS2_OS/2 / eComStation
+3*2TSUNOS_SunOS/Solaris
+3*2TWDOSX_WDOSX DOS extender
+3*2TWIN32_Windows 32 Bit
 6*1A<x>_Ausgabe Format:
 6*2Aas_Unix o-Datei mit Hilfe von GNU AS
 6*2Agas_GNU Motorola Assembler

+ 7 - 6
compiler/msg/errore.msg

@@ -2109,14 +2109,15 @@ option_help_pages=11025_[
 3*3Op2_set target processor to Pentium/PentiumMMX (tm)
 3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)
 3*1T<x>_Target operating system:
-3*2TGO32V2_version 2 of DJ Delorie DOS extender
-3*2TWDOSX DOS 32 Bit Extender
+3*2TEMX_OS/2 via EMX (including EMX/RSX extender)
+3*2TGO32V2_Version 2 of DJ Delorie DOS extender
 3*2TLINUX_Linux
-3*2Tnetware_Novell Netware Module (experimental)
-3*2TOS2_OS/2 2.x
+3*2TNETWARE_Novell Netware Module (experimental)
+3*2TOS2_OS/2 / eComStation
 3*2TSUNOS_SunOS/Solaris
-3*2TWin32_Windows 32 Bit
-3*1W<x>_Win32 target options
+3*2TWDOSX_WDOSX DOS extender
+3*2TWIN32_Windows 32 Bit
+3*1W<x>_Win32-like target options
 3*2WB<x>_Set Image base to Hexadecimal <x> value
 3*2WC_Specify console type application
 3*2WD_Use DEFFILE to export functions of DLL or EXE

+ 2 - 2
compiler/msg/errores.msg

@@ -1870,8 +1870,8 @@ option_help_pages=11025_[
 3*1T<x>_Sistema operativo de destino
 3*2TGO32V2_versi¢n 2 del extensor del DOS de DJ Delorie
 3*2TLINUX_Linux
-3*2TOS2_OS/2 2.x
-3*2TWin32_Windows 32 Bit
+3*2TOS2_OS/2
+3*2TWIN32_Windows 32 Bit
 6*1A<x>_formato de salida
 6*2Aas_Unix o-file usando GNU AS
 6*2Agas_Ensamblador GNU Motorola

+ 7 - 3
compiler/msg/errorf.msg

@@ -1853,11 +1853,15 @@ option_help_pages=11025_[
 3*3Op1_d‚finit 386/486 comme processeur cible
 3*3Op2_d‚finit Pentium/PentiumMMX (tm) comme processeur cycle
 3*3Op3_d‚finit  PPro/PII/c6x86/K6 (tm) comme processeur cycle
-3*1T<x>_systŠme d'explioitation cible :
+3*1T<x>_systŠme d'expliotation cible:
+3*2TEMX_OS/2 via EMX (et les extensions EMX/RSX)
 3*2TGO32V2_version 2 de l'extension DOS de DJ Delorie
 3*2TLINUX_Linux
-3*2TOS2_OS/2 2.x
-3*2TWin32_Windows 32 Bits
+3*2TNETWARE_Novell Netware Module (experimental)
+3*2TOS2_OS/2 / eComStation
+3*2TSUNOS_SunOS/Solaris
+3*2TWDOSX_WDOSX DOS extension
+3*2TWIN32_Windows 32 Bits
 6*1A<x>_output format
 6*2Aas_Unix o-file using GNU AS
 6*2Agas_GNU Motorola assembler

+ 2 - 2
compiler/msg/errorn.msg

@@ -1900,8 +1900,8 @@ option_help_pages=11025_[
 6*1T<x>_Doel besturingssysteem:
 3*2TGO32V2_version 2 of DJ Delorie DOS extender
 3*2TLINUX_Linux
-3*2TOS2_OS/2 2.x
-3*2TWin32_Windows 32 Bit
+3*2TOS2_OS/2 / eComStation
+3*2TWIN32_Windows 32 Bit
 3*1W<x>_Win32 Doel opties
 3*2WB<x>_Stel Image base in op (hexadecimale) waarde <x>
 3*2WC_Maak een console applicatie

+ 2 - 2
compiler/msg/errorr.msg

@@ -1980,8 +1980,8 @@ option_help_pages=11025_[
 3*1T<x>_⨯ ®¯¥à æ¨®­­ ï á¨á⥬ë, ¤«ï ª®â®p®© ¯p®¨á室¨â ª®¬¯¨«ïæ¨ï:
 3*2TGO32V2_version 2 (DJ Delorie à áè¨à¨â¥«ì DOS)
 3*2TLINUX_Linux
-3*2TOS2_OS/2 2.x
-3*2TWin32_Windows 32 Bit
+3*2TOS2_OS/2 / eComStation
+3*2TWIN32_Windows 32 Bit
 3*1W<x>_Win32 ®¯æ¨¨
 3*1WB<x>_ “áâ ­®¢ª  Image ¡ §ë ¢ è¥áâ­ ¤æ¥â¨à¨ç­®¥ <x> §­ ç¥­¨¥
 3*1WC_ Ž¯à¥¤¥«¨âì, çâ® íâ® ¡ã¤¥â ª®­á®«ì­®¥ ¯à¨«®¦¥­¨¥

+ 2 - 2
compiler/msg/errorrw.msg

@@ -1980,8 +1980,8 @@ option_help_pages=11025_[
 3*1T<x>_тип операционная системы, для котоpой пpоисходит компиляция:
 3*2TGO32V2_version 2 (DJ Delorie расширитель DOS)
 3*2TLINUX_Linux
-3*2TOS2_OS/2 2.x
-3*2TWin32_Windows 32 Bit
+3*2TOS2_OS/2 / eComStation
+3*2TWIN32_Windows 32 Bit
 3*1W<x>_Win32 опции
 3*1WB<x>_ Установка Image базы в шестнадцетиричное <x> значение
 3*1WC_ Определить, что это будет консольное приложение

+ 1 - 1
compiler/msgidx.inc

@@ -608,7 +608,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 34382;
+  MsgTxtSize = 34446;
 
   MsgIdxMax : array[1..20] of longint=(
     17,62,195,50,57,44,98,19,35,43,

+ 15 - 14
compiler/msgtxt.inc

@@ -796,42 +796,43 @@ const msgtxt : array[0..000143,1..240] of char=(
   '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
   '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
   '3*1T<x>_Target ','operating system:'#010+
-  '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+
-  '3*2TWDOSX DOS 32 Bit Extender'#010+
+  '3*2TEMX_OS/2 via EMX (including EMX/RSX extender)'#010+
+  '3*2TGO32V2_Version 2 of DJ Delorie DOS extender'#010+
   '3*2TLINUX_Linux'#010+
-  '3*2Tnetware_Novell Netware Module (experimental)'#010+
-  '3*2TOS2_OS/2 2.x'#010+
+  '3*2TNETWARE_Novell Netware Module (experimental)'#010+
+  '3*2TOS2_OS/2 / eComStation'#010+
   '3*2TSUNOS_SunOS/Solaris'#010+
-  '3*2TWin32_Windows 32 Bit'#010+
-  '3*1W<x>_Win32',' target options'#010+
+  '3*2TWDOS','X_WDOSX DOS extender'#010+
+  '3*2TWIN32_Windows 32 Bit'#010+
+  '3*1W<x>_Win32-like target options'#010+
   '3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
   '3*2WC_Specify console type application'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
-  '3*2WF_Specify full-screen type application (OS/2 only)'#010+
-  '3*2WG_Specify graphic type ap','plication'#010+
+  '3*2WF_Specify full-s','creen type application (OS/2 only)'#010+
+  '3*2WG_Specify graphic type application'#010+
   '3*2WN_Do not generate relocation code (necessary for debugging)'#010+
   '3*2WR_Generate relocation code'#010+
   '6*1A<x>_output format'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
-  '6*2Agas_GNU Motorola assembler'#010+
+  '6*2Agas_GNU Motor','ola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
-  '6*2Amot_Standard Moto','rola assembler'#010+
+  '6*2Amot_Standard Motorola assembler'#010+
   '6*1O_optimizations:'#010+
   '6*2Oa_turn on the optimizer'#010+
   '6*2Og_generate smaller code'#010+
   '6*2OG_generate faster code (default)'#010+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#010+
-  '6*2O0_set target processor to a MC68000'#010+
-  '6*2O2_set target processor to a ','MC68020+ (default)'#010+
+  '6*2O0_se','t target processor to a MC68000'#010+
+  '6*2O2_set target processor to a MC68020+ (default)'#010+
   '6*1R<x>_assembler reading style:'#010+
   '6*2RMOT_read motorola style assembler'#010+
   '6*1T<x>_Target operating system:'#010+
   '6*2TAMIGA_Commodore Amiga'#010+
   '6*2TATARI_Atari ST/STe/TT'#010+
-  '6*2TMACOS_Macintosh m68k'#010+
+  '6','*2TMACOS_Macintosh m68k'#010+
   '6*2TLINUX_Linux-68k'#010+
   '6*2TPALMOS_PalmOS'#010+
-  '**','1*_'#010+
+  '**1*_'#010+
   '**1?_shows this help'#010+
   '**1h_shows this help without waiting'#000
 );

+ 11 - 3
compiler/options.pas

@@ -1033,7 +1033,12 @@ begin
                     'D':
                       ForceDeffileForExport:=not UnsetBool(More, j);
                     'F':
-                      apptype:=app_fs;
+                      begin
+                        if UnsetBool(More, j) then
+                          apptype:=app_cui
+                        else
+                          apptype:=app_fs;
+                      end;
                     'G':
                       begin
                         if UnsetBool(More, j) then
@@ -1048,7 +1053,7 @@ begin
                       end;
                     'R':
                       begin
-                        { support -WR+ / -WR- as synonims to -WR / -WN }
+                        { support -WR+ / -WR- as synonyms to -WR / -WN }
                         RelocSection:=not UnsetBool(More,j);
                         RelocSectionSetExplicitly:=true;
                       end;
@@ -1893,7 +1898,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.92  2003-03-08 08:59:07  daniel
+  Revision 1.93  2003-03-23 23:20:38  hajny
+    + emx target added
+
+  Revision 1.92  2003/03/08 08:59:07  daniel
     + $define newra will enable new register allocator
     + getregisterint will return imaginary registers with $newra
     + -sr switch added, will skip register allocation so you can see

+ 6 - 3
compiler/pdecsub.pas

@@ -844,8 +844,8 @@ begin
     Message(parser_e_methods_dont_be_export);
   if lexlevel<>normal_function_level then
     Message(parser_e_dont_nest_export);
-  { only os/2 needs this }
-  if target_info.system=system_i386_os2 then
+  { only os/2 and emx need this }
+  if target_info.system in [system_i386_os2,system_i386_emx] then
    begin
      aktprocdef.aliasnames.insert(aktprocsym.realname);
      procinfo.exported:=true;
@@ -2123,7 +2123,10 @@ const
 end.
 {
   $Log$
-  Revision 1.108  2003-03-19 17:34:04  peter
+  Revision 1.109  2003-03-23 23:21:42  hajny
+    + emx target added
+
+  Revision 1.108  2003/03/19 17:34:04  peter
     * only allow class [procedure|function]
 
   Revision 1.107  2003/03/17 18:56:02  peter

+ 5 - 2
compiler/pmodules.pas

@@ -362,7 +362,7 @@ implementation
               ;
 {$endif x86_64}
 {$ifdef i386}
-            system_i386_OS2:
+            system_i386_OS2,system_i386_EMX:
               ;
 {$endif i386}
 {$ifdef powerpc}
@@ -1444,7 +1444,10 @@ So, all parameters are passerd into registers in sparc architecture.}
 end.
 {
   $Log$
-  Revision 1.98  2003-03-17 22:20:08  peter
+  Revision 1.99  2003-03-23 23:21:42  hajny
+    + emx target added
+
+  Revision 1.98  2003/03/17 22:20:08  peter
   *** empty log message ***
 
   Revision 1.97  2003/03/17 13:36:39  peter

+ 12 - 6
compiler/scandir.pas

@@ -181,8 +181,8 @@ implementation
       var
          hs : string;
       begin
-        if (target_info.system<>system_i386_win32)
-                                 and (target_info.system<>system_i386_os2) then
+        if not (target_info.system in [system_i386_win32,system_i386_os2,
+                                       system_i386_emx]) then
           Message(scan_w_app_type_not_support);
         if not current_module.in_global then
           Message(scan_w_switch_is_global)
@@ -194,7 +194,8 @@ implementation
                apptype:=app_gui
              else if hs='CONSOLE' then
                apptype:=app_cui
-             else if (hs='FS') and (target_info.system=system_i386_os2) then
+             else if (hs='FS') and (target_info.system in [system_i386_os2,
+                                                         system_i386_emx]) then
                apptype:=app_fs
              else
                Message1(scan_w_unsupported_app_type,hs);
@@ -236,7 +237,8 @@ implementation
 
     procedure dir_description;
       begin
-        if not (target_info.system in [system_i386_os2,system_i386_win32,system_i386_netware,system_i386_wdosx]) then
+        if not (target_info.system in [system_i386_os2,system_i386_emx,
+                 system_i386_win32,system_i386_netware,system_i386_wdosx]) then
           Message(scan_w_description_not_support);
         { change description global var in all cases }
         { it not used but in win32, os2 and netware }
@@ -763,7 +765,8 @@ implementation
         major, minor, revision : longint;
         error : integer;
       begin
-        if not (target_info.system in [system_i386_os2,system_i386_win32,system_i386_netware,system_i386_wdosx]) then
+        if not (target_info.system in [system_i386_os2,system_i386_emx,
+                 system_i386_win32,system_i386_netware,system_i386_wdosx]) then
           begin
             Message(scan_n_version_not_support);
             exit;
@@ -980,7 +983,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  2003-01-03 21:25:01  peter
+  Revision 1.25  2003-03-23 23:20:38  hajny
+    + emx target added
+
+  Revision 1.24  2003/01/03 21:25:01  peter
     * OBJECTCHECKS added, equivalent of -CR
     * WRITEABLECONST added, equivalent of $J
 

+ 6 - 2
compiler/systems.pas

@@ -109,7 +109,8 @@ interface
              target_i386_openbsd,       { 24 }
              target_m68k_openbsd,       { 25 }
              system_x86_64_linux,       { 26 }
-             system_powerpc_macosx      { 27 }
+             system_powerpc_macosx,     { 27 }
+             system_i386_EMX            { 28 }
        );
 
        tasm = (as_none
@@ -678,7 +679,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.59  2003-01-12 15:42:23  peter
+  Revision 1.60  2003-03-23 23:21:42  hajny
+    + emx target added
+
+  Revision 1.59  2003/01/12 15:42:23  peter
     * m68k pathexist update from 1.0.x
     * palmos res update from 1.0.x
 

+ 123 - 0
compiler/systems/i_emx.pas

@@ -0,0 +1,123 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Peter Vreman
+
+    This unit implements support information structures for OS/2 via EMX
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+{ This unit implements support information structures for OS/2 via EMX. }
+unit i_emx;
+
+  interface
+
+    uses
+       systems;
+
+    const
+       res_emxbind_info : tresinfo =
+          (
+            id     : res_emxbind;
+            resbin : 'emxbind';
+            rescmd : '-b -r $RES $OBJ'
+            (* Not really used - see TLinkerEMX.SetDefaultInfo in t_emx.pas. *)
+          );
+
+       system_i386_emx_info : tsysteminfo =
+          (
+            system       : system_i386_EMX;
+            name         : 'OS/2 via EMX';
+            shortname    : 'EMX';
+            flags        : [tf_need_export];
+            cpu          : cpu_i386;
+            unit_env     : 'EMXUNITS';
+            extradefines : 'OS2';
+            sourceext    : '.pas';
+            pasext       : '.pp';
+            exeext       : '.exe';
+            defext       : '.def';
+            scriptext    : '.cmd';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            staticlibprefix : '';
+            sharedlibprefix : '';
+            sharedClibext : '.dll';
+            staticClibext : '.a';
+            staticClibprefix : '';
+            sharedClibprefix : '';
+            Cprefix      : '_';
+            newline      : #13#10;
+            dirsep       : '\';
+            files_case_relevent : false;
+            assem        : as_i386_as_aout;
+            assemextern  : as_i386_as_aout;
+            link         : nil;
+            linkextern   : nil;
+            ar           : ar_gnu_ar;
+            res          : res_emxbind;
+            script       : script_dos;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 4;
+                varalignmin     : 0;
+                varalignmax     : 4;
+                localalignmin   : 0;
+                localalignmax   : 4;
+                paraalign       : 4;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 4
+              );
+            first_parm_offset : 8;
+            heapsize     : 256*1024;
+            stacksize    : 256*1024;
+            DllScanSupported:true;
+            use_function_relative_addresses : false
+          );
+
+
+  implementation
+
+initialization
+{$ifdef CPU86}
+  {$ifdef EMX}
+    {$IFNDEF VER1_0}
+      set_source_info(system_i386_emx_info);
+      { OS/2 via EMX can be run under DOS as well }
+      if (OS_Mode=osDOS) or (OS_Mode=osDPMI) then
+        source_info.scriptext := '.bat';
+    {$ENDIF VER1_0}
+  {$endif EMX}
+{$endif CPU86}
+end.
+{
+  $Log$
+  Revision 1.1  2003-03-23 23:28:33  hajny
+    + emx target added
+
+}

+ 523 - 0
compiler/systems/t_emx.pas

@@ -0,0 +1,523 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Daniel Mantione
+    Portions Copyright (c) 1998-2002 Eberhard Mattes
+
+    Unit to write out import libraries and def files for OS/2 via EMX
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{
+   A lot of code in this unit has been ported from C to Pascal from the
+   emximp utility, part of the EMX development system. Emximp is copyrighted
+   by Eberhard Mattes. Note: Eberhard doesn't know much about the Pascal
+   port, please send questions to Daniel Mantione
+   <[email protected]>.
+}
+unit t_emx;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+  uses
+{$ifdef Delphi}
+     sysutils,
+     dmisc,
+{$else Delphi}
+     strings,
+     dos,
+{$endif Delphi}
+     cutils,cclasses,
+     globtype,comphook,systems,symsym,
+     globals,verbose,fmodule,script,
+     import,link,i_emx,ppu;
+
+  type
+    TImportLibEMX=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure generatelib;override;
+    end;
+
+    TLinkerEMX=class(texternallinker)
+    private
+       Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+       constructor Create;override;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
+    end;
+
+
+const   profile_flag:boolean=false;
+
+const   n_ext   = 1;
+        n_abs   = 2;
+        n_text  = 4;
+        n_data  = 6;
+        n_bss   = 8;
+        n_imp1  = $68;
+        n_imp2  = $6a;
+
+type    reloc=packed record     {This is the layout of a relocation table
+                                 entry.}
+            address:longint;    {Fixup location}
+            remaining:longint;
+            {Meaning of bits for remaining:
+             0..23:              Symbol number or segment
+             24:                 Self-relative fixup if non-zero
+             25..26:             Fixup size (0: 1 byte, 1: 2, 2: 4 bytes)
+             27:                 Reference to symbol or segment
+             28..31              Not used}
+        end;
+
+        nlist=packed record     {This is the layout of a symbol table entry.}
+            strofs:longint;     {Offset in string table}
+            typ:byte;           {Type of the symbol}
+            other:byte;         {Other information}
+            desc:word;          {More information}
+            value:longint;      {Value (address)}
+        end;
+
+        a_out_header=packed record
+            magic:word;         {Magic word, must be $0107}
+            machtype:byte;      {Machine type}
+            flags:byte;         {Flags}
+            text_size:longint;  {Length of text, in bytes}
+            data_size:longint;  {Length of initialized data, in bytes}
+            bss_size:longint;   {Length of uninitialized data, in bytes}
+            sym_size:longint;   {Length of symbol table, in bytes}
+            entry:longint;      {Start address (entry point)}
+            trsize:longint;     {Length of relocation info for text, bytes}
+            drsize:longint;     {Length of relocation info for data, bytes}
+        end;
+
+        ar_hdr=packed record
+            ar_name:array[0..15] of char;
+            ar_date:array[0..11] of char;
+            ar_uid:array[0..5] of char;
+            ar_gid:array[0..5] of char;
+            ar_mode:array[0..7] of char;
+            ar_size:array[0..9] of char;
+            ar_fmag:array[0..1] of char;
+        end;
+
+var aout_str_size:longint;
+    aout_str_tab:array[0..2047] of byte;
+    aout_sym_count:longint;
+    aout_sym_tab:array[0..5] of nlist;
+
+    aout_text:array[0..63] of byte;
+    aout_text_size:longint;
+
+    aout_treloc_tab:array[0..1] of reloc;
+    aout_treloc_count:longint;
+
+    aout_size:longint;
+    seq_no:longint;
+
+    ar_member_size:longint;
+
+    out_file:file;
+
+procedure write_ar(const name:string;size:longint);
+
+var ar:ar_hdr;
+    time:datetime;
+    dummy:word;
+    numtime:longint;
+    tmp:string[19];
+
+
+begin
+    ar_member_size:=size;
+    fillchar(ar.ar_name,sizeof(ar.ar_name),' ');
+    move(name[1],ar.ar_name,length(name));
+    getdate(time.year,time.month,time.day,dummy);
+    gettime(time.hour,time.min,time.sec,dummy);
+    packtime(time,numtime);
+    str(numtime,tmp);
+    fillchar(ar.ar_date,sizeof(ar.ar_date),' ');
+    move(tmp[1],ar.ar_date,length(tmp));
+    ar.ar_uid:='0     ';
+    ar.ar_gid:='0     ';
+    ar.ar_mode:='100666'#0#0;
+    str(size,tmp);
+    fillchar(ar.ar_size,sizeof(ar.ar_size),' ');
+    move(tmp[1],ar.ar_size,length(tmp));
+    ar.ar_fmag:='`'#10;
+    blockwrite(out_file,ar,sizeof(ar));
+end;
+
+procedure finish_ar;
+
+var a:byte;
+
+begin
+    a:=0;
+    if odd(ar_member_size) then
+        blockwrite(out_file,a,1);
+end;
+
+procedure aout_init;
+
+begin
+  aout_str_size:=sizeof(longint);
+  aout_sym_count:=0;
+  aout_text_size:=0;
+  aout_treloc_count:=0;
+end;
+
+function aout_sym(const name:string;typ,other:byte;desc:word;
+                  value:longint):longint;
+
+begin
+    if aout_str_size+length(name)+1>sizeof(aout_str_tab) then
+        Do_halt($da);
+    if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
+        Do_halt($da);
+    aout_sym_tab[aout_sym_count].strofs:=aout_str_size;
+    aout_sym_tab[aout_sym_count].typ:=typ;
+    aout_sym_tab[aout_sym_count].other:=other;
+    aout_sym_tab[aout_sym_count].desc:=desc;
+    aout_sym_tab[aout_sym_count].value:=value;
+    strPcopy(@aout_str_tab[aout_str_size],name);
+    aout_str_size:=aout_str_size+length(name)+1;
+    aout_sym:=aout_sym_count;
+    inc(aout_sym_count);
+end;
+
+procedure aout_text_byte(b:byte);
+
+begin
+    if aout_text_size>=sizeof(aout_text) then
+        Do_halt($da);
+    aout_text[aout_text_size]:=b;
+    inc(aout_text_size);
+end;
+
+procedure aout_text_dword(d:longint);
+
+type li_ar=array[0..3] of byte;
+
+begin
+    aout_text_byte(li_ar(d)[0]);
+    aout_text_byte(li_ar(d)[1]);
+    aout_text_byte(li_ar(d)[2]);
+    aout_text_byte(li_ar(d)[3]);
+end;
+
+procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
+
+begin
+    if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then
+        Do_halt($da);
+    aout_treloc_tab[aout_treloc_count].address:=address;
+    aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
+     len shl 25+ext shl 27;
+    inc(aout_treloc_count);
+end;
+
+procedure aout_finish;
+
+begin
+    while (aout_text_size and 3)<>0 do
+        aout_text_byte ($90);
+    aout_size:=sizeof(a_out_header)+aout_text_size+aout_treloc_count*
+     sizeof(reloc)+aout_sym_count*sizeof(aout_sym_tab[0])+aout_str_size;
+end;
+
+procedure aout_write;
+
+var ao:a_out_header;
+
+begin
+    ao.magic:=$0107;
+    ao.machtype:=0;
+    ao.flags:=0;
+    ao.text_size:=aout_text_size;
+    ao.data_size:=0;
+    ao.bss_size:=0;
+    ao.sym_size:=aout_sym_count*sizeof(aout_sym_tab[0]);
+    ao.entry:=0;
+    ao.trsize:=aout_treloc_count*sizeof(reloc);
+    ao.drsize:=0;
+    blockwrite(out_file,ao,sizeof(ao));
+    blockwrite(out_file,aout_text,aout_text_size);
+    blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count);
+    blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count);
+    longint((@aout_str_tab)^):=aout_str_size;
+    blockwrite(out_file,aout_str_tab,aout_str_size);
+end;
+
+procedure TImportLibEMX.preparelib(const s:string);
+
+{This code triggers a lot of bugs in the compiler.
+const   armag='!<arch>'#10;
+        ar_magic:array[1..length(armag)] of char=armag;}
+const   ar_magic:array[1..8] of char='!<arch>'#10;
+var
+  libname : string;
+begin
+    LibName:=FixFileName(S + Target_Info.StaticCLibExt);
+    seq_no:=1;
+    current_module.linkotherstaticlibs.add(libname,link_allways);
+    assign(out_file,current_module.outputpath^+libname);
+    rewrite(out_file,1);
+    blockwrite(out_file,ar_magic,sizeof(ar_magic));
+end;
+
+procedure TImportLibEMX.ImportProcedure(const func,module:string;index:longint;const name:string);
+{func       = Name of function to import.
+ module     = Name of DLL to import from.
+ index      = Index of function in DLL. Use 0 to import by name.
+ name       = Name of function in DLL. Ignored when index=0;}
+var tmp1,tmp2,tmp3:string;
+    sym_mcount,sym_import:longint;
+    fixup_mcount,fixup_import:longint;
+begin
+    { force the current mangledname }
+    aktprocdef.has_mangledname:=true;
+
+    aout_init;
+    tmp2:=func;
+    if profile_flag and not (copy(func,1,4)='_16_') then
+        begin
+            {sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);}
+            sym_mcount:=aout_sym('__mcount',n_ext,0,0,0);
+            {Use, say, "_$U_DosRead" for "DosRead" to import the
+             non-profiled function.}
+            tmp2:='__$U_'+func;
+            sym_import:=aout_sym(tmp2,n_ext,0,0,0);
+            aout_text_byte($55);    {push ebp}
+            aout_text_byte($89);    {mov ebp, esp}
+            aout_text_byte($e5);
+            aout_text_byte($e8);    {call _mcount}
+            fixup_mcount:=aout_text_size;
+            aout_text_dword(0-(aout_text_size+4));
+            aout_text_byte($5d);    {pop ebp}
+            aout_text_byte($e9);    {jmp _$U_DosRead}
+            fixup_import:=aout_text_size;
+            aout_text_dword(0-(aout_text_size+4));
+
+            aout_treloc(fixup_mcount,sym_mcount,1,2,1);
+            aout_treloc (fixup_import, sym_import,1,2,1);
+        end;
+    str(seq_no,tmp1);
+    tmp1:='IMPORT#'+tmp1;
+    if name='' then
+        begin
+            str(index,tmp3);
+            tmp3:=func+'='+module+'.'+tmp3;
+        end
+    else
+        tmp3:=func+'='+module+'.'+name;
+    aout_sym(tmp2,n_imp1+n_ext,0,0,0);
+    aout_sym(tmp3,n_imp2+n_ext,0,0,0);
+    aout_finish;
+    write_ar(tmp1,aout_size);
+    aout_write;
+    finish_ar;
+    inc(seq_no);
+end;
+
+procedure TImportLibEMX.GenerateLib;
+
+begin
+    close(out_file);
+end;
+
+
+{****************************************************************************
+                               TLinkerEMX
+****************************************************************************}
+
+Constructor TLinkerEMX.Create;
+begin
+  Inherited Create;
+  { allow duplicated libs (PM) }
+  SharedLibFiles.doubles:=true;
+  StaticLibFiles.doubles:=true;
+end;
+
+
+procedure TLinkerEMX.SetDefaultInfo;
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='ld $OPT -o $EXE.out @$RES';
+     ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE.out -aim -s$DOSHEAPKB';
+     ExeCmd[3]:='del $EXE.out';
+   end;
+end;
+
+
+Function TLinkerEMX.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres  : TLinkRes;
+  i        : longint;
+  HPath    : TStringListItem;
+  s        : string;
+begin
+  WriteResponseFile:=False;
+
+  { Open link.res file }
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  { add objectfiles, start with prt0 always }
+  LinkRes.AddFileName(FindObjectFile('prt0',''));
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(s);
+   end;
+
+  { Write staticlibraries }
+  { No group !! This will not work correctly PM }
+  While not StaticLibFiles.Empty do
+   begin
+     S:=StaticLibFiles.GetFirst;
+     LinkRes.AddFileName(s)
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  While not SharedLibFiles.Empty do
+   begin
+     S:=SharedLibFiles.GetFirst;
+     i:=Pos(target_info.sharedlibext,S);
+     if i>0 then
+      Delete(S,i,255);
+     LinkRes.Add('-l'+s);
+   end;
+
+{ Write and Close response }
+  linkres.writetodisk;
+  LinkRes.Free;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkerEMX.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  i       : longint;
+  AppTypeStr,
+  StripStr: string[40];
+  RsrcStr : string;
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr := '-s'
+  else
+   StripStr := '';
+  if (usewindowapi) or (AppType = app_gui) then
+   AppTypeStr := '-p'
+  else if AppType = app_fs then
+   AppTypeStr := '-f'
+  else AppTypeStr := '-w';
+  if not (Current_module.ResourceFiles.Empty) then
+   RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst
+  else
+   RsrcStr := '';
+(* Only one resource file supported, discard everything else
+   (should be already empty anyway, however. *)
+  Current_module.ResourceFiles.Clear;
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  success:=false;
+  for i:=1 to 3 do
+   begin
+     SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
+     if binstr<>'' then
+      begin
+        { Is this really required? Not anymore according to my EMX docs }
+        Replace(cmdstr,'$HEAPMB',tostr((heapsize+1048575) shr 20));
+        {Size of the stack when an EMX program runs in OS/2.}
+        Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10));
+        {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+heapsize+1023) shr 10));
+        Replace(cmdstr,'$STRIP',StripStr);
+        Replace(cmdstr,'$APPTYPE',AppTypeStr);
+        Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+        Replace(cmdstr,'$OPT',Info.ExtraOptions);
+        Replace(cmdstr,'$RSRC',RsrcStr);
+        Replace(cmdstr,'$EXE',current_module.exefilename^);
+        if i<>3 then
+         success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false)
+        else
+         success:=DoExec(binstr,cmdstr,(i=1),true);
+(* We still want to have the PPAS script complete, right?
+        if not success then
+         break;
+*)
+      end;
+   end;
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+initialization
+  RegisterExternalLinker(system_i386_emx_info,TLinkerEMX);
+  RegisterImport(system_i386_emx,TImportLibEMX);
+  RegisterRes(res_emxbind_info);
+  RegisterTarget(system_i386_emx_info);
+end.
+{
+  $Log$
+  Revision 1.1  2003-03-23 23:28:33  hajny
+    + emx target added
+
+
+}

+ 1 - 0
fcl/Makefile.fpc

@@ -39,6 +39,7 @@ includedir_netbsd=unix
 includedir_openbsd=unix
 includedir_sunos=posix
 includedir_qnx=posix
+includedir_emx=os2
 sourcedir=$(OS_TARGET) inc
 
 [libs]

+ 1 - 0
packages/extra/Makefile.fpc

@@ -22,6 +22,7 @@ dirs_openbsd=unzip uncgi  \
 dirs_win32=unzip uncgi opengl gtk \
            zlib mmsystem tcl cdrom fpgtk
 dirs_os2=unzip uncgi zlib os2units rexx x11 gtk fpgtk
+dirs_emx=unzip uncgi zlib os2units rexx x11 gtk fpgtk
 dirs_go32v2=unzip uncgi
 dirs_netware=cmem zlib
 

+ 1 - 0
rtl/Makefile.fpc

@@ -12,6 +12,7 @@ dirs_win32=win32
 dirs_go32v2=go32v2
 dirs_go32v1=go32v1
 dirs_os2=os2
+dirs_emx=emx
 dirs_freebsd=freebsd
 dirs_beos=beos
 dirs_amiga=amiga

+ 21 - 20
rtl/emx/Makefile.fpc

@@ -9,7 +9,7 @@ main=rtl
 loaders=prt0 prt1
 units=$(SYSTEMUNIT) objpas strings \
       ports os2def doscalls moncalls kbdcalls moucalls viocalls \
-      pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl dive \
+      pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl \
       dos crt objects printer \
       sysutils math typinfo varutils \
       charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs \
@@ -28,8 +28,8 @@ target=emx
 cpu=i386
 
 [compiler]
-includedir=$(INC) $(PROCINC) ../os2
-sourcedir=$(INC) $(PROCINC) ../os2
+includedir=$(INC) $(PROCINC) $(OS2INC)
+sourcedir=$(INC) $(PROCINC) $(OS2INC)
 targetdir=.
 
 
@@ -37,6 +37,7 @@ targetdir=.
 RTL=..
 INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU_TARGET)
+OS2INC=$(RTL)/os2
 
 UNITPREFIX=rtl
 
@@ -102,31 +103,31 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
 
 ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) objects$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+doscalls$(PPUEXT) : $(OS2INC)/doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
+kbdcalls$(PPUEXT) : $(OS2INC)/kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
 
-moucalls$(PPUEXT) : moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
+moucalls$(PPUEXT) : $(OS2INC)/moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
 
-moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+moncalls$(PPUEXT) : $(OS2INC)/moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-os2def$(PPUEXT) : os2def.pas $(SYSTEMUNIT)$(PPUEXT)
+os2def$(PPUEXT) : $(OS2INC)/os2def.pas $(SYSTEMUNIT)$(PPUEXT)
 
-pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmwin$(PPUEXT) : $(OS2INC)/pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
+pmbitmap$(PPUEXT) : $(OS2INC)/pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
 
-pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmgpi$(PPUEXT) : $(OS2INC)/pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-pmstddlg$(PPUEXT) : pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmstddlg$(PPUEXT) : $(OS2INC)/pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-pmhelp$(PPUEXT) : pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmhelp$(PPUEXT) : $(OS2INC)/pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-pmdev$(PPUEXT) : pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmdev$(PPUEXT) : $(OS2INC)/pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-pmspl$(PPUEXT) : pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmspl$(PPUEXT) : $(OS2INC)/pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmshl$(PPUEXT) : $(OS2INC)/pmshl.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
@@ -139,9 +140,9 @@ dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
 
 crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : $(OS2INC)/printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
 
 #graph$(PPUEXT) : graph.pp
 
@@ -160,8 +161,8 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
 
 varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
-                    $(OBJPASDIR)/varutilh.inc varutils.pp
-        $(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
+                    $(OBJPASDIR)/varutilh.inc $(OS2INC)/varutils.pp
+        $(COMPILER) -I$(OBJPASDIR) $(OS2INC)/varutils.pp $(REDIR)
 
 types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/types.pp

+ 901 - 0
rtl/emx/crt.pas

@@ -0,0 +1,901 @@
+{****************************************************************************
+
+    $Id$
+
+                            Standard CRT unit.
+                    Free Pascal runtime library for EMX.
+                    Copyright (c) 1997 Daniel Mantione.
+
+      This file may be reproduced and modified under the same conditions
+                      as all other Free Pascal source code.
+
+****************************************************************************}
+
+unit crt;
+
+{$ASMMODE ATT}
+
+interface
+
+uses dos;
+
+const   _40cols=0;
+        _80cols=1;
+        _132cols=2;
+        _25rows=0;
+        _28rows=16;
+        _43rows=32;
+        _50rows=48;
+        font8x8=_50rows;
+
+        black         =0;
+        blue          =1;
+        green         =2;
+        cyan          =3;
+        red           =4;
+        magenta       =5;
+        brown         =6;
+        lightgray     =7;
+        darkgray      =8;
+        lightblue     =9;
+        lightgreen    =10;
+        lightcyan     =11;
+        lightred      =12;
+        lightmagenta  =13;
+        yellow        =14;
+        white         =15;
+        blink         =128;
+
+{cemodeset means that the procedure textmode has failed to set up a mode.}
+
+type    cexxxx=(cenoerror,cemodeset);
+
+var textattr:byte;                      {Text attribute.        RW}
+    windmin,windmax:word;               {Window coordinates.    R-}
+    lastmode:word;                      {Last videomode.        R-}
+    crt_error:cexxxx;                   {Crt-status.            RW}
+
+function keypressed:boolean;
+function readkey:char;
+
+procedure clrscr;
+procedure clreol;
+function whereX:byte;
+function whereY:byte;
+procedure gotoXY(x,y:byte);
+procedure window(left,top,right,bottom : byte);
+procedure textmode(mode:integer);
+procedure textcolor(colour:byte);
+procedure textbackground(colour:byte);
+procedure insline;
+procedure delline;
+procedure lowvideo;
+procedure normvideo;
+procedure highvideo;
+procedure assigncrt(var f:text);
+procedure delay(ms:word);
+procedure sound(hz:word);
+procedure nosound;
+
+{***************************************************************************}
+
+{***************************************************************************}
+
+implementation
+
+const   extkeycode:char=#0;
+
+var maxrows,maxcols:word;
+    calibration:longint;
+
+type    Tkbdkeyinfo=record
+            charcode,scancode:char;
+            fbstatus,bnlsshift:byte;
+            fsstate:word;
+            time:longint;
+        end;
+
+        {if you have information on the folowing datastructure, please
+         send them to me at [email protected]}
+
+        {This datastructure is needed when we ask in what video mode we are,
+         or we want to set up a new mode.}
+
+        viomodeinfo=record
+            cb:word;                         { length of the entire data
+                                               structure }
+            fbtype,                          { bit mask of mode being set}
+            color: byte;                     { number of colors (power of 2) }
+            col,                             { number of text columns }
+            row,                             { number of text rows }
+            hres,                            { horizontal resolution }
+            vres: word;                      { vertical resolution }
+            fmt_ID,                          { attribute format
+                                               ! more info wanted !}
+            attrib: byte;                    { number of attributes }
+            buf_addr,                        { physical address of
+                                               videobuffer, e.g. $0b800}
+            buf_length,                      { length of a videopage (bytes)}
+            full_length,                     { total video-memory on video-
+                                               card (bytes)}
+            partial_length:longint;          { ????? info wanted !}
+            ext_data_addr:pointer;           { ????? info wanted !}
+        end;
+        Pviomodeinfo=^viomodeinfo;
+
+{EMXWRAP.DLL has strange calling conventions: All parameters must have
+ a 4 byte size.}
+
+function kbdcharin(var Akeyrec:Tkbdkeyinfo;wait,kbdhandle:longint):word; cdecl;
+                   external 'EMXWRAP' index 204;
+function kbdpeek(var Akeyrec:TkbdkeyInfo;kbdhandle:word):word; cdecl;
+                 external 'EMXWRAP' index 222;
+
+function dossleep(time:longint):word; cdecl;
+                  external 'DOSCALLS' index 229;
+function vioscrollup(top,left,bottom,right,lines:longint;
+                     var screl:word;viohandle:longint):word; cdecl;
+                     external 'EMXWRAP' index 107;
+function vioscrolldn(top,left,bottom,right,lines:longint;
+                     var screl:word;viohandle:longint):word; cdecl;
+                     external 'EMXWRAP' index 147;
+function viogetcurpos(var row,column:word;viohandle:longint):word; cdecl;
+                      external 'EMXWRAP' index 109;
+function viosetcurpos(row,column,viohandle:longint):word; cdecl;
+                      external 'EMXWRAP' index 115;
+function viowrtTTY(s:Pchar;len,viohandle:longint):word; cdecl;
+                      external 'EMXWRAP' index 119;
+function viowrtcharstratt(s:Pchar;len,row,col:longint;var attr:byte;
+                          viohandle:longint):word; cdecl;
+                          external 'EMXWRAP' index 148;
+function viogetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word; cdecl;
+                    external 'EMXWRAP' index 121;
+function viosetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word; cdecl;
+                    external 'EMXWRAP' index 122;
+
+procedure setscreenmode(mode:word);
+
+{ This procedure sets a new videomode. Note that the constants passes to
+  this procedure are different than in the dos mode.}
+
+const   modecols:array[0..2] of word=(40,80,132);
+        moderows:array[0..3] of word=(25,28,43,50);
+
+var newmode:viomodeinfo;
+
+begin
+    if os_mode=osOS2 then
+        begin
+            newmode.cb:=8;
+            newmode.fbtype:=1;          {Non graphics colour mode.}
+            newmode.color:=4;           {We want 16 colours, 2^4=16.}
+            newmode.col:=modecols[mode and 15];
+            newmode.row:=moderows[mode shr 4];
+            if viosetmode(newmode,0)=0 then
+                crt_error:=cenoerror
+            else
+                crt_error:=cemodeset;
+            maxcols:=newmode.col;
+            maxrows:=newmode.row;
+        end
+    else
+        begin
+            maxcols:=modecols[mode and 15];
+            maxrows:=moderows[mode shr 4];
+            crt_error:=cenoerror;
+            {Set correct vertical resolution.}
+            asm
+                movw $0x1202,%ax
+                movw 8(%ebp),%bx
+                shrw $4,%bx
+                cmpb $2,%bl
+                jne .L_crtsetmode_a1
+                decw %ax
+            .L_crtsetmode_a1:
+                mov $0x30,%bl
+                int $0x10
+            end;
+            {132 column mode in DOS is videocard dependend.}
+            if mode and 15=2 then
+                begin
+                    crt_error:=cemodeset;
+                    exit;
+                end;
+            {Switch to correct mode.}
+            asm
+                mov 8(%ebp),%bx
+                and $15,%bl
+                mov $1,%ax
+                cmp $1,%bl
+                jne .L_crtsetmode_b1
+                mov $3,%al
+            .L_crtsetmode_b1:
+                int $0x10
+            {Use alternate print-screen function.}
+                mov $0x12,%ah
+                mov $0x20,%bl
+                int $0x10
+            end;
+            {Set correct font.}
+            case mode shr 4 of
+                1:
+                    {Set 8x14 font.}
+                    asm
+                        mov $0x1111,%ax
+                        mov $0,%bl
+                        int $0x10
+                    end;
+                2,3:
+                    {Set 8x8 font.}
+                    asm
+                        mov $0x1112,%ax
+                        mov $0,%bl
+                        int $0x10
+                    end;
+            end;
+        end;
+end;
+
+procedure getcursor(var y,x:word);
+
+{Get the cursor position.}
+
+begin
+    if os_mode=osOS2 then
+        viogetcurpos(y,x,0)
+    else
+        asm
+            movb $3,%ah
+            movb $0,%bh
+            int $0x10
+            movl y,%eax
+            movl x,%ebx
+            movzbl %dh,%edi
+            andw $255,%dx
+            movw %di,(%eax)
+            movw %dx,(%ebx)
+        end;
+end;
+
+{$ASMMODE INTEL}
+procedure setcursor(y,x:word);
+
+{Set the cursor position.}
+
+begin
+    if os_mode=osOS2 then
+        viosetcurpos(y,x,0)
+    else
+        asm
+            mov ah, 2
+            mov bh, 0
+            mov dh, byte ptr y
+            mov dl, byte ptr x
+            int 10h
+        end;
+end;
+
+procedure scroll_up(top,left,bottom,right,lines:word;var screl:word);
+
+begin
+    if os_mode=osOS2 then
+        vioscrollup(top,left,bottom,right,lines,screl,0)
+    else
+        asm
+            mov ah, 6
+            mov al, byte ptr lines
+            mov edi, screl
+            mov bh, [edi + 1]
+            mov ch, byte ptr top
+            mov cl, byte ptr left
+            mov dh, byte ptr bottom
+            mov dl, byte ptr right
+            int 10h
+        end;
+end;
+
+procedure scroll_dn(top,left,bottom,right,lines:word;var screl:word);
+
+begin
+    if os_mode=osOS2 then
+        vioscrolldn(top,left,bottom,right,lines,screl,0)
+    else
+        asm
+            mov ah, 7
+            mov al, byte ptr lines
+            mov edi, screl
+            mov bh, [edi + 1]
+            mov ch, byte ptr top
+            mov cl, byte ptr left
+            mov dh, byte ptr bottom
+            mov dl, byte ptr right
+            int 10h
+        end;
+end;
+
+{$ASMMODE ATT}
+function keypressed:boolean;
+
+{Checks if a key is pressed.}
+
+var Akeyrec:Tkbdkeyinfo;
+
+begin
+    if os_mode=osOS2 then
+        begin
+            kbdpeek(Akeyrec,0);
+            keypressed:=(extkeycode<>#0) or ((Akeyrec.fbstatus and $40)<>0);
+        end
+    else
+        begin
+            if extkeycode<>#0 then
+                begin
+                    keypressed:=true;
+                    exit
+                end
+            else
+                asm
+                    movb $1,%ah
+                    int $0x16
+                    setnz %al
+                    movb %al,__RESULT
+                end;
+        end;
+end;
+
+function readkey:char;
+
+{Reads the next character from the keyboard.}
+
+var Akeyrec:Tkbdkeyinfo;
+    c,s:char;
+
+begin
+    if extkeycode<>#0 then
+        begin
+            readkey:=extkeycode;
+            extkeycode:=#0
+        end
+    else
+        begin
+            if os_mode=osOS2 then
+                begin
+                    kbdcharin(Akeyrec,0,0);
+                    c:=Akeyrec.charcode;
+                    s:=Akeyrec.scancode;
+                    if (c=#224) and (s<>#0) then
+                        c:=#0;
+                end
+            else
+                begin
+                    asm
+                        movb $0,%ah
+                        int $0x16
+                        movb %al,c
+                        movb %ah,s
+                    end;
+                end;
+            if c=#0 then
+                extkeycode:=s;
+            readkey:=c;
+        end;
+end;
+
+procedure clrscr;
+
+{Clears the current window.}
+
+var screl:word;
+
+begin
+    screl:=$20+textattr shl 8;
+    scroll_up(hi(windmin),lo(windmin),
+              hi(windmax),lo(windmax),
+              hi(windmax)-hi(windmin)+1,
+              screl);
+    gotoXY(1,1);
+end;
+
+procedure gotoXY(x,y:byte);
+
+{Positions the cursor on (x,y) relative to the window origin.}
+
+begin
+    if x<1 then
+        x:=1;
+    if y<1 then
+        y:=1;
+    if y+hi(windmin)-2>=hi(windmax) then
+        y:=hi(windmax)-hi(windmin)+1;
+    if x+lo(windmin)-2>=lo(windmax) then
+        x:=lo(windmax)-lo(windmin)+1;
+    setcursor(y+hi(windmin)-1,x+lo(windmin)-1);
+end;
+
+function whereX:byte;
+
+{Returns the x position of the cursor.}
+
+var x,y:word;
+
+begin
+    getcursor(y,x);
+    whereX:=x-lo(windmin)+1;
+end;
+
+function whereY:byte;
+
+{Returns the y position of the cursor.}
+
+var x,y:word;
+
+begin
+    getcursor(y,x);
+    whereY:=y-hi(windmin)+1;
+end;
+
+procedure clreol;
+{Clear from current position to end of line.
+Contributed by Michail A. Baikov}
+
+var i:byte;
+
+begin
+    {not fastest, but compatible}
+    for i:=wherex to lo(windmax) do write(' ');
+        gotoxy(1,wherey); {may be not}
+end;
+
+
+procedure delline;
+
+{Deletes the line at the cursor.}
+
+var row,left,right,bot:longint;
+    fil:word;
+
+begin
+    row:=whereY;
+    left:=lo(windmin)+1;
+    right:=lo(windmax)+1;
+    bot:=hi(windmax)+1;
+    fil:=$20 or (textattr shl 8);
+    scroll_up(row+1,left,bot,right,1,fil);
+end;
+
+procedure insline;
+
+{Inserts a line at the cursor position.}
+
+var row,left,right,bot:longint;
+    fil:word;
+
+begin
+    row:=whereY;
+    left:=lo(windmin)+1;
+    right:=lo(windmax)+1;
+    bot:=hi(windmax);
+    fil:=$20 or (textattr shl 8);
+    scroll_dn(row,left,bot-1,right,1,fil);
+end;
+
+procedure textmode(mode:integer);
+
+{ Use this procedure to set-up a specific text-mode.}
+
+begin
+    textattr:=$07;
+    lastmode:=mode;
+    mode:=mode and $ff;
+    setscreenmode(mode);
+    windmin:=0;
+    windmax:=(maxcols-1) or ((maxrows-1) shl 8);
+    clrscr;
+end;
+
+procedure textcolor(colour:byte);
+
+{All text written after calling this will have color as foreground colour.}
+
+begin
+    textattr:=(textattr and $70) or (colour and $f)+colour and 128;
+end;
+
+procedure textbackground(colour:byte);
+
+{All text written after calling this will have colour as background colour.}
+
+begin
+    textattr:=(textattr and $8f) or ((colour and $7) shl 4);
+end;
+
+procedure normvideo;
+
+{Changes the text-background to black and the foreground to white.}
+
+begin
+    textattr:=$7;
+end;
+
+procedure lowvideo;
+
+{All text written after this will have low intensity.}
+
+begin
+    textattr:=textattr and $f7;
+end;
+
+procedure highvideo;
+
+{All text written after this will have high intensity.}
+
+begin
+    textattr:=textattr or $8;
+end;
+
+procedure delay(ms:word);
+
+var i,j:longint;
+
+{Waits ms microseconds. The DOS code is copied from the DOS rtl.}
+
+begin
+    {Under OS/2 we could also calibrate like under DOS. But this is
+     unreliable, because OS/2 can hold our programs while calibrating,
+     if it needs the processor for other things.}
+    if os_mode=osOS2 then
+        dossleep(ms)
+    else
+        begin
+            for i:=1 to ms do
+                for j:=1 to calibration do
+                    begin
+                    end;
+        end;
+end;
+
+procedure window(left,top,right,bottom:byte);
+
+{Change the write window to the given coordinates.}
+
+begin
+    if (left<1) or
+     (top<1) or
+     (right>maxcols) or
+     (bottom>maxrows) or
+     (left>right) or
+     (top>bottom) then
+        exit;
+    windmin:=(left-1) or ((top-1) shl 8);
+    windmax:=(right-1) or ((bottom-1) shl 8);
+    gotoXY(1,1);
+end;
+
+{$ASMMODE INTEL}
+procedure writePchar(s:Pchar;len:word);
+
+{Write a series of characters to the screen.
+
+ Not very fast, but is just text-mode isn't it?}
+
+var x,y:word;
+    c:char;
+    i,n:integer;
+    screl:word;
+    ca:Pchar;
+
+begin
+    i:=0;
+    getcursor(y,x);
+    while i<=len-1 do
+        begin
+            case s[i] of
+                #8:
+                    x:=x-1;
+                #9:
+                    x:=(x-lo(windmin)) and $fff8+8+lo(windmin);
+                #10:
+                    ;
+                #13:
+                    begin
+                        x:=lo(windmin);
+                        inc(y);
+                    end;
+                else
+                    begin
+                        ca:=@s[i];
+                        n:=1;
+                        while not(s[i+1] in [#8,#9,#10,#13]) and
+{                         (x+n<=lo(windmax)+1) and (i<len-1) do}
+                         (x+n<=lo(windmax)) and (i<len-1) do
+                            begin
+                                inc(n);
+                                inc(i);
+                            end;
+                        if os_mode=osOS2 then
+                            viowrtcharstratt(ca,n,y,x,textattr,0)
+                        else
+                            asm
+                                mov ax, 1300h
+                                mov bh, 0
+                                mov bl, TEXTATTR
+                                mov dh, byte ptr y
+                                mov dl, byte ptr x
+                                mov cx, n
+                                push ebp
+                                mov ebp, ca
+                                int 10h
+                                pop ebp
+                            end;
+                        x:=x+n;
+                    end;
+            end;
+            if x>lo(windmax) then
+                begin
+                    x:=lo(windmin);
+                    inc(y);
+                end;
+            if y>hi(windmax) then
+                begin
+                    screl:=$20+textattr shl 8;
+                    scroll_up(hi(windmin),lo(windmin),
+                              hi(windmax),lo(windmax),
+                              1,screl);
+                    y:=hi(windmax);
+                end;
+{           writeln(stderr,x,'  ',y);}
+            inc(i);
+        end;
+    setcursor(y,x);
+end;
+
+{$ASMMODE ATT}
+function crtread(var f:textrec):word;
+
+{Read a series of characters from the console.}
+
+var max,curpos:integer;
+    c:char;
+    clist:array[0..2] of char;
+
+begin
+    max:=f.bufsize-2;
+    curpos:=0;
+    repeat
+        c:=readkey;
+        case c of
+            #0:
+                readkey;
+            #8:
+                if curpos>0 then
+                    begin
+                        clist:=#8' '#8;
+                        writePchar(@clist,3);
+                        dec(curpos);
+                    end;
+            #13:
+                begin
+                    f.bufptr^[curpos]:=#13;
+                    inc(curpos);
+                    f.bufptr^[curpos]:=#10;
+                    inc(curpos);
+                    f.bufpos:=0;
+                    f.bufend:=curpos;
+                    clist[0]:=#13;
+                    writePchar(@clist,1);
+                    break;
+                end;
+            #32..#255:
+                if curpos<max then
+                    begin
+                        f.bufptr^[curpos]:=c;
+                        inc(curpos);
+                        writePchar(@c,1);
+                    end;
+        end;
+    until false;
+    crtread:=0;
+end;
+
+function crtwrite(var f:textrec):word;
+
+{Write a series of characters to the console.}
+
+begin
+    writePchar(Pchar(f.bufptr),f.bufpos);
+    f.bufpos:=0;
+    crtwrite:=0;
+end;
+
+
+function crtopen(var f:textrec):integer;
+
+begin
+    if f.mode=fmoutput then
+        crtopen:=0
+    else
+        crtopen:=5;
+end;
+
+function crtinout(var f:textrec):integer;
+
+begin
+    case f.mode of
+        fminput:
+            crtinout:=crtread(f);
+        fmoutput:
+            crtinout:=crtwrite(f);
+    end;
+end;
+
+function crtclose(var f:textrec):integer;
+
+begin
+    f.mode:=fmclosed;
+    crtclose:=0;
+end;
+
+procedure assigncrt(var f:text);
+
+{Assigns a file to the crt console.}
+
+begin
+    textrec(f).mode:=fmclosed;
+    textrec(f).bufsize:=128;
+    textrec(f).bufptr:=@textrec(f).buffer;
+    textrec(f).bufpos:=0;
+    textrec(f).openfunc:=@crtopen;
+    textrec(f).inoutfunc:=@crtinout;
+    textrec(f).flushfunc:=@crtinout;
+    textrec(f).closefunc:=@crtclose;
+    textrec(f).name[0]:='.';
+    textrec(f).name[0]:=#0;
+end;
+
+procedure sound(hz:word);
+
+{sound and nosound are not implemented because the OS/2 API supports a freq/
+ duration procedure instead of start/stop procedures.}
+
+begin
+end;
+
+procedure nosound;
+
+begin
+end;
+
+function get_ticks:word;
+
+type    Pword=^word;
+
+begin
+    get_ticks:=Pword(longint(first_meg)+$46c)^;
+end;
+
+procedure initdelay;
+
+{Calibrate the delay procedure. Copied from DOS rtl.}
+
+var first:word;
+
+begin
+    calibration:=0;
+
+    { wait for new tick }
+    first:=get_ticks;
+    while get_ticks=first do
+        begin
+        end;
+    first:=get_ticks;
+
+    { this estimates calibration }
+    while get_ticks=first do
+        inc(calibration);
+
+    { calculate this to ms }
+    calibration:=calibration div 70;
+    while true do
+        begin
+            first:=get_ticks;
+            while get_ticks=first do
+                begin
+                end;
+            first:=get_ticks;
+            delay(55);
+            if first=get_ticks then
+                exit
+            else
+                begin
+                    { decrement calibration two percent }
+                    calibration:=calibration-calibration div 50;
+                    dec(calibration);
+                end;
+        end;
+end;
+
+{Initialization.}
+
+type    Pbyte=^byte;
+
+var curmode:viomodeinfo;
+    mode:byte;
+
+begin
+    textattr:=lightgray;
+    if os_mode=osOS2 then
+        begin
+            curmode.cb:=sizeof(curmode);
+            viogetmode(curmode,0);
+            maxcols:=curmode.col;
+            maxrows:=curmode.row;
+            lastmode:=0;
+            case maxcols of
+                40:
+                    lastmode:=0;
+                80:
+                    lastmode:=1;
+                132:
+                    lastmode:=2;
+            end;
+            case maxrows of
+                25:;
+                28:
+                    lastmode:=lastmode+16;
+                43:
+                    lastmode:=lastmode+32;
+                50:
+                    lastmode:=lastmode+48;
+            end
+        end
+    else
+        begin
+            {Request video mode to determine columns.}
+            asm
+                mov $0x0f,%ah
+                int $0x10
+{                mov %al,_MODE }
+                mov %al,MODE
+            end;
+            case mode of
+                0,1:
+                    begin
+                        lastmode:=0;
+                        maxcols:=40;
+                    end;
+                else
+                    begin
+                        lastmode:=1;
+                        maxcols:=80;
+                    end;
+            end;
+            {Get number of rows from realmode $0040:$0084.}
+            maxrows:=Pbyte(longint(first_meg)+$484)^;
+            case maxrows of
+                25:;
+                28:
+                    lastmode:=lastmode+16;
+                43:
+                    lastmode:=lastmode+32;
+                50:
+                    lastmode:=lastmode+48;
+            end
+        end;
+    windmin:=0;
+    windmax:=((maxrows-1) shl 8) or (maxcols-1);
+    if os_mode=osDOS then
+        initdelay;
+    crt_error:=cenoerror;
+    assigncrt(input);
+    textrec(input).mode:=fminput;
+    assigncrt(output);
+    textrec(output).mode:=fmoutput;
+end.
+
+{
+  $Log$
+  Revision 1.1  2003-03-23 23:11:17  hajny
+    + emx target added
+
+
+}

+ 27 - 27
rtl/emx/dos.pas

@@ -175,6 +175,7 @@ function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
               const comline:comstr):longint;
 function envcount:longint;
 function envstr(index:longint) : string;
+function GetEnvPChar (EnvVar: string): PChar;
 function getenv(const envvar:string): string;
 
 implementation
@@ -846,7 +847,7 @@ procedure FindFirst (const Path: PathStr; Attr: word; var F: SearchRec);
 
 
 var path0: array[0..255] of char;
-    Count: longint;
+    Count: cardinal;
 
 begin
     {No error.}
@@ -854,9 +855,9 @@ begin
     if os_mode = osOS2 then
     begin
         New (F.FStat);
-        F.Handle := $FFFFFFFF;
+        F.Handle := longint ($FFFFFFFF);
         Count := 1;
-        DosError := Integer(DosFindFirst (Path, F.Handle,
+        DosError := integer (DosFindFirst (Path, F.Handle,
                        Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
                                                            Count, ilStandard));
         if (DosError = 0) and (Count = 0) then DosError := 18;
@@ -883,7 +884,7 @@ end;
 
 
 procedure FindNext (var F: SearchRec);
-var Count: longint;
+var Count: cardinal;
 
 
 begin
@@ -893,7 +894,8 @@ begin
     if os_mode = osOS2 then
     begin
         Count := 1;
-        DosError := Integer(DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^), Count));
+        DosError := integer (DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^),
+                                                                       Count));
         if (DosError = 0) and (Count = 0) then DosError := 18;
     end else _findnext (F);
     DosSearchRec2SearchRec (F);
@@ -932,18 +934,17 @@ begin
     envstr:=strpas(hp);
 end;
 
-function GetEnv (const EnvVar: string): string;
+function GetEnvPChar (EnvVar: string): PChar;
 (* The assembler version is more than three times as fast as Pascal. *)
 var
  P: PChar;
- _EnvVar: string;
 begin
- _EnvVar := UpCase (EnvVar);
+ EnvVar := UpCase (EnvVar);
 {$ASMMODE INTEL}
  asm
   cld
   mov edi, Environment
-  lea esi, _EnvVar
+  lea esi, EnvVar
   xor eax, eax
   lodsb
 @NewVar:
@@ -988,7 +989,14 @@ begin
   mov P, edi      { place pointer to variable contents in P }
 @End:
  end;
- GetEnv := StrPas (P);
+ GetEnvPChar := P;
+end;
+{$ASMMODE ATT}
+
+function GetEnv (const EnvVar: string): string;
+(* The assembler version is more than three times as fast as Pascal. *)
+begin
+ GetEnv := StrPas (GetEnvPChar (EnvVar));
 end;
 {$ASMMODE ATT}
 
@@ -1153,7 +1161,8 @@ var
  ptr : pchar;
  base : pchar;
  i: integer;
- tib : pprocessinfoblock;
+ PIB: PProcessInfoBlock;
+ TIB: PThreadInfoBlock;
 begin
   { We need to setup the environment     }
   { only in the case of OS/2             }
@@ -1162,8 +1171,8 @@ begin
     exit;
   cnt := 0;
   { count number of environment pointers }
-  dosgetinfoblocks (nil, PPProcessInfoBlock (@tib));
-  ptr := pchar(tib^.env);
+  DosGetInfoBlocks (PPThreadInfoBlock (@TIB), PPProcessInfoBlock (@PIB));
+  ptr := pchar(PIB^.env);
   { stringz,stringz...,#0 }
   i := 0;
   repeat
@@ -1180,7 +1189,7 @@ begin
   { got count of environment strings }
   GetMem(envp, cnt*sizeof(pchar)+16384);
   cnt := 0;
-  ptr := pchar(tib^.env);
+  ptr := pchar(PIB^.env);
   i:=0;
   repeat
     envp[cnt] := ptr;
@@ -1213,22 +1222,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2002-12-15 22:50:29  hajny
+  Revision 1.3  2003-03-23 23:11:17  hajny
+    + emx target added
+
+  Revision 1.2  2002/12/15 22:50:29  hajny
     * GetEnv fix merged from os2 target
 
   Revision 1.1  2002/11/17 16:22:53  hajny
     + RTL for emx target
 
-  Revision 1.19  2002/09/07 16:01:24  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.18  2002/07/11 16:00:05  hajny
-    * FindFirst fix (invalid attribute bits masked out)
-
-  Revision 1.17  2002/07/07 18:00:48  hajny
-    * DosGetInfoBlock modification to allow overloaded version (in DosCalls)
-
-  Revision 1.16  2002/03/03 11:19:20  hajny
-    * GetEnv rewritten to assembly - 3x faster now
-
 }

+ 11 - 31
rtl/emx/system.pas

@@ -37,7 +37,11 @@ Coding style:
 interface
 
 {Link the startup code.}
-{$l prt1.oo2}
+{$ifdef VER1_0}
+ {$l prt1.oo2}
+{$else}
+ {$l prt1.o}
+{$endif}
 
 {$I systemh.inc}
 
@@ -589,9 +593,9 @@ begin
             exit;
         end;
     Action := Action or (Flags and $FF);
-(* DenyAll if sharing not specified. *)
+(* DenyNone if sharing not specified. *)
     if Flags and 112 = 0 then
-        Action := Action or 16;
+        Action := Action or 64;
     asm
         movl $0x7f2b, %eax
         movl Action, %ecx
@@ -1237,7 +1241,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2002-12-15 22:46:29  hajny
+  Revision 1.4  2003-03-23 23:11:17  hajny
+    + emx target added
+
+  Revision 1.3  2002/12/15 22:46:29  hajny
     * First_Meg fixed + Environment initialization under Dos
 
   Revision 1.2  2002/11/17 22:32:05  hajny
@@ -1246,31 +1253,4 @@ end.
   Revision 1.1  2002/11/17 16:22:54  hajny
     + RTL for emx target
 
-  Revision 1.26  2002/10/27 14:29:00  hajny
-    * heap management (hopefully) fixed
-
-  Revision 1.25  2002/10/14 19:39:17  peter
-    * threads unit added for thread support
-
-  Revision 1.24  2002/10/13 09:28:45  florian
-    + call to initvariantmanager inserted
-
-  Revision 1.23  2002/09/07 16:01:25  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.22  2002/07/01 16:29:05  peter
-    * sLineBreak changed to normal constant like Kylix
-
-  Revision 1.21  2002/04/21 15:54:20  carl
-  + initialize some global variables
-
-  Revision 1.20  2002/04/12 17:42:16  carl
-  + generic stack checking
-
-  Revision 1.19  2002/03/11 19:10:33  peter
-    * Regenerated with updated fpcmake
-
-  Revision 1.18  2002/02/10 13:46:20  hajny
-    * heap management corrected (heap_brk)
-
 }

+ 4 - 2
rtl/emx/systhrds.pp

@@ -379,7 +379,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.2  2002-11-17 22:32:05  hajny
+  Revision 1.3  2003-03-23 23:11:17  hajny
+    + emx target added
+
+  Revision 1.2  2002/11/17 22:32:05  hajny
     * type corrections (longing x cardinal)
 
   Revision 1.1  2002/11/17 16:45:35  hajny
@@ -392,4 +395,3 @@ end.
     * threads unit added for thread support
 
 }
-  

+ 18 - 24
rtl/emx/sysutils.pp

@@ -192,11 +192,12 @@ function DosScanEnv (Name: PChar; var Value: PChar): longint; cdecl;
                                                  external 'DOSCALLS' index 227;
 
 function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: longint;
-                       AFileStatus: PFileStatus; FileStatusLen: longint;
-                       var Count: longint; InfoLevel: longint): longint; cdecl;
+                       AFileStatus: PFileStatus; FileStatusLen: cardinal;
+                    var Count: cardinal; InfoLevel: cardinal): longint; cdecl;
                                                  external 'DOSCALLS' index 264;
+
 function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
-                FileStatusLen: longint; var Count: longint): longint; cdecl;
+                FileStatusLen: cardinal; var Count: cardinal): longint; cdecl;
                                                  external 'DOSCALLS' index 265;
 
 function DosFindClose (Handle: longint): longint; cdecl;
@@ -283,6 +284,12 @@ begin
 end;
 
 
+Function FileCreate (Const FileName : String; Mode:longint) : Longint;
+begin
+  FileCreate:=FileCreate(FileName);
+end;
+
+
 function FileRead (Handle: longint; var Buffer; Count: longint): longint;
                                                                      assembler;
 asm
@@ -331,7 +338,7 @@ end;
 
 procedure FileClose (Handle: longint);
 begin
-    if (Handle <= 4) or (os_mode = osOS2) and (Handle <= 2) then
+    if (Handle > 4) or (os_mode = osOS2) and (Handle > 2) then
         asm
             mov eax, 3E00h
             mov ebx, Handle
@@ -410,7 +417,7 @@ function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): lo
 
 var SR: PSearchRec;
     FStat: PFileFindBuf3;
-    Count: longint;
+    Count: cardinal;
     Err: longint;
 
 begin
@@ -459,7 +466,7 @@ function FindNext (var Rslt: TSearchRec): longint;
 
 var SR: PSearchRec;
     FStat: PFileFindBuf3;
-    Count: longint;
+    Count: cardinal;
     Err: longint;
 
 begin
@@ -929,12 +936,8 @@ end;
 
 Function GetEnvironmentVariable(Const EnvVar : String) : String;
 
-var P: PChar;
-
 begin
-    if DosScanEnv (PChar (EnvVar), P) = 0
-                  then GetEnvironmentVariable := StrPas (P)
-                                             else GetEnvironmentVariable := '';
+    GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
 end;
 
 
@@ -951,19 +954,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-11-17 16:22:54  hajny
-    + RTL for emx target
-
-  Revision 1.18  2002/09/23 17:42:37  hajny
-    * AnsiString to PChar typecast
-
-  Revision 1.17  2002/09/07 16:01:25  peter
-    * old logs removed and tabs fixed
+  Revision 1.2  2003-03-23 23:11:17  hajny
+    + emx target added
 
-  Revision 1.16  2002/07/11 16:00:05  hajny
-    * FindFirst fix (invalid attribute bits masked out)
-
-  Revision 1.15  2002/01/25 16:23:03  peter
-    * merged filesearch() fix
+  Revision 1.1  2002/11/17 16:22:54  hajny
+    + RTL for emx target
 
 }