mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-25 04:00:48 +01:00
+ emx target added
This commit is contained in:
Tomas Hajny
parent
504571d024
commit
8e7124f9f8
@ -164,7 +164,11 @@ uses
|
|||||||
,i_nwm
|
,i_nwm
|
||||||
{$endif nwm}
|
{$endif nwm}
|
||||||
{$ifdef os2}
|
{$ifdef os2}
|
||||||
|
{$ifdef emx}
|
||||||
|
,i_emx
|
||||||
|
{$else emx}
|
||||||
,i_os2
|
,i_os2
|
||||||
|
{$endif emx}
|
||||||
{$endif os2}
|
{$endif os2}
|
||||||
{$ifdef palmos}
|
{$ifdef palmos}
|
||||||
,i_palmos
|
,i_palmos
|
||||||
@ -386,7 +390,10 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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)
|
* Several bugfixes for m68k target (register alloc., opcode emission)
|
||||||
+ VIS target
|
+ VIS target
|
||||||
+ Generic add more complete (still not verified)
|
+ Generic add more complete (still not verified)
|
||||||
|
|||||||
@ -134,7 +134,7 @@ var
|
|||||||
hr : presourcefile;
|
hr : presourcefile;
|
||||||
begin
|
begin
|
||||||
{ OS/2 (EMX) must be processed elsewhere (in the linking/binding stage). }
|
{ 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
|
While not current_module.ResourceFiles.Empty do
|
||||||
begin
|
begin
|
||||||
case target_info.system of
|
case target_info.system of
|
||||||
@ -154,7 +154,10 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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)
|
* path fix (merged)
|
||||||
|
|
||||||
Revision 1.16 2003/01/12 15:42:23 peter
|
Revision 1.16 2003/01/12 15:42:23 peter
|
||||||
|
|||||||
@ -113,7 +113,7 @@ begin
|
|||||||
exit;
|
exit;
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
case target_info.system of
|
case target_info.system of
|
||||||
system_i386_Os2 :
|
system_i386_Os2, system_i386_emx:
|
||||||
begin
|
begin
|
||||||
write(t,'NAME '+inputfile);
|
write(t,'NAME '+inputfile);
|
||||||
if usewindowapi then
|
if usewindowapi then
|
||||||
@ -160,7 +160,10 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* rewrote the system handling
|
||||||
|
|
||||||
Revision 1.10 2002/05/18 13:34:08 peter
|
Revision 1.10 2002/05/18 13:34:08 peter
|
||||||
|
|||||||
@ -496,7 +496,8 @@ implementation
|
|||||||
begin
|
begin
|
||||||
{ these operating systems have dos type drives }
|
{ these operating systems have dos type drives }
|
||||||
if source_info.system in [system_m68k_atari,system_i386_go32v2,
|
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
|
Begin
|
||||||
if (Length(f)=3) and (F[2]=':') and (F[3] in ['/','\']) then
|
if (Length(f)=3) and (F[2]=':') and (F[3] in ['/','\']) then
|
||||||
begin
|
begin
|
||||||
@ -1526,7 +1527,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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)
|
* amiga path fix (merged)
|
||||||
|
|
||||||
Revision 1.82 2003/01/12 15:42:23 peter
|
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*3Op2_Optimierungen f<>r Pentium/PentiumMMX (R)
|
||||||
3*3Op3_Optimierungen f<>r PPro/PII/c6x86/K6 (R)
|
3*3Op3_Optimierungen f<>r PPro/PII/c6x86/K6 (R)
|
||||||
3*1T<x>_Ziel-Betriebssystem
|
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*2TGO32V2_Version 2 von DJ Delorie's DOS extender
|
||||||
3*2TLINUX_Linux
|
3*2TLINUX_Linux
|
||||||
3*2TOS2_OS/2 2.x
|
3*2TNETWARE_Novell Netware Module (experimental)
|
||||||
3*2TWin32_Windows 32 Bit
|
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*1A<x>_Ausgabe Format:
|
||||||
6*2Aas_Unix o-Datei mit Hilfe von GNU AS
|
6*2Aas_Unix o-Datei mit Hilfe von GNU AS
|
||||||
6*2Agas_GNU Motorola Assembler
|
6*2Agas_GNU Motorola Assembler
|
||||||
|
|||||||
@ -2109,14 +2109,15 @@ option_help_pages=11025_[
|
|||||||
3*3Op2_set target processor to Pentium/PentiumMMX (tm)
|
3*3Op2_set target processor to Pentium/PentiumMMX (tm)
|
||||||
3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)
|
3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)
|
||||||
3*1T<x>_Target operating system:
|
3*1T<x>_Target operating system:
|
||||||
3*2TGO32V2_version 2 of DJ Delorie DOS extender
|
3*2TEMX_OS/2 via EMX (including EMX/RSX extender)
|
||||||
3*2TWDOSX DOS 32 Bit Extender
|
3*2TGO32V2_Version 2 of DJ Delorie DOS extender
|
||||||
3*2TLINUX_Linux
|
3*2TLINUX_Linux
|
||||||
3*2Tnetware_Novell Netware Module (experimental)
|
3*2TNETWARE_Novell Netware Module (experimental)
|
||||||
3*2TOS2_OS/2 2.x
|
3*2TOS2_OS/2 / eComStation
|
||||||
3*2TSUNOS_SunOS/Solaris
|
3*2TSUNOS_SunOS/Solaris
|
||||||
3*2TWin32_Windows 32 Bit
|
3*2TWDOSX_WDOSX DOS extender
|
||||||
3*1W<x>_Win32 target options
|
3*2TWIN32_Windows 32 Bit
|
||||||
|
3*1W<x>_Win32-like target options
|
||||||
3*2WB<x>_Set Image base to Hexadecimal <x> value
|
3*2WB<x>_Set Image base to Hexadecimal <x> value
|
||||||
3*2WC_Specify console type application
|
3*2WC_Specify console type application
|
||||||
3*2WD_Use DEFFILE to export functions of DLL or EXE
|
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*1T<x>_Sistema operativo de destino
|
||||||
3*2TGO32V2_versi¢n 2 del extensor del DOS de DJ Delorie
|
3*2TGO32V2_versi¢n 2 del extensor del DOS de DJ Delorie
|
||||||
3*2TLINUX_Linux
|
3*2TLINUX_Linux
|
||||||
3*2TOS2_OS/2 2.x
|
3*2TOS2_OS/2
|
||||||
3*2TWin32_Windows 32 Bit
|
3*2TWIN32_Windows 32 Bit
|
||||||
6*1A<x>_formato de salida
|
6*1A<x>_formato de salida
|
||||||
6*2Aas_Unix o-file usando GNU AS
|
6*2Aas_Unix o-file usando GNU AS
|
||||||
6*2Agas_Ensamblador GNU Motorola
|
6*2Agas_Ensamblador GNU Motorola
|
||||||
|
|||||||
@ -1853,11 +1853,15 @@ option_help_pages=11025_[
|
|||||||
3*3Op1_d‚finit 386/486 comme processeur cible
|
3*3Op1_d‚finit 386/486 comme processeur cible
|
||||||
3*3Op2_d‚finit Pentium/PentiumMMX (tm) comme processeur cycle
|
3*3Op2_d‚finit Pentium/PentiumMMX (tm) comme processeur cycle
|
||||||
3*3Op3_d‚finit PPro/PII/c6x86/K6 (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*2TGO32V2_version 2 de l'extension DOS de DJ Delorie
|
||||||
3*2TLINUX_Linux
|
3*2TLINUX_Linux
|
||||||
3*2TOS2_OS/2 2.x
|
3*2TNETWARE_Novell Netware Module (experimental)
|
||||||
3*2TWin32_Windows 32 Bits
|
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*1A<x>_output format
|
||||||
6*2Aas_Unix o-file using GNU AS
|
6*2Aas_Unix o-file using GNU AS
|
||||||
6*2Agas_GNU Motorola assembler
|
6*2Agas_GNU Motorola assembler
|
||||||
|
|||||||
@ -1900,8 +1900,8 @@ option_help_pages=11025_[
|
|||||||
6*1T<x>_Doel besturingssysteem:
|
6*1T<x>_Doel besturingssysteem:
|
||||||
3*2TGO32V2_version 2 of DJ Delorie DOS extender
|
3*2TGO32V2_version 2 of DJ Delorie DOS extender
|
||||||
3*2TLINUX_Linux
|
3*2TLINUX_Linux
|
||||||
3*2TOS2_OS/2 2.x
|
3*2TOS2_OS/2 / eComStation
|
||||||
3*2TWin32_Windows 32 Bit
|
3*2TWIN32_Windows 32 Bit
|
||||||
3*1W<x>_Win32 Doel opties
|
3*1W<x>_Win32 Doel opties
|
||||||
3*2WB<x>_Stel Image base in op (hexadecimale) waarde <x>
|
3*2WB<x>_Stel Image base in op (hexadecimale) waarde <x>
|
||||||
3*2WC_Maak een console applicatie
|
3*2WC_Maak een console applicatie
|
||||||
|
|||||||
@ -1980,8 +1980,8 @@ option_help_pages=11025_[
|
|||||||
3*1T<x>_⨯ ®¯¥à 樮 ï á¨á⥬ë, ¤«ï ª®â®p®© ¯p®¨á室¨â ª®¬¯¨«ïæ¨ï:
|
3*1T<x>_⨯ ®¯¥à 樮 ï á¨á⥬ë, ¤«ï ª®â®p®© ¯p®¨á室¨â ª®¬¯¨«ïæ¨ï:
|
||||||
3*2TGO32V2_version 2 (DJ Delorie à áè¨à¨â¥«ì DOS)
|
3*2TGO32V2_version 2 (DJ Delorie à áè¨à¨â¥«ì DOS)
|
||||||
3*2TLINUX_Linux
|
3*2TLINUX_Linux
|
||||||
3*2TOS2_OS/2 2.x
|
3*2TOS2_OS/2 / eComStation
|
||||||
3*2TWin32_Windows 32 Bit
|
3*2TWIN32_Windows 32 Bit
|
||||||
3*1W<x>_Win32 ®¯æ¨¨
|
3*1W<x>_Win32 ®¯æ¨¨
|
||||||
3*1WB<x>_ “áâ ®¢ª Image ¡ §ë ¢ è¥áâ ¤æ¥â¨à¨ç®¥ <x> § 票¥
|
3*1WB<x>_ “áâ ®¢ª Image ¡ §ë ¢ è¥áâ ¤æ¥â¨à¨ç®¥ <x> § 票¥
|
||||||
3*1WC_ Ž¯à¥¤¥«¨âì, çâ® íâ® ¡ã¤¥â ª®á®«ì®¥ ¯à¨«®¦¥¨¥
|
3*1WC_ Ž¯à¥¤¥«¨âì, çâ® íâ® ¡ã¤¥â ª®á®«ì®¥ ¯à¨«®¦¥¨¥
|
||||||
|
|||||||
@ -1980,8 +1980,8 @@ option_help_pages=11025_[
|
|||||||
3*1T<x>_тип операционная системы, для котоpой пpоисходит компиляция:
|
3*1T<x>_тип операционная системы, для котоpой пpоисходит компиляция:
|
||||||
3*2TGO32V2_version 2 (DJ Delorie расширитель DOS)
|
3*2TGO32V2_version 2 (DJ Delorie расширитель DOS)
|
||||||
3*2TLINUX_Linux
|
3*2TLINUX_Linux
|
||||||
3*2TOS2_OS/2 2.x
|
3*2TOS2_OS/2 / eComStation
|
||||||
3*2TWin32_Windows 32 Bit
|
3*2TWIN32_Windows 32 Bit
|
||||||
3*1W<x>_Win32 опции
|
3*1W<x>_Win32 опции
|
||||||
3*1WB<x>_ Установка Image базы в шестнадцетиричное <x> значение
|
3*1WB<x>_ Установка Image базы в шестнадцетиричное <x> значение
|
||||||
3*1WC_ Определить, что это будет консольное приложение
|
3*1WC_ Определить, что это будет консольное приложение
|
||||||
|
|||||||
@ -608,7 +608,7 @@ const
|
|||||||
option_info=11024;
|
option_info=11024;
|
||||||
option_help_pages=11025;
|
option_help_pages=11025;
|
||||||
|
|
||||||
MsgTxtSize = 34382;
|
MsgTxtSize = 34446;
|
||||||
|
|
||||||
MsgIdxMax : array[1..20] of longint=(
|
MsgIdxMax : array[1..20] of longint=(
|
||||||
17,62,195,50,57,44,98,19,35,43,
|
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*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
|
||||||
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
|
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
|
||||||
'3*1T<x>_Target ','operating system:'#010+
|
'3*1T<x>_Target ','operating system:'#010+
|
||||||
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+
|
'3*2TEMX_OS/2 via EMX (including EMX/RSX extender)'#010+
|
||||||
'3*2TWDOSX DOS 32 Bit Extender'#010+
|
'3*2TGO32V2_Version 2 of DJ Delorie DOS extender'#010+
|
||||||
'3*2TLINUX_Linux'#010+
|
'3*2TLINUX_Linux'#010+
|
||||||
'3*2Tnetware_Novell Netware Module (experimental)'#010+
|
'3*2TNETWARE_Novell Netware Module (experimental)'#010+
|
||||||
'3*2TOS2_OS/2 2.x'#010+
|
'3*2TOS2_OS/2 / eComStation'#010+
|
||||||
'3*2TSUNOS_SunOS/Solaris'#010+
|
'3*2TSUNOS_SunOS/Solaris'#010+
|
||||||
'3*2TWin32_Windows 32 Bit'#010+
|
'3*2TWDOS','X_WDOSX DOS extender'#010+
|
||||||
'3*1W<x>_Win32',' target options'#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*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
|
||||||
'3*2WC_Specify console type application'#010+
|
'3*2WC_Specify console type application'#010+
|
||||||
'3*2WD_Use DEFFILE to export functions of DLL or EXE'#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*2WF_Specify full-s','creen type application (OS/2 only)'#010+
|
||||||
'3*2WG_Specify graphic type ap','plication'#010+
|
'3*2WG_Specify graphic type application'#010+
|
||||||
'3*2WN_Do not generate relocation code (necessary for debugging)'#010+
|
'3*2WN_Do not generate relocation code (necessary for debugging)'#010+
|
||||||
'3*2WR_Generate relocation code'#010+
|
'3*2WR_Generate relocation code'#010+
|
||||||
'6*1A<x>_output format'#010+
|
'6*1A<x>_output format'#010+
|
||||||
'6*2Aas_Unix o-file using GNU AS'#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*2Amit_MIT Syntax (old GAS)'#010+
|
||||||
'6*2Amot_Standard Moto','rola assembler'#010+
|
'6*2Amot_Standard Motorola assembler'#010+
|
||||||
'6*1O_optimizations:'#010+
|
'6*1O_optimizations:'#010+
|
||||||
'6*2Oa_turn on the optimizer'#010+
|
'6*2Oa_turn on the optimizer'#010+
|
||||||
'6*2Og_generate smaller code'#010+
|
'6*2Og_generate smaller code'#010+
|
||||||
'6*2OG_generate faster code (default)'#010+
|
'6*2OG_generate faster code (default)'#010+
|
||||||
'6*2Ox_optimize maximum (still BUGGY!!!)'#010+
|
'6*2Ox_optimize maximum (still BUGGY!!!)'#010+
|
||||||
'6*2O0_set target processor to a MC68000'#010+
|
'6*2O0_se','t target processor to a MC68000'#010+
|
||||||
'6*2O2_set target processor to a ','MC68020+ (default)'#010+
|
'6*2O2_set target processor to a MC68020+ (default)'#010+
|
||||||
'6*1R<x>_assembler reading style:'#010+
|
'6*1R<x>_assembler reading style:'#010+
|
||||||
'6*2RMOT_read motorola style assembler'#010+
|
'6*2RMOT_read motorola style assembler'#010+
|
||||||
'6*1T<x>_Target operating system:'#010+
|
'6*1T<x>_Target operating system:'#010+
|
||||||
'6*2TAMIGA_Commodore Amiga'#010+
|
'6*2TAMIGA_Commodore Amiga'#010+
|
||||||
'6*2TATARI_Atari ST/STe/TT'#010+
|
'6*2TATARI_Atari ST/STe/TT'#010+
|
||||||
'6*2TMACOS_Macintosh m68k'#010+
|
'6','*2TMACOS_Macintosh m68k'#010+
|
||||||
'6*2TLINUX_Linux-68k'#010+
|
'6*2TLINUX_Linux-68k'#010+
|
||||||
'6*2TPALMOS_PalmOS'#010+
|
'6*2TPALMOS_PalmOS'#010+
|
||||||
'**','1*_'#010+
|
'**1*_'#010+
|
||||||
'**1?_shows this help'#010+
|
'**1?_shows this help'#010+
|
||||||
'**1h_shows this help without waiting'#000
|
'**1h_shows this help without waiting'#000
|
||||||
);
|
);
|
||||||
|
|||||||
@ -1033,7 +1033,12 @@ begin
|
|||||||
'D':
|
'D':
|
||||||
ForceDeffileForExport:=not UnsetBool(More, j);
|
ForceDeffileForExport:=not UnsetBool(More, j);
|
||||||
'F':
|
'F':
|
||||||
apptype:=app_fs;
|
begin
|
||||||
|
if UnsetBool(More, j) then
|
||||||
|
apptype:=app_cui
|
||||||
|
else
|
||||||
|
apptype:=app_fs;
|
||||||
|
end;
|
||||||
'G':
|
'G':
|
||||||
begin
|
begin
|
||||||
if UnsetBool(More, j) then
|
if UnsetBool(More, j) then
|
||||||
@ -1048,7 +1053,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
'R':
|
'R':
|
||||||
begin
|
begin
|
||||||
{ support -WR+ / -WR- as synonims to -WR / -WN }
|
{ support -WR+ / -WR- as synonyms to -WR / -WN }
|
||||||
RelocSection:=not UnsetBool(More,j);
|
RelocSection:=not UnsetBool(More,j);
|
||||||
RelocSectionSetExplicitly:=true;
|
RelocSectionSetExplicitly:=true;
|
||||||
end;
|
end;
|
||||||
@ -1893,7 +1898,10 @@ finalization
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ $define newra will enable new register allocator
|
||||||
+ getregisterint will return imaginary registers with $newra
|
+ getregisterint will return imaginary registers with $newra
|
||||||
+ -sr switch added, will skip register allocation so you can see
|
+ -sr switch added, will skip register allocation so you can see
|
||||||
|
|||||||
@ -844,8 +844,8 @@ begin
|
|||||||
Message(parser_e_methods_dont_be_export);
|
Message(parser_e_methods_dont_be_export);
|
||||||
if lexlevel<>normal_function_level then
|
if lexlevel<>normal_function_level then
|
||||||
Message(parser_e_dont_nest_export);
|
Message(parser_e_dont_nest_export);
|
||||||
{ only os/2 needs this }
|
{ only os/2 and emx need this }
|
||||||
if target_info.system=system_i386_os2 then
|
if target_info.system in [system_i386_os2,system_i386_emx] then
|
||||||
begin
|
begin
|
||||||
aktprocdef.aliasnames.insert(aktprocsym.realname);
|
aktprocdef.aliasnames.insert(aktprocsym.realname);
|
||||||
procinfo.exported:=true;
|
procinfo.exported:=true;
|
||||||
@ -2123,7 +2123,10 @@ const
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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]
|
* only allow class [procedure|function]
|
||||||
|
|
||||||
Revision 1.107 2003/03/17 18:56:02 peter
|
Revision 1.107 2003/03/17 18:56:02 peter
|
||||||
|
|||||||
@ -362,7 +362,7 @@ implementation
|
|||||||
;
|
;
|
||||||
{$endif x86_64}
|
{$endif x86_64}
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
system_i386_OS2:
|
system_i386_OS2,system_i386_EMX:
|
||||||
;
|
;
|
||||||
{$endif i386}
|
{$endif i386}
|
||||||
{$ifdef powerpc}
|
{$ifdef powerpc}
|
||||||
@ -1444,7 +1444,10 @@ So, all parameters are passerd into registers in sparc architecture.}
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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 ***
|
*** empty log message ***
|
||||||
|
|
||||||
Revision 1.97 2003/03/17 13:36:39 peter
|
Revision 1.97 2003/03/17 13:36:39 peter
|
||||||
|
|||||||
@ -181,8 +181,8 @@ implementation
|
|||||||
var
|
var
|
||||||
hs : string;
|
hs : string;
|
||||||
begin
|
begin
|
||||||
if (target_info.system<>system_i386_win32)
|
if not (target_info.system in [system_i386_win32,system_i386_os2,
|
||||||
and (target_info.system<>system_i386_os2) then
|
system_i386_emx]) then
|
||||||
Message(scan_w_app_type_not_support);
|
Message(scan_w_app_type_not_support);
|
||||||
if not current_module.in_global then
|
if not current_module.in_global then
|
||||||
Message(scan_w_switch_is_global)
|
Message(scan_w_switch_is_global)
|
||||||
@ -194,7 +194,8 @@ implementation
|
|||||||
apptype:=app_gui
|
apptype:=app_gui
|
||||||
else if hs='CONSOLE' then
|
else if hs='CONSOLE' then
|
||||||
apptype:=app_cui
|
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
|
apptype:=app_fs
|
||||||
else
|
else
|
||||||
Message1(scan_w_unsupported_app_type,hs);
|
Message1(scan_w_unsupported_app_type,hs);
|
||||||
@ -236,7 +237,8 @@ implementation
|
|||||||
|
|
||||||
procedure dir_description;
|
procedure dir_description;
|
||||||
begin
|
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);
|
Message(scan_w_description_not_support);
|
||||||
{ change description global var in all cases }
|
{ change description global var in all cases }
|
||||||
{ it not used but in win32, os2 and netware }
|
{ it not used but in win32, os2 and netware }
|
||||||
@ -763,7 +765,8 @@ implementation
|
|||||||
major, minor, revision : longint;
|
major, minor, revision : longint;
|
||||||
error : integer;
|
error : integer;
|
||||||
begin
|
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
|
begin
|
||||||
Message(scan_n_version_not_support);
|
Message(scan_n_version_not_support);
|
||||||
exit;
|
exit;
|
||||||
@ -980,7 +983,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* OBJECTCHECKS added, equivalent of -CR
|
||||||
* WRITEABLECONST added, equivalent of $J
|
* WRITEABLECONST added, equivalent of $J
|
||||||
|
|
||||||
|
|||||||
@ -109,7 +109,8 @@ interface
|
|||||||
target_i386_openbsd, { 24 }
|
target_i386_openbsd, { 24 }
|
||||||
target_m68k_openbsd, { 25 }
|
target_m68k_openbsd, { 25 }
|
||||||
system_x86_64_linux, { 26 }
|
system_x86_64_linux, { 26 }
|
||||||
system_powerpc_macosx { 27 }
|
system_powerpc_macosx, { 27 }
|
||||||
|
system_i386_EMX { 28 }
|
||||||
);
|
);
|
||||||
|
|
||||||
tasm = (as_none
|
tasm = (as_none
|
||||||
@ -678,7 +679,10 @@ finalization
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* m68k pathexist update from 1.0.x
|
||||||
* palmos res 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_openbsd=unix
|
||||||
includedir_sunos=posix
|
includedir_sunos=posix
|
||||||
includedir_qnx=posix
|
includedir_qnx=posix
|
||||||
|
includedir_emx=os2
|
||||||
sourcedir=$(OS_TARGET) inc
|
sourcedir=$(OS_TARGET) inc
|
||||||
|
|
||||||
[libs]
|
[libs]
|
||||||
|
|||||||
@ -22,6 +22,7 @@ dirs_openbsd=unzip uncgi \
|
|||||||
dirs_win32=unzip uncgi opengl gtk \
|
dirs_win32=unzip uncgi opengl gtk \
|
||||||
zlib mmsystem tcl cdrom fpgtk
|
zlib mmsystem tcl cdrom fpgtk
|
||||||
dirs_os2=unzip uncgi zlib os2units rexx x11 gtk 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_go32v2=unzip uncgi
|
||||||
dirs_netware=cmem zlib
|
dirs_netware=cmem zlib
|
||||||
|
|
||||||
|
|||||||
@ -12,6 +12,7 @@ dirs_win32=win32
|
|||||||
dirs_go32v2=go32v2
|
dirs_go32v2=go32v2
|
||||||
dirs_go32v1=go32v1
|
dirs_go32v1=go32v1
|
||||||
dirs_os2=os2
|
dirs_os2=os2
|
||||||
|
dirs_emx=emx
|
||||||
dirs_freebsd=freebsd
|
dirs_freebsd=freebsd
|
||||||
dirs_beos=beos
|
dirs_beos=beos
|
||||||
dirs_amiga=amiga
|
dirs_amiga=amiga
|
||||||
|
|||||||
@ -9,7 +9,7 @@ main=rtl
|
|||||||
loaders=prt0 prt1
|
loaders=prt0 prt1
|
||||||
units=$(SYSTEMUNIT) objpas strings \
|
units=$(SYSTEMUNIT) objpas strings \
|
||||||
ports os2def doscalls moncalls kbdcalls moucalls viocalls \
|
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 \
|
dos crt objects printer \
|
||||||
sysutils math typinfo varutils \
|
sysutils math typinfo varutils \
|
||||||
charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs \
|
charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs \
|
||||||
@ -28,8 +28,8 @@ target=emx
|
|||||||
cpu=i386
|
cpu=i386
|
||||||
|
|
||||||
[compiler]
|
[compiler]
|
||||||
includedir=$(INC) $(PROCINC) ../os2
|
includedir=$(INC) $(PROCINC) $(OS2INC)
|
||||||
sourcedir=$(INC) $(PROCINC) ../os2
|
sourcedir=$(INC) $(PROCINC) $(OS2INC)
|
||||||
targetdir=.
|
targetdir=.
|
||||||
|
|
||||||
|
|
||||||
@ -37,6 +37,7 @@ targetdir=.
|
|||||||
RTL=..
|
RTL=..
|
||||||
INC=$(RTL)/inc
|
INC=$(RTL)/inc
|
||||||
PROCINC=$(RTL)/$(CPU_TARGET)
|
PROCINC=$(RTL)/$(CPU_TARGET)
|
||||||
|
OS2INC=$(RTL)/os2
|
||||||
|
|
||||||
UNITPREFIX=rtl
|
UNITPREFIX=rtl
|
||||||
|
|
||||||
@ -102,31 +103,31 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
|
|||||||
|
|
||||||
ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
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)
|
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)
|
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
|
#graph$(PPUEXT) : graph.pp
|
||||||
|
|
||||||
@ -160,8 +161,8 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
|
|||||||
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
|
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
|
||||||
|
|
||||||
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
|
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
|
||||||
$(OBJPASDIR)/varutilh.inc varutils.pp
|
$(OBJPASDIR)/varutilh.inc $(OS2INC)/varutils.pp
|
||||||
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
|
$(COMPILER) -I$(OBJPASDIR) $(OS2INC)/varutils.pp $(REDIR)
|
||||||
|
|
||||||
types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||||
$(COMPILER) $(OBJPASDIR)/types.pp
|
$(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;
|
const comline:comstr):longint;
|
||||||
function envcount:longint;
|
function envcount:longint;
|
||||||
function envstr(index:longint) : string;
|
function envstr(index:longint) : string;
|
||||||
|
function GetEnvPChar (EnvVar: string): PChar;
|
||||||
function getenv(const envvar:string): string;
|
function getenv(const envvar:string): string;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -846,7 +847,7 @@ procedure FindFirst (const Path: PathStr; Attr: word; var F: SearchRec);
|
|||||||
|
|
||||||
|
|
||||||
var path0: array[0..255] of char;
|
var path0: array[0..255] of char;
|
||||||
Count: longint;
|
Count: cardinal;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{No error.}
|
{No error.}
|
||||||
@ -854,9 +855,9 @@ begin
|
|||||||
if os_mode = osOS2 then
|
if os_mode = osOS2 then
|
||||||
begin
|
begin
|
||||||
New (F.FStat);
|
New (F.FStat);
|
||||||
F.Handle := $FFFFFFFF;
|
F.Handle := longint ($FFFFFFFF);
|
||||||
Count := 1;
|
Count := 1;
|
||||||
DosError := Integer(DosFindFirst (Path, F.Handle,
|
DosError := integer (DosFindFirst (Path, F.Handle,
|
||||||
Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
|
Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
|
||||||
Count, ilStandard));
|
Count, ilStandard));
|
||||||
if (DosError = 0) and (Count = 0) then DosError := 18;
|
if (DosError = 0) and (Count = 0) then DosError := 18;
|
||||||
@ -883,7 +884,7 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
procedure FindNext (var F: SearchRec);
|
procedure FindNext (var F: SearchRec);
|
||||||
var Count: longint;
|
var Count: cardinal;
|
||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -893,7 +894,8 @@ begin
|
|||||||
if os_mode = osOS2 then
|
if os_mode = osOS2 then
|
||||||
begin
|
begin
|
||||||
Count := 1;
|
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;
|
if (DosError = 0) and (Count = 0) then DosError := 18;
|
||||||
end else _findnext (F);
|
end else _findnext (F);
|
||||||
DosSearchRec2SearchRec (F);
|
DosSearchRec2SearchRec (F);
|
||||||
@ -932,18 +934,17 @@ begin
|
|||||||
envstr:=strpas(hp);
|
envstr:=strpas(hp);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetEnv (const EnvVar: string): string;
|
function GetEnvPChar (EnvVar: string): PChar;
|
||||||
(* The assembler version is more than three times as fast as Pascal. *)
|
(* The assembler version is more than three times as fast as Pascal. *)
|
||||||
var
|
var
|
||||||
P: PChar;
|
P: PChar;
|
||||||
_EnvVar: string;
|
|
||||||
begin
|
begin
|
||||||
_EnvVar := UpCase (EnvVar);
|
EnvVar := UpCase (EnvVar);
|
||||||
{$ASMMODE INTEL}
|
{$ASMMODE INTEL}
|
||||||
asm
|
asm
|
||||||
cld
|
cld
|
||||||
mov edi, Environment
|
mov edi, Environment
|
||||||
lea esi, _EnvVar
|
lea esi, EnvVar
|
||||||
xor eax, eax
|
xor eax, eax
|
||||||
lodsb
|
lodsb
|
||||||
@NewVar:
|
@NewVar:
|
||||||
@ -988,7 +989,14 @@ begin
|
|||||||
mov P, edi { place pointer to variable contents in P }
|
mov P, edi { place pointer to variable contents in P }
|
||||||
@End:
|
@End:
|
||||||
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;
|
end;
|
||||||
{$ASMMODE ATT}
|
{$ASMMODE ATT}
|
||||||
|
|
||||||
@ -1153,7 +1161,8 @@ var
|
|||||||
ptr : pchar;
|
ptr : pchar;
|
||||||
base : pchar;
|
base : pchar;
|
||||||
i: integer;
|
i: integer;
|
||||||
tib : pprocessinfoblock;
|
PIB: PProcessInfoBlock;
|
||||||
|
TIB: PThreadInfoBlock;
|
||||||
begin
|
begin
|
||||||
{ We need to setup the environment }
|
{ We need to setup the environment }
|
||||||
{ only in the case of OS/2 }
|
{ only in the case of OS/2 }
|
||||||
@ -1162,8 +1171,8 @@ begin
|
|||||||
exit;
|
exit;
|
||||||
cnt := 0;
|
cnt := 0;
|
||||||
{ count number of environment pointers }
|
{ count number of environment pointers }
|
||||||
dosgetinfoblocks (nil, PPProcessInfoBlock (@tib));
|
DosGetInfoBlocks (PPThreadInfoBlock (@TIB), PPProcessInfoBlock (@PIB));
|
||||||
ptr := pchar(tib^.env);
|
ptr := pchar(PIB^.env);
|
||||||
{ stringz,stringz...,#0 }
|
{ stringz,stringz...,#0 }
|
||||||
i := 0;
|
i := 0;
|
||||||
repeat
|
repeat
|
||||||
@ -1180,7 +1189,7 @@ begin
|
|||||||
{ got count of environment strings }
|
{ got count of environment strings }
|
||||||
GetMem(envp, cnt*sizeof(pchar)+16384);
|
GetMem(envp, cnt*sizeof(pchar)+16384);
|
||||||
cnt := 0;
|
cnt := 0;
|
||||||
ptr := pchar(tib^.env);
|
ptr := pchar(PIB^.env);
|
||||||
i:=0;
|
i:=0;
|
||||||
repeat
|
repeat
|
||||||
envp[cnt] := ptr;
|
envp[cnt] := ptr;
|
||||||
@ -1213,22 +1222,13 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* GetEnv fix merged from os2 target
|
||||||
|
|
||||||
Revision 1.1 2002/11/17 16:22:53 hajny
|
Revision 1.1 2002/11/17 16:22:53 hajny
|
||||||
+ RTL for emx target
|
+ 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
|
interface
|
||||||
|
|
||||||
{Link the startup code.}
|
{Link the startup code.}
|
||||||
{$l prt1.oo2}
|
{$ifdef VER1_0}
|
||||||
|
{$l prt1.oo2}
|
||||||
|
{$else}
|
||||||
|
{$l prt1.o}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
{$I systemh.inc}
|
{$I systemh.inc}
|
||||||
|
|
||||||
@ -589,9 +593,9 @@ begin
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
Action := Action or (Flags and $FF);
|
Action := Action or (Flags and $FF);
|
||||||
(* DenyAll if sharing not specified. *)
|
(* DenyNone if sharing not specified. *)
|
||||||
if Flags and 112 = 0 then
|
if Flags and 112 = 0 then
|
||||||
Action := Action or 16;
|
Action := Action or 64;
|
||||||
asm
|
asm
|
||||||
movl $0x7f2b, %eax
|
movl $0x7f2b, %eax
|
||||||
movl Action, %ecx
|
movl Action, %ecx
|
||||||
@ -1237,7 +1241,10 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* First_Meg fixed + Environment initialization under Dos
|
||||||
|
|
||||||
Revision 1.2 2002/11/17 22:32:05 hajny
|
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
|
Revision 1.1 2002/11/17 16:22:54 hajny
|
||||||
+ RTL for emx target
|
+ 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.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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)
|
* type corrections (longing x cardinal)
|
||||||
|
|
||||||
Revision 1.1 2002/11/17 16:45:35 hajny
|
Revision 1.1 2002/11/17 16:45:35 hajny
|
||||||
@ -392,4 +395,3 @@ end.
|
|||||||
* threads unit added for thread support
|
* threads unit added for thread support
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -192,11 +192,12 @@ function DosScanEnv (Name: PChar; var Value: PChar): longint; cdecl;
|
|||||||
external 'DOSCALLS' index 227;
|
external 'DOSCALLS' index 227;
|
||||||
|
|
||||||
function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: longint;
|
function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: longint;
|
||||||
AFileStatus: PFileStatus; FileStatusLen: longint;
|
AFileStatus: PFileStatus; FileStatusLen: cardinal;
|
||||||
var Count: longint; InfoLevel: longint): longint; cdecl;
|
var Count: cardinal; InfoLevel: cardinal): longint; cdecl;
|
||||||
external 'DOSCALLS' index 264;
|
external 'DOSCALLS' index 264;
|
||||||
|
|
||||||
function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
|
function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
|
||||||
FileStatusLen: longint; var Count: longint): longint; cdecl;
|
FileStatusLen: cardinal; var Count: cardinal): longint; cdecl;
|
||||||
external 'DOSCALLS' index 265;
|
external 'DOSCALLS' index 265;
|
||||||
|
|
||||||
function DosFindClose (Handle: longint): longint; cdecl;
|
function DosFindClose (Handle: longint): longint; cdecl;
|
||||||
@ -283,6 +284,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function FileCreate (Const FileName : String; Mode:longint) : Longint;
|
||||||
|
begin
|
||||||
|
FileCreate:=FileCreate(FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function FileRead (Handle: longint; var Buffer; Count: longint): longint;
|
function FileRead (Handle: longint; var Buffer; Count: longint): longint;
|
||||||
assembler;
|
assembler;
|
||||||
asm
|
asm
|
||||||
@ -331,7 +338,7 @@ end;
|
|||||||
|
|
||||||
procedure FileClose (Handle: longint);
|
procedure FileClose (Handle: longint);
|
||||||
begin
|
begin
|
||||||
if (Handle <= 4) or (os_mode = osOS2) and (Handle <= 2) then
|
if (Handle > 4) or (os_mode = osOS2) and (Handle > 2) then
|
||||||
asm
|
asm
|
||||||
mov eax, 3E00h
|
mov eax, 3E00h
|
||||||
mov ebx, Handle
|
mov ebx, Handle
|
||||||
@ -410,7 +417,7 @@ function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): lo
|
|||||||
|
|
||||||
var SR: PSearchRec;
|
var SR: PSearchRec;
|
||||||
FStat: PFileFindBuf3;
|
FStat: PFileFindBuf3;
|
||||||
Count: longint;
|
Count: cardinal;
|
||||||
Err: longint;
|
Err: longint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -459,7 +466,7 @@ function FindNext (var Rslt: TSearchRec): longint;
|
|||||||
|
|
||||||
var SR: PSearchRec;
|
var SR: PSearchRec;
|
||||||
FStat: PFileFindBuf3;
|
FStat: PFileFindBuf3;
|
||||||
Count: longint;
|
Count: cardinal;
|
||||||
Err: longint;
|
Err: longint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -929,12 +936,8 @@ end;
|
|||||||
|
|
||||||
Function GetEnvironmentVariable(Const EnvVar : String) : String;
|
Function GetEnvironmentVariable(Const EnvVar : String) : String;
|
||||||
|
|
||||||
var P: PChar;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if DosScanEnv (PChar (EnvVar), P) = 0
|
GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
|
||||||
then GetEnvironmentVariable := StrPas (P)
|
|
||||||
else GetEnvironmentVariable := '';
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -951,19 +954,10 @@ end.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ 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