mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 15:47:53 +02:00
+ emx target added
This commit is contained in:
parent
504571d024
commit
8e7124f9f8
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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_ Ž¯à¥¤¥«¨âì, çâ® íâ® ¡ã¤¥â ª®á®«ì®¥ ¯à¨«®¦¥¨¥
|
||||
|
@ -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_ Определить, что это будет консольное приложение
|
||||
|
@ -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,
|
||||
|
@ -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
|
||||
);
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
compiler/systems/i_emx.pas
Normal file
123
compiler/systems/i_emx.pas
Normal file
@ -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
compiler/systems/t_emx.pas
Normal file
523
compiler/systems/t_emx.pas
Normal file
@ -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
|
||||
<d.s.p.mantione@twi.tudelft.nl>.
|
||||
}
|
||||
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
|
||||
|
||||
|
||||
}
|
@ -39,6 +39,7 @@ includedir_netbsd=unix
|
||||
includedir_openbsd=unix
|
||||
includedir_sunos=posix
|
||||
includedir_qnx=posix
|
||||
includedir_emx=os2
|
||||
sourcedir=$(OS_TARGET) inc
|
||||
|
||||
[libs]
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
rtl/emx/crt.pas
Normal file
901
rtl/emx/crt.pas
Normal file
@ -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 (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
|
||||
|
||||
|
||||
}
|
@ -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
|
||||
|
||||
}
|
||||
|
@ -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)
|
||||
|
||||
}
|
||||
|
@ -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
|
||||
|
||||
}
|
||||
|
@ -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
|
||||
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
|
||||
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user