FP 2.3.1 (SVN 8373)

git-svn-id: svn://kolibrios.org@619 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
bw 2007-09-04 13:23:24 +00:00
parent d01af144cb
commit 6c47c845cb
8 changed files with 114 additions and 62 deletions

View File

@ -1,3 +1,18 @@
Codepage: koi8-r Codepage: koi8-r
Комментарии будут позже. Текущий код адаптирован и проверялся только на FreePascal 2.3.1 (SVN 8373) при
компиляции из Windows.
Для компилирования версии RTL для KolibriOS вам необходимо иметь установленный
у себя FreePascal с исходными кодами RTL указанной выше версии. Откройте файл
rtl/build.bat и укажите в переменной окружения FPRTL точный путь к исходному
коду оригинальной RTL. Например, если FreePascal установлен в c:\fp, то
вероятнее всего исходный код находится в c:\fp\src\rtl. Этот путь и нужно
указать. Предпологается что иерархия директорий исходников FreePascal сохранена
точно такой же как в репозитарии FreePascal'я.
После изменения rtl/build.bat запустите этот командный файл на выполнение. После
завершения работы этого файла в папке ./units должны появить модули и объектные
файлы RTL.
Как теперь собирать программы я опишу позже.

View File

@ -1,6 +1,6 @@
@echo off @echo off
set FPRTL={path to original freepascal rtl source code, example ... \fp\src\rtl} set FPRTL={FreePascal RTL source code, example c:\fp\src\rtl}
set INCS=-Fi%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas;%FPRTL%\objpas\sysutils;%FPRTL%\objpas\classes set INCS=-Fi%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas;%FPRTL%\objpas\sysutils;%FPRTL%\objpas\classes
set UNTS=-Fu%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas set UNTS=-Fu%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas
set FPCARGS=-Twin32 -Se5 -Sg -n -O3pPENTIUM3 -CfSSE -di386 -FU..\units %INCS% %UNTS% set FPCARGS=-Twin32 -Se5 -Sg -n -O3pPENTIUM3 -CfSSE -di386 -FU..\units %INCS% %UNTS%

View File

@ -1,9 +1,80 @@
unit Dos; unit Dos;
interface interface
{$i filerec.inc}
type
SearchRec = record
{FindHandle : THandle;
WinFindData : TWinFindData;
ExcludeAttr : longint;}
Time : longint;
Size : longint;
Attr : longint;
Name : string;
end;
{$i dosh.inc}
implementation implementation
procedure Intr(intno: byte; var regs: registers); begin end;
procedure MSDos(var regs: registers); begin end;
function DosVersion: Word; begin end;
procedure GetDate(var year, month, mday, wday: word); begin end;
procedure GetTime(var hour, minute, second, sec100: word); begin end;
procedure SetDate(year,month,day: word); begin end;
procedure SetTime(hour,minute,second,sec100: word); begin end;
procedure UnpackTime(p: longint; var t: datetime); begin end;
procedure PackTime(var t: datetime; var p: longint); begin end;
procedure Exec(const path: pathstr; const comline: comstr); begin end;
function DosExitCode: word; begin end;
function DiskFree(drive: byte) : int64; begin end;
function DiskSize(drive: byte) : int64; begin end;
procedure FindFirst(const path: pathstr; attr: word; var f: searchRec); begin end;
procedure FindNext(var f: searchRec); begin end;
procedure FindClose(Var f: SearchRec); begin end;
procedure GetFAttr(var f; var attr: word); begin end;
procedure GetFTime(var f; var time: longint); begin end;
function FSearch(path: pathstr; dirlist: string): pathstr; begin end;
function FExpand(const path: pathstr): pathstr; begin end;
procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr); begin end;
function GetShortName(var p : String) : boolean; begin end;
function GetLongName(var p : String) : boolean; begin end;
function EnvCount: longint; begin end;
function EnvStr (Index: longint): string; begin end;
function GetEnv(envvar: string): string; begin end;
procedure SetFAttr(var f; attr: word); begin end;
procedure SetFTime(var f; time: longint); begin end;
procedure GetCBreak(var breakvalue: boolean); begin end;
procedure SetCBreak(breakvalue: boolean); begin end;
procedure GetVerify(var verify: boolean); begin end;
procedure SetVerify(verify: boolean); begin end;
procedure SwapVectors; begin end;
procedure GetIntVec(intno: byte; var vector: pointer); begin end;
procedure SetIntVec(intno: byte; vector: pointer); begin end;
procedure Keep(exitcode: word); begin end;
function GetMsCount: int64; begin end;
end. end.

View File

@ -161,6 +161,22 @@ end;
{ Graphics } { Graphics }
function kos_screensize(): TKosPoint; assembler; register;
asm
pushl %eax
pushl %ecx
pushl %eax
movl $14, %eax
int $0x40
movswl %ax, %ecx
popl %ebx
shrl $16, %eax
movl %ecx, TKosPoint.Y(%ebx)
movl %eax, TKosPoint.X(%ebx)
popl %ecx
popl %eax
end;
procedure kos_begindraw(); assembler; register; procedure kos_begindraw(); assembler; register;
asm asm
pushl %ebx pushl %ebx

View File

@ -114,8 +114,7 @@ begin
while not Console^.FTerminate do while not Console^.FTerminate do
begin begin
Event := kos_getevent(); Event := kos_getevent();
if Console^.FTerminate then if not Console^.FTerminate then
{Console^.ProcessMessage('[CONSOLE] Terminate...'#13#10)} else
case Event of case Event of
SE_PAINT: Console^.Paint(); SE_PAINT: Console^.Paint();
SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey()); SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey());
@ -146,23 +145,21 @@ begin
FOpened := False; FOpened := False;
FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE; FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE;
FIPCBuffer := GetMem(FIPCBufferSize); FIPCBuffer := GetMem(FIPCBufferSize);
{FIPCBufferSize := SizeOf(KonsoleIPCBuffer);
FIPCBuffer := @KonsoleIPCBuffer;}
FIPCBuffer^.Lock := False; FIPCBuffer^.Lock := False;
FIPCBuffer^.Size := 0; FIPCBuffer^.Size := 0;
FThreadSlot := -1; FThreadSlot := -1;
FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self); FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self);
if FThreadID <> 0 then if FThreadID <> 0 then
while not FOpened do kos_delay(1); {XXX: ¬®¦¥â § ¢¨á­ãâì}
while not FOpened do ThreadSwitch;
end; end;
destructor TKonsole.Done(); destructor TKonsole.Done();
begin begin
FTerminate := True; FTerminate := True;
Self.Write(#0); if FOpened then begin Self.Write(#0); kos_delay(01); end;
if FOpened then kos_delay(1); if FOpened then begin Self.Write(#0); kos_delay(10); end;
if FOpened then kos_delay(10); if FOpened then begin Self.Write(#0); kos_delay(20); end;
if FOpened then kos_delay(20);
if FOpened then if FOpened then
begin begin
FOpened := False; FOpened := False;
@ -345,7 +342,7 @@ begin
{XXX: ¢®§¬®¦­  á¨âã æ¨ï ¯à¨ ª®â®à®© á®®¡é¥­¨¥ ­¥ ¡ã¤¥â ®â¯à ¢«¥­®} {XXX: ¢®§¬®¦­  á¨âã æ¨ï ¯à¨ ª®â®à®© á®®¡é¥­¨¥ ­¥ ¡ã¤¥â ®â¯à ¢«¥­®}
if FOpened then if FOpened then
begin begin
I := 20; I := 100;
while (kos_sendmsg(FThreadID, @Message[1], Length(Message)) = 2) and (I > 0) do while (kos_sendmsg(FThreadID, @Message[1], Length(Message)) = 2) and (I > 0) do
begin begin
Dec(I); Dec(I);

View File

@ -26,6 +26,7 @@ procedure kos_maskevents(mask: DWord);
procedure kos_setcaption(caption: PChar); procedure kos_setcaption(caption: PChar);
{ Graphics } { Graphics }
function kos_screensize(): TKosPoint;
procedure kos_begindraw(); procedure kos_begindraw();
procedure kos_enddraw(); procedure kos_enddraw();
procedure kos_putpixel(x, y: Word; color: DWord = $000000); procedure kos_putpixel(x, y: Word; color: DWord = $000000);
@ -168,8 +169,6 @@ type
path : PChar; path : PChar;
end; end;
{var
KonsoleIPCBuffer: array[0..4096] of Byte;}
type type
PKonsole = ^TKonsole; PKonsole = ^TKonsole;

View File

@ -146,10 +146,6 @@ type
Stack: Pointer; Stack: Pointer;
end; end;
procedure DoneThread;
begin
SysReleaseThreadVars;
end;
procedure ThreadMain(ThreadInfo: PThreadInfo); procedure ThreadMain(ThreadInfo: PThreadInfo);
var var
@ -291,45 +287,6 @@ begin
end; end;
{$ifndef HAS_MT_MEMORYMANAGER}
var
HeapMutex: TRTLCriticalSection;
procedure KosHeapMutexInit;
begin
InitCriticalSection(HeapMutex);
end;
procedure KosHeapMutexDone;
begin
DoneCriticalSection(HeapMutex);
end;
procedure KosHeapMutexLock;
begin
EnterCriticalSection(HeapMutex);
end;
procedure KosHeapMutexUnlock;
begin
LeaveCriticalSection(HeapMutex);
end;
const
KosMemoryMutexManager: TMemoryMutexManager = (
MutexInit: @KosHeapMutexInit;
MutexDone: @KosHeapMutexDone;
MutexLock: @KosHeapMutexLock;
MutexUnlock: @KosHeapMutexUnlock);
procedure InitHeapMutexes;
begin
SetMemoryMutexManager(KosMemoryMutexManager);
end;
{$endif HAS_MT_MEMORYMANAGER}
var var
KosThreadManager: TThreadManager; KosThreadManager: TThreadManager;
@ -379,8 +336,5 @@ begin
SemaphorePost := @NoSemaphorePost; SemaphorePost := @NoSemaphorePost;
end; end;
SetThreadManager(KosThreadManager); SetThreadManager(KosThreadManager);
{$ifndef HAS_MT_MEMORYMANAGER}
InitHeapMutexes;
{$endif HAS_MT_MEMORYMANAGER}
ThreadID := GetCurrentThreadID; ThreadID := GetCurrentThreadID;
end; end;

View File

@ -161,7 +161,7 @@ begin
ReleaseFileRecord(Handle); ReleaseFileRecord(Handle);
end; end;
function FileTruncate(Handle: THandle; Size: Longint): Boolean; function FileTruncate(Handle: THandle; Size: Int64): Boolean;
begin begin
Result := False; Result := False;
end; end;