diff --git a/compiler/compiler.pas b/compiler/compiler.pas index 13f438fe1b..7f34495e23 100644 --- a/compiler/compiler.pas +++ b/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) diff --git a/compiler/comprsrc.pas b/compiler/comprsrc.pas index 918c0851b2..eda6b9575a 100644 --- a/compiler/comprsrc.pas +++ b/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 diff --git a/compiler/gendef.pas b/compiler/gendef.pas index cc4da6eb1a..11d4bca633 100644 --- a/compiler/gendef.pas +++ b/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 diff --git a/compiler/globals.pas b/compiler/globals.pas index affe3d87f2..d82720a1a8 100644 --- a/compiler/globals.pas +++ b/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 diff --git a/compiler/msg/errord.msg b/compiler/msg/errord.msg index 883c98cd56..b5d82744eb 100644 --- a/compiler/msg/errord.msg +++ b/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_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_Ausgabe Format: 6*2Aas_Unix o-Datei mit Hilfe von GNU AS 6*2Agas_GNU Motorola Assembler diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index 74fc7a8a37..0f1cfd5000 100644 --- a/compiler/msg/errore.msg +++ b/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_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_Win32 target options +3*2TWDOSX_WDOSX DOS extender +3*2TWIN32_Windows 32 Bit +3*1W_Win32-like target options 3*2WB_Set Image base to Hexadecimal value 3*2WC_Specify console type application 3*2WD_Use DEFFILE to export functions of DLL or EXE diff --git a/compiler/msg/errores.msg b/compiler/msg/errores.msg index dc4f7f4578..7515775b3d 100644 --- a/compiler/msg/errores.msg +++ b/compiler/msg/errores.msg @@ -1870,8 +1870,8 @@ option_help_pages=11025_[ 3*1T_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_formato de salida 6*2Aas_Unix o-file usando GNU AS 6*2Agas_Ensamblador GNU Motorola diff --git a/compiler/msg/errorf.msg b/compiler/msg/errorf.msg index 48b4dcfd8c..bb240c02a9 100644 --- a/compiler/msg/errorf.msg +++ b/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_systКme d'explioitation cible : +3*1T_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_output format 6*2Aas_Unix o-file using GNU AS 6*2Agas_GNU Motorola assembler diff --git a/compiler/msg/errorn.msg b/compiler/msg/errorn.msg index 151db22b1e..0e421deb9a 100644 --- a/compiler/msg/errorn.msg +++ b/compiler/msg/errorn.msg @@ -1900,8 +1900,8 @@ option_help_pages=11025_[ 6*1T_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_Win32 Doel opties 3*2WB_Stel Image base in op (hexadecimale) waarde 3*2WC_Maak een console applicatie diff --git a/compiler/msg/errorr.msg b/compiler/msg/errorr.msg index 6e31528198..2b60324d22 100644 --- a/compiler/msg/errorr.msg +++ b/compiler/msg/errorr.msg @@ -1980,8 +1980,8 @@ option_help_pages=11025_[ 3*1T_тип операционная системы, для кото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_Win32 опции 3*1WB_ Установка Image базы в шестнадцетиричное значение 3*1WC_ Определить, что это будет консольное приложение diff --git a/compiler/msg/errorrw.msg b/compiler/msg/errorrw.msg index 7f628b6736..54a07e968c 100644 --- a/compiler/msg/errorrw.msg +++ b/compiler/msg/errorrw.msg @@ -1980,8 +1980,8 @@ option_help_pages=11025_[ 3*1T_Єшя юяхЁрЎшюээр  ёшёЄхь√, фы  ъюЄю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_Win32 юяЎшш 3*1WB_ ╙ёЄрэютър Image срч√ т °хёЄэрфЎхЄшЁшўэюх чэрўхэшх 3*1WC_ ╬яЁхфхышЄ№, ўЄю ¤Єю сєфхЄ ъюэёюы№эюх яЁшыюцхэшх diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index c8f63a707d..2284d436f0 100644 --- a/compiler/msgidx.inc +++ b/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, diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index 5388b1ac30..6f1ecd6278 100644 --- a/compiler/msgtxt.inc +++ b/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_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_Win32',' target options'#010+ + '3*2TWDOS','X_WDOSX DOS extender'#010+ + '3*2TWIN32_Windows 32 Bit'#010+ + '3*1W_Win32-like target options'#010+ '3*2WB_Set Image base to Hexadecimal 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_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_assembler reading style:'#010+ '6*2RMOT_read motorola style assembler'#010+ '6*1T_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 ); diff --git a/compiler/options.pas b/compiler/options.pas index 5ca01de166..31b938e672 100644 --- a/compiler/options.pas +++ b/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 diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 8947784b9b..bc2949034c 100644 --- a/compiler/pdecsub.pas +++ b/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 diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index c4c170be65..5874157599 100644 --- a/compiler/pmodules.pas +++ b/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 diff --git a/compiler/scandir.pas b/compiler/scandir.pas index ce8139cf28..8ac1dfcccc 100644 --- a/compiler/scandir.pas +++ b/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 diff --git a/compiler/systems.pas b/compiler/systems.pas index 9da990a336..7f06fcd35d 100644 --- a/compiler/systems.pas +++ b/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 diff --git a/compiler/systems/i_emx.pas b/compiler/systems/i_emx.pas new file mode 100644 index 0000000000..ade07e095a --- /dev/null +++ b/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 + +} diff --git a/compiler/systems/t_emx.pas b/compiler/systems/t_emx.pas new file mode 100644 index 0000000000..87b81e7b1a --- /dev/null +++ b/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 + . +} +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='!'#10; + ar_magic:array[1..length(armag)] of char=armag;} +const ar_magic:array[1..8] of char='!'#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, 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 + + +} diff --git a/fcl/Makefile.fpc b/fcl/Makefile.fpc index 8f2936521f..43631c1ca9 100644 --- a/fcl/Makefile.fpc +++ b/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] diff --git a/packages/extra/Makefile.fpc b/packages/extra/Makefile.fpc index e5302d31f4..281d529ead 100644 --- a/packages/extra/Makefile.fpc +++ b/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 diff --git a/rtl/Makefile.fpc b/rtl/Makefile.fpc index 5b76968eff..d8db68977b 100644 --- a/rtl/Makefile.fpc +++ b/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 diff --git a/rtl/emx/Makefile.fpc b/rtl/emx/Makefile.fpc index bd9c7da12e..faf84f14db 100644 --- a/rtl/emx/Makefile.fpc +++ b/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 diff --git a/rtl/emx/crt.pas b/rtl/emx/crt.pas new file mode 100644 index 0000000000..21c329797f --- /dev/null +++ b/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 d.s.p.mantione@twi.tudelft.nl} + + {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 (ilo(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 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 + Revision 1.2 2003-03-23 23:11:17 hajny + + emx target added + + 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.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 - }