paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 02:49:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* BeOS/Haiku updates from Olivier Coursière

Browse Source 
git-svn-id: trunk@9880 -
This commit is contained in:
peter 2008-01-23 15:37:25 +00:00
parent 801837f60d
commit 73871b64ce
11 changed files with 188 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -1,5 +1,5 @@
# #
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/12/01] # Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/01/22]
# #
default: help default: help
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded
@ -338,7 +338,7 @@ BUILDOPTS=FPC=$(PPNEW) RELEASE=1
INSTALLOPTS=FPC=$(PPNEW) ZIPDESTDIR=$(BASEDIR) FPCMAKE=$(FPCMAKENEW) INSTALLOPTS=FPC=$(PPNEW) ZIPDESTDIR=$(BASEDIR) FPCMAKE=$(FPCMAKENEW)
ifndef CROSSCOMPILE ifndef CROSSCOMPILE
ifneq ($(wildcard ide),) ifneq ($(wildcard ide),)
IDETARGETS=go32v2 win32 linux freebsd os2 emx IDETARGETS=go32v2 win32 linux freebsd os2 emx beos
ifneq ($(findstring $(OS_TARGET),$(IDETARGETS)),) ifneq ($(findstring $(OS_TARGET),$(IDETARGETS)),)
IDE=1 IDE=1
endif endif

2
Makefile.fpc
View File

@ -147,7 +147,7 @@ INSTALLOPTS=FPC=$(PPNEW) ZIPDESTDIR=$(BASEDIR) FPCMAKE=$(FPCMAKENEW)
# Skipped by default for cross compiles, because it depends on libc # Skipped by default for cross compiles, because it depends on libc
ifndef CROSSCOMPILE ifndef CROSSCOMPILE
ifneq ($(wildcard ide),) ifneq ($(wildcard ide),)
IDETARGETS=go32v2 win32 linux freebsd os2 emx IDETARGETS=go32v2 win32 linux freebsd os2 emx beos
ifneq ($(findstring $(OS_TARGET),$(IDETARGETS)),) ifneq ($(findstring $(OS_TARGET),$(IDETARGETS)),)
IDE=1 IDE=1
endif endif

8
packages/base/gdbint/gdbint.pp
View File

@ -250,17 +250,17 @@ interface
{$LINKLIB bfd} {$LINKLIB bfd}
{$LINKLIB readline} {$LINKLIB readline}
{$LINKLIB opcodes} {$LINKLIB opcodes}
{$LINKLIB history} { $ LINKLIB history}
{$LINKLIB iberty} {$LINKLIB iberty}
{$LINKLIB ncurses} {$LINKLIB ncurses}
{$LINKLIB m} { $ LINKLIB m} // include in libroot under BeOS
{$LINKLIB iberty}
{$LINKLIB intl} {$LINKLIB intl}
{$ifdef GDB_USES_EXPAT_LIB} {$ifdef GDB_USES_EXPAT_LIB}
{$LINKLIB expat} {$LINKLIB expat}
{$endif GDB_USES_EXPAT_LIB} {$endif GDB_USES_EXPAT_LIB}
{ does not seem to exist on netbsd LINKLIB dl} { does not seem to exist on netbsd LINKLIB dl}
{$LINKLIB c} { $ LINKLIB c} // This is libroot under BeOS, and always linked
{$LINKLIB debug}
{$LINKLIB gcc} {$LINKLIB gcc}
{$endif beos} {$endif beos}

4
packages/base/netdb/Makefile
View File

@ -1,5 +1,5 @@
# #
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/11/08] # Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/01/22]
# #
default: all default: all
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded
@ -1648,7 +1648,7 @@ endif
endif endif
endif endif
.PHONY: fpc_units .PHONY: fpc_units
ifneq ($(TARGET_UNITS),) ifneq ($(TARGET_UNITS)$(TARGET_IMPLICITUNITS),)
override ALLTARGET+=fpc_units override ALLTARGET+=fpc_units
override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS)) override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS)) override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))

9
rtl/beos/baseunix.pp
View File

@ -139,9 +139,16 @@ begin
{$warning TODO BeOS fpFlock implementation} {$warning TODO BeOS fpFlock implementation}
end; end;
function snooze(microseconds : bigtime_t) : status_t; cdecl; external 'root' name 'snooze';
Function FpNanoSleep (req : ptimespec;rem : ptimespec):cint; Function FpNanoSleep (req : ptimespec;rem : ptimespec):cint;
begin begin
{$warning TODO BeOS FpNanoSleep implementation} case snooze((req^.tv_nsec div 1000) + (req^.tv_sec * 1000 * 1000)) of
B_OK : FpNanoSleep := 0;
B_INTERRUPTED : FpNanoSleep := - 1;
else
FpNanoSleep := - 1;
end;
end; end;
end. end.

93
rtl/beos/termios.inc
View File

@ -90,10 +90,10 @@ CONST
INLCR = $40; { map NL into CR } INLCR = $40; { map NL into CR }
IGNCR = $80; { ignore CR } IGNCR = $80; { ignore CR }
ICRNL = $100; { map CR to NL (ala CRMOD) } ICRNL = $100; { map CR to NL (ala CRMOD) }
IUCLC = $200; { maps all upper case to lower } IUCLC = $200; { maps all upper case to lower }
IXON = $400; { enable output flow control } IXON = $400; { enable output flow control }
IXANY = $800; { enable input flow control } IXANY = $800; { enable input flow control }
IXOFF = $1000; { any char will restart after stop } IXOFF = $1000; { any char will restart after stop }
{ {
* Output flags - software output processing * Output flags - software output processing
@ -188,7 +188,7 @@ CRTSCTS = RTSFLOW or CTSFLOW;
} }
ISIG = $01; { enable signals } ISIG = $01; { enable signals }
ICANON = $02; { Canonical input } ICANON = $02; { Canonical input }
XCASE = $04; { Canonical u/l case } XCASE = $04; { Canonical u/l case }
ECHO = $08; { Enable echo } ECHO = $08; { Enable echo }
ECHOE = $10; { Echo erase as bs-sp-bs } ECHOE = $10; { Echo erase as bs-sp-bs }
@ -212,19 +212,21 @@ EV_CARRIERLOST = $0008;
CONST CONST
TCSANOW =0; { make change immediate } TCSANOW = $01; { make change immediate }
TCSADRAIN =1; { drain output, then change } TCSADRAIN = $02; { drain output, then change }
TCSAFLUSH =2; { drain output, flush input } TCSAFLUSH = $04; { drain output, flush input }
TCSASOFT =$10; { flag - don't alter h.w. state }
// TCASOFT undefined under BeOS
TCSASOFT = $10; { flag - don't alter h.w. state }
TCIFLUSH =1; TCIFLUSH = $01;
TCOFLUSH =2; TCOFLUSH = $02;
TCIOFLUSH =3; TCIOFLUSH = (TCIFLUSH or TCOFLUSH);
TCOOFF =1; TCOOFF = $01;
TCOON =2; TCOON = $02;
TCIOFF =3; TCIOFF = $04;
TCION =4; TCION = $08;
{ {
#include <sys/cdefs.h> #include <sys/cdefs.h>
@ -259,7 +261,7 @@ struct winsize {
}; };
} }
IOCTLREAD = $40000000; (* IOCTLREAD = $40000000;
IOCTLWRITE = $80000000; IOCTLWRITE = $80000000;
IOCTLVOID = $20000000; IOCTLVOID = $20000000;
@ -279,19 +281,41 @@ struct winsize {
{ 8-10 compat } { 8-10 compat }
TIOCEXCL =IOCTLVOID+$7400+ 13; { set exclusive use of tty } TIOCEXCL =IOCTLVOID+$7400+ 13; { set exclusive use of tty }
TIOCNXCL =IOCTLVOID+$7400+ 14; { reset exclusive use of tty } TIOCNXCL =IOCTLVOID+$7400+ 14; { reset exclusive use of tty }
{ 15 unused } *) { 15 unused }
TIOCFLUSH =IOCTLWRITE+$47400+ 16; { flush buffers } // TIOCFLUSH =IOCTLWRITE+$47400+ 16; { flush buffers }
{ 17-18 compat } { 17-18 compat }
TIOCGETA =IOCTLREAD+$2C7400+ 19; { get termios struct } // TIOCGETA =IOCTLREAD+$2C7400+ 19; { get termios struct }
TIOCSETA =IOCTLWRITE+$2C7400+ 20; { set termios struct } // TIOCSETA =IOCTLWRITE+$2C7400+ 20; { set termios struct }
TIOCSETAW =IOCTLWRITE+$2C7400+ 21; { drain output, set } // TIOCSETAW =IOCTLWRITE+$2C7400+ 21; { drain output, set }
TIOCSETAF =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set } // TIOCSETAF =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set }
TIOCGETD =IOCTLREAD+$47400+ 26; { get line discipline } // TIOCGETD =IOCTLREAD+$47400+ 26; { get line discipline }
TIOCSETD =IOCTLWRITE+$47400+ 27; { set line discipline } // TIOCSETD =IOCTLWRITE+$47400+ 27; { set line discipline }
{ 127-124 compat } { 127-124 compat }
TIOCSBRK =IOCTLVOID+$7400+ 123; { set break bit }
// BeOS values
TIOCGETA = $8000;
TIOCSETA = TIOCGETA + 1;
TIOCSETAF = TIOCGETA + 2;
TIOCSETAW = TIOCGETA + 3;
TCWAITEVENT = TIOCGETA + 4;
TIOCSBRK = TIOCGETA + 5;
TIOCFLUSH = TIOCGETA + 6;
TCXONC = TIOCGETA + 7;
TCQUERYCONNECTED= TIOCGETA + 8;
TCGETBITS = TIOCGETA + 9;
TIOCSDTR = TIOCGETA + 10;
TCSETRTS = TIOCGETA + 11;
TIOCGWINSZ = TIOCGETA + 12;
TIOCSWINSZ = TIOCGETA + 13;
TCVTIME = TIOCGETA + 14;
// TIOCTIMESTAMP = TCVTIME;
// end BeOS values
(*
// TIOCSBRK =IOCTLVOID+$7400+ 123; { set break bit }
TIOCCBRK =IOCTLVOID+$7400+ 122; { clear break bit } TIOCCBRK =IOCTLVOID+$7400+ 122; { clear break bit }
TIOCSDTR =IOCTLVOID+$7400+ 121; { set data terminal ready } // TIOCSDTR =IOCTLVOID+$7400+ 121; { set data terminal ready }
TIOCCDTR =IOCTLVOID+$7400+ 120; { clear data terminal ready } TIOCCDTR =IOCTLVOID+$7400+ 120; { clear data terminal ready }
TIOCGPGRP =IOCTLREAD+$47400+ 119; { get pgrp of tty } TIOCGPGRP =IOCTLREAD+$47400+ 119; { get pgrp of tty }
TIOCSPGRP =IOCTLWRITE+$47400+ 118; { set pgrp of tty } TIOCSPGRP =IOCTLWRITE+$47400+ 118; { set pgrp of tty }
@ -315,8 +339,8 @@ struct winsize {
TIOCMBIC =IOCTLWRITE+$47400+ 107; { bic modem bits } TIOCMBIC =IOCTLWRITE+$47400+ 107; { bic modem bits }
TIOCMGET =IOCTLREAD+$47400+ 106; { get all modem bits } TIOCMGET =IOCTLREAD+$47400+ 106; { get all modem bits }
TIOCREMOTE =IOCTLWRITE+$47400+ 105; { remote input editing } TIOCREMOTE =IOCTLWRITE+$47400+ 105; { remote input editing }
TIOCGWINSZ =IOCTLREAD+$87400+ 104; { get window size } // TIOCGWINSZ =IOCTLREAD+$87400+ 104; { get window size }
TIOCSWINSZ =IOCTLWRITE+$87400+ 103; { set window size } // TIOCSWINSZ =IOCTLWRITE+$87400+ 103; { set window size }
TIOCUCNTL =IOCTLWRITE+$47400+ 102; { pty: set/clr usr cntl mode } TIOCUCNTL =IOCTLWRITE+$47400+ 102; { pty: set/clr usr cntl mode }
TIOCSTAT =IOCTLVOID+$7400+ 101; { simulate ^T status message } TIOCSTAT =IOCTLVOID+$7400+ 101; { simulate ^T status message }
// UIOCCMD(n) _IO('u', n) { usr cntl op "n" } // UIOCCMD(n) _IO('u', n) { usr cntl op "n" }
@ -327,8 +351,8 @@ struct winsize {
TIOCDRAIN =IOCTLVOID+$7400+ 94; { wait till output drained } TIOCDRAIN =IOCTLVOID+$7400+ 94; { wait till output drained }
TIOCMSDTRWAIT =IOCTLWRITE+$47400+ 91; { modem: set wait on close } TIOCMSDTRWAIT =IOCTLWRITE+$47400+ 91; { modem: set wait on close }
TIOCMGDTRWAIT =IOCTLREAD+$47400+ 90; { modem: get wait on close } TIOCMGDTRWAIT =IOCTLREAD+$47400+ 90; { modem: get wait on close }
TIOCTIMESTAMP =IOCTLREAD+$87400+ 89; { enable/get timestamp // TIOCTIMESTAMP =IOCTLREAD+$87400+ 89; { enable/get timestamp
* of last input event } // * of last input event }
TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp
* of last DCd rise } * of last DCd rise }
TIOCSDRAINWAIT =IOCTLWRITE+$47400+ 87; { set ttywait timeout } TIOCSDRAINWAIT =IOCTLWRITE+$47400+ 87; { set ttywait timeout }
@ -344,7 +368,7 @@ struct winsize {
// Maybe, it should not work but it compile at least... // Maybe, it should not work but it compile at least...
TIOCLINUX = $541C; TIOCLINUX = $541C;
*)
{ {
* Defaults on "first" open. * Defaults on "first" open.
} }
@ -359,7 +383,7 @@ struct winsize {
{ {
* Control Character Defaults * Control Character Defaults
} }
CtrlMask = $1f; {\037} (* CtrlMask = $1f; {\037}
CEOF =chr( ORD('d') and CtrlMask); CEOF =chr( ORD('d') and CtrlMask);
CEOL =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE } CEOL =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE }
CERASE =chr( $7F and CtrlMask); CERASE =chr( $7F and CtrlMask);
@ -382,14 +406,11 @@ struct winsize {
CBRK =CEOL; CBRK =CEOL;
CRPRNT =CREPRINT; CRPRNT =CREPRINT;
CFLUSH =CDISCARD; CFLUSH =CDISCARD;
*)
{ {
* TTYDEFCHARS to include an array of default control characters. * TTYDEFCHARS to include an array of default control characters.
} }
{ ttydefchars : array[0..NCCS-1] OF char =(
Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL),
Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP));}
ttydefchars : array[0..NCCS-1] OF char =( ttydefchars : array[0..NCCS-1] OF char =(
Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL), Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL),
Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP)); Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP));

26
rtl/beos/termiosproc.inc
View File

@ -45,13 +45,15 @@ end;
Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal); Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
begin begin
// BeOS tios.c_ispeed:=speed; {Probably the Bxxxx speed constants} // field unused under BeOS
tios.c_ixxxxx:=speed;
end; end;
Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal); Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
begin begin
// BeOS tios.c_ospeed:=speed; // field unused under BeOS
tios.c_oxxxxx:=speed;
end; end;
@ -78,36 +80,38 @@ begin
TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil); TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
end; end;
Function be_tcsetpgrp(fd, pgrpid : pid_t) : cint; cdecl; external 'root' name 'tcsetpgrp';
Function be_tcgetpgrp(fd : cint) : pid_t; cdecl; external 'root' name 'tcgetpgrp';
Function be_tcdrain(fd : cint) : cint; cdecl; external 'root' name 'tcdrain';
Function be_tcflow(fd, action : cint) : cint; cdecl; external 'root' name 'tcflow';
Function be_tcflush(fd, queue_selector : cint) : cint; cdecl; external 'root' name 'tcflush';
Function TCSetPGrp(fd,id:cint):cint; Function TCSetPGrp(fd,id:cint):cint;
begin begin
TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id)); TCSetPGrp := be_tcsetpgrp(fd, id);
end; end;
Function TCGetPGrp(fd:cint;var id:cint):cint; Function TCGetPGrp(fd:cint;var id:cint):cint;
begin begin
TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id); id := be_tcgetpgrp(fd);
end; end;
Function TCDrain(fd:cint):cint; Function TCDrain(fd:cint):cint;
begin begin
TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?} TCDrain := be_tcdrain(fd);
end; end;
Function TCFlow(fd,act:cint):cint; Function TCFlow(fd,act:cint):cint;
begin begin
case act OF TCFlow := be_tcflow(fd, act);
TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,nil);
TCIOFF : {N/I}
end;
end; end;
Function TCFlush(fd,qsel:cint):cint; Function TCFlush(fd,qsel:cint):cint;
begin begin
TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel)); TCFlush := be_tcflush(fd, qsel);
end; end;
Function BeOSIsATTY (Handle:cint):cint; cdecl; external 'root' name 'isatty'; Function BeOSIsATTY (Handle:cint):cint; cdecl; external 'root' name 'isatty';

114
rtl/inc/exeinfo.pp
View File

@ -662,9 +662,8 @@ end;
{$ENDIF EMX} {$ENDIF EMX}
{$if defined(ELF32) or defined(ELF64)} {$if defined(ELF32) or defined(BEOS)}
type type
{$ifdef ELF32}
telfheader=packed record telfheader=packed record
magic0123 : longint; magic0123 : longint;
file_class : byte; file_class : byte;
@ -697,8 +696,9 @@ type
sh_addralign : longword; sh_addralign : longword;
sh_entsize : longword; sh_entsize : longword;
end; end;
{$endif ELF32} {$endif ELF32 or BEOS}
{$ifdef ELF64} {$ifdef ELF64}
type
telfheader=packed record telfheader=packed record
magic0123 : longint; magic0123 : longint;
file_class : byte; file_class : byte;
@ -719,6 +719,7 @@ type
e_shnum : word; // 0..e_shnum-1 of entrys e_shnum : word; // 0..e_shnum-1 of entrys
e_shstrndx : word; // index of string section header e_shstrndx : word; // index of string section header
end; end;
type
telfsechdr=packed record telfsechdr=packed record
sh_name : longword; sh_name : longword;
sh_type : longword; sh_type : longword;
@ -733,6 +734,8 @@ type
end; end;
{$endif ELF64} {$endif ELF64}
{$if defined(ELF32) or defined(ELF64) or defined(BEOS)}
function OpenElf(var e:TExeFile):boolean; function OpenElf(var e:TExeFile):boolean;
var var
elfheader : telfheader; elfheader : telfheader;
@ -756,6 +759,7 @@ begin
result:=true; result:=true;
end; end;
function FindSectionElf(var e:TExeFile;const asecname:string;out secofs,seclen:longint):boolean; function FindSectionElf(var e:TExeFile;const asecname:string;out secofs,seclen:longint):boolean;
var var
elfsec : telfsechdr; elfsec : telfsechdr;
@ -784,16 +788,13 @@ begin
end; end;
end; end;
end; end;
{$endif ELF32} {$endif ELF32 or ELF64 or BEOS}
{$ifdef beos} {$ifdef beos}
{$i ptypes.inc} {$i ptypes.inc}
{ ------------------------- Images --------------------------- }
type type
// Descriptive formats // Descriptive formats
status_t = Longint; status_t = Longint;
@ -832,103 +833,24 @@ type
function get_next_image_info(team: team_id; var cookie:longint; var info:image_info; size: size_t) : status_t;cdecl; external 'root' name '_get_next_image_info'; function get_next_image_info(team: team_id; var cookie:longint; var info:image_info; size: size_t) : status_t;cdecl; external 'root' name '_get_next_image_info';
function LoadElf32Beos:boolean; function OpenElf32Beos(var e:TExeFile):boolean;
type
telf32header=packed record
magic0123 : longint;
file_class : byte;
data_encoding : byte;
file_version : byte;
padding : array[$07..$0f] of byte;
e_type : word;
e_machine : word;
e_version : longword;
e_entry : longword; // entrypoint
e_phoff : longword; // program header offset
e_shoff : longword; // sections header offset
e_flags : longword;
e_ehsize : word; // elf header size in bytes
e_phentsize : word; // size of an entry in the program header array
e_phnum : word; // 0..e_phnum-1 of entrys
e_shentsize : word; // size of an entry in sections header array
e_shnum : word; // 0..e_shnum-1 of entrys
e_shstrndx : word; // index of string section header
end;
telf32sechdr=packed record
sh_name : longword;
sh_type : longword;
sh_flags : longword;
sh_addr : longword;
sh_offset : longword;
sh_size : longword;
sh_link : longword;
sh_info : longword;
sh_addralign : longword;
sh_entsize : longword;
end;
var var
elfheader : telf32header;
elfsec : telf32sechdr;
secnames : array[0..255] of char;
pname : pchar;
i : longint;
cookie : longint; cookie : longint;
info : image_info; info : image_info;
result : status_t;
begin begin
// The only BeOS specific part is setting the processaddress
cookie := 0; cookie := 0;
fillchar(info, sizeof(image_info), 0); fillchar(info, sizeof(image_info), 0);
get_next_image_info(0,cookie,info,sizeof(info)); get_next_image_info(0,cookie,info,sizeof(info));
if (info._type = B_APP_IMAGE) then if (info._type = B_APP_IMAGE) then
processaddress := cardinal(info.text) e.processaddress := cardinal(info.text)
else else
processaddress := 0; e.processaddress := 0;
LoadElf32Beos:=false; Result := OpenElf(e);
stabofs:=-1;
stabstrofs:=-1;
{ read and check header }
if E.Size<sizeof(telf32header) then
exit;
blockread(f,elfheader,sizeof(telf32header));
{$ifdef ENDIAN_LITTLE}
if elfheader.magic0123<>$464c457f then
exit;
{$endif ENDIAN_LITTLE}
{$ifdef ENDIAN_BIG}
if elfheader.magic0123<>$7f454c46 then
exit;
{$endif ENDIAN_BIG}
if elfheader.e_shentsize<>sizeof(telf32sechdr) then
exit;
{ read section names }
seek(f,elfheader.e_shoff+elfheader.e_shstrndx*cardinal(sizeof(telf32sechdr)));
blockread(f,elfsec,sizeof(telf32sechdr));
seek(f,elfsec.sh_offset);
blockread(f,secnames,sizeof(secnames));
{ read section info }
seek(f,elfheader.e_shoff);
for i:=1to elfheader.e_shnum do
begin
blockread(f,elfsec,sizeof(telf32sechdr));
pname:=@secnames[elfsec.sh_name];
if (pname[4]='b') and
(pname[1]='s') and
(pname[2]='t') then
begin
if (pname[5]='s') and
(pname[6]='t') then
stabstrofs:=elfsec.sh_offset
else
begin
stabofs:=elfsec.sh_offset;
stabcnt:=elfsec.sh_size div sizeof(tstab);
end;
end;
end;
LoadElf32Beos:=(stabofs<>-1) and (stabstrofs<>-1);
end; end;
{$endif beos} {$endif beos}
{$ifdef darwin} {$ifdef darwin}
type type
MachoFatHeader= MachoFatHeader=
@ -1097,11 +1019,11 @@ const
{$if defined(ELF32) or defined(ELF64)} {$if defined(ELF32) or defined(ELF64)}
openproc : @OpenElf; openproc : @OpenElf;
findproc : @FindSectionElf; findproc : @FindSectionElf;
{$endif} {$endif ELF32 or ELF64}
{$ifdef Beos} {$ifdef BEOS}
openproc : @OpenElf32Beos; openproc : @OpenElf32Beos;
findproc : @FindSectionElf32Beos; findproc : @FindSectionElf;
{$endif} {$endif BEOS}
{$ifdef darwin} {$ifdef darwin}
openproc : @OpenMachO32PPC; openproc : @OpenMachO32PPC;
findproc : @FindSectionMachO32PPC; findproc : @FindSectionMachO32PPC;

5
rtl/inc/system.inc
View File

@ -92,10 +92,15 @@ function do_isdevice(handle:thandle):boolean;forward;
****************************************************************************} ****************************************************************************}
{$ifdef FPC_USE_LIBC} {$ifdef FPC_USE_LIBC}
{ Under Haiku, bcopy cause a problem when searching for include file
in the compiler. So, we use the internal implementation for now
under BeOS and Haiku. }
{$ifndef BEOS}
{ prefer libc implementations over our own, as they're most likely faster } { prefer libc implementations over our own, as they're most likely faster }
{$i cgeneric.inc} {$i cgeneric.inc}
{ is now declared as external reference to another routine in the interface } { is now declared as external reference to another routine in the interface }
{$i cgenstr.inc} {$i cgenstr.inc}
{$endif}
{$endif FPC_USE_LIBC} {$endif FPC_USE_LIBC}
{$ifdef cpui386} {$ifdef cpui386}

24
rtl/unix/convert.inc
View File

@ -46,3 +46,27 @@ const convert_linuxlowascii_to_vga:array[#0..#31] of word=(
$00ad,$00b1,$f879,$00be,$00b6,$00a7,$00f7,$00b8, { $f0..$f7 } $00ad,$00b1,$f879,$00be,$00b6,$00a7,$00f7,$00b8, { $f0..$f7 }
$00b0,$00a8,$00b7,$00b9,$00b3,$00b2,$002a,$00a0 { $f8..$ff } $00b0,$00a8,$00b7,$00b9,$00b3,$00b2,$002a,$00a0 { $f8..$ff }
); );
convert_lowascii_to_UTF8:array[#0..#31] of WideChar=(
#0000,#9786,#9787,#9829,#9830,#9827,#9824,#8226,
#9688,#9675,#9689,#9794,#9792,#9834,#9835,#9788,
#9658,#9668,#8597,#8252,#0182,#0167,#9644,#8616,
#8593,#8595,#8594,#8592,#8735,#8596,#9650,#9660
);
convert_cp437_to_UTF8:array[#128..#255] of WideChar=(
#0199,#0252,#0233,#0226,#0228,#0224,#0229,#0231, { $80..$87 }
#0234,#0235,#0232,#0239,#0238,#0236,#0196,#0197, { $88..$8f }
#0201,#0230,#0198,#0244,#0246,#0242,#0251,#0249, { $90..$97 }
#0255,#0214,#0220,#0162,#0163,#0165,#8359,#0402, { $98..$9f }
#0225,#0237,#0243,#0250,#0241,#0209,#0170,#0186, { $a0..$a7 }
#0191,#8976,#0172,#0189,#0188,#0161,#0171,#0187, { $a8..$af }
#9617,#9618,#9619,#9474,#9508,#9569,#9570,#9558, { $b0..$b7 }
#9557,#9571,#9553,#9559,#9565,#9564,#9563,#9488, { $b8..$bf }
#9492,#9524,#9516,#9500,#9472,#9532,#9566,#9567, { $c0..$c7 }
#9562,#9556,#9577,#9574,#9568,#9552,#9580,#9575, { $c8..$cf }
#9576,#9572,#9573,#9561,#9560,#9554,#9555,#9579, { $d0..$d7 }
#9578,#9496,#9484,#9608,#9604,#9612,#9616,#9600, { $d8..$df }
#0945,#0223,#0915,#0960,#0931,#0963,#0181,#0964, { $e0..$e7 }
#0934,#0920,#0937,#0948,#8734,#0966,#0949,#8745, { $e8..$ef }
#8801,#0177,#8805,#8804,#8992,#8993,#0247,#8776, { $f0..$f7 }
#0176,#8729,#0183,#8730,#8319,#0178,#9632,#0160 { $f8..$ff }
);

58
rtl/unix/video.pp
View File

@ -71,7 +71,8 @@ type Tconsole_type=(ttyNetwork
Tconversion=(cv_none, Tconversion=(cv_none,
cv_cp437_to_iso01, cv_cp437_to_iso01,
cv_cp850_to_iso01, cv_cp850_to_iso01,
cv_linuxlowascii_to_vga); cv_linuxlowascii_to_vga,
cv_cp437_to_UTF8);
Ttermcode=( Ttermcode=(
enter_alt_charset_mode, enter_alt_charset_mode,
@ -174,8 +175,21 @@ const term_codes_ansi:Ttermcodes=
#$1B#$5B#$3F#$37#$6C, {exit_am_mode} #$1B#$5B#$3F#$37#$6C, {exit_am_mode}
#$1B#$28#$42#$1B#$29#$30); {ena_acs} #$1B#$28#$42#$1B#$29#$30); {ena_acs}
term_codes_beos:Ttermcodes=
(nil,//#$0E, {enter_alt_charset_mode}
nil,//#$0F, {exit_alt_charset_mode}
#$1B#$5B#$48#$1B#$5B#$4A, {clear_screen}
#$1B#$5B#$48, {cursor_home}
#$1B'[?25h',// nil,//#$1B#$5B#$3F#$31#$32#$6C#$1B#$5B#$3F#$32#$35#$68, {cursor_normal}
nil,//#$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68, {cursor visible, underline}
nil,//#$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68, {cursor visible, block}
#$1B'[?25l',//nil,//#$1B#$5B#$3F#$32#$35#$6C, {cursor_invisible}
nil,//#$1B#$5B#$3F#$31#$30#$34#$39#$68, {enter_ca_mode}
nil,//#$1B#$5B#$3F#$31#$30#$34#$39#$6C, {exit_ca_mode}
nil,//#$1B#$5B#$3F#$37#$6C, {exit_am_mode}
nil);//#$1B#$28#$42#$1B#$29#$30); {ena_acs}
const terminal_names:array[0..10] of string[7]=( const terminal_names:array[0..11] of string[7]=(
'ansi', 'ansi',
'cons', 'cons',
'eterm', 'eterm',
@ -186,8 +200,9 @@ const terminal_names:array[0..10] of string[7]=(
'screen', 'screen',
'vt100', 'vt100',
'vt220', 'vt220',
'xterm'); 'xterm',
terminal_data:array[0..10] of Ptermcodes=( 'beterm');
terminal_data:array[0..11] of Ptermcodes=(
@term_codes_ansi, @term_codes_ansi,
@term_codes_freebsd, @term_codes_freebsd,
@term_codes_xterm, @term_codes_xterm,
@ -198,7 +213,8 @@ const terminal_names:array[0..10] of string[7]=(
@term_codes_xterm, @term_codes_xterm,
@term_codes_vt100, @term_codes_vt100,
@term_codes_vt220, @term_codes_vt220,
@term_codes_xterm); @term_codes_xterm,
@term_codes_beos);
const convert:Tconversion=cv_none; const convert:Tconversion=cv_none;
@ -285,7 +301,6 @@ begin
end; end;
end; end;
procedure SendEscapeSeqNdx(ndx:Ttermcode); procedure SendEscapeSeqNdx(ndx:Ttermcode);
var p:PChar; var p:PChar;
@ -596,6 +611,32 @@ var
end; end;
end; end;
function transform_cp437_to_UTF8(const st:string): string;
var i:byte;
c : char;
converted : WideChar;
s : WideString;
begin
transform_cp437_to_UTF8 := '';
for i:=1 to length(st) do
begin
c:=st[i];
case c of
#0..#31:
converted:=convert_lowascii_to_UTF8[c];
#128..#255:
converted:=convert_cp437_to_UTF8[c];
else
begin
converted := #0;
converted := c;
end;
end;
s := s + converted;
end;
transform_cp437_to_UTF8 := Utf8Encode(s);
end;
function transform(const hstr:string):string; function transform(const hstr:string):string;
begin begin
@ -606,6 +647,8 @@ var
transform:=transform_cp437_to_iso01(hstr); transform:=transform_cp437_to_iso01(hstr);
cv_cp850_to_iso01: cv_cp850_to_iso01:
transform:=transform_cp850_to_iso01(hstr); transform:=transform_cp850_to_iso01(hstr);
cv_cp437_to_UTF8:
transform:=transform_cp437_to_UTF8(hstr);
else else
transform:=hstr; transform:=hstr;
end; end;
@ -935,6 +978,9 @@ begin
437 in the hope that the actual font has similarity to codepage 437.} 437 in the hope that the actual font has similarity to codepage 437.}
internal_codepage:=cp437; internal_codepage:=cp437;
end; end;
{$ifdef BEOS}
convert := cv_cp437_to_UTF8;
{$endif}
end; end;