From 6c47c845cb1462e033d3c1f6f01887ef19515c10 Mon Sep 17 00:00:00 2001 From: bw Date: Tue, 4 Sep 2007 13:23:24 +0000 Subject: [PATCH] FP 2.3.1 (SVN 8373) git-svn-id: svn://kolibrios.org@619 a494cfbc-eb01-0410-851d-a64ba20cac60 --- programs/develop/fp/readme-ru.txt | 17 ++++++- programs/develop/fp/rtl/build.bat | 2 +- programs/develop/fp/rtl/dos.pp | 73 ++++++++++++++++++++++++++- programs/develop/fp/rtl/kos.inc | 16 ++++++ programs/develop/fp/rtl/kos_stdio.inc | 17 +++---- programs/develop/fp/rtl/kosh.inc | 3 +- programs/develop/fp/rtl/systhrd.inc | 46 ----------------- programs/develop/fp/rtl/sysutils.pp | 2 +- 8 files changed, 114 insertions(+), 62 deletions(-) diff --git a/programs/develop/fp/readme-ru.txt b/programs/develop/fp/readme-ru.txt index 39c0b48b54..c18f2c3bf6 100644 --- a/programs/develop/fp/readme-ru.txt +++ b/programs/develop/fp/readme-ru.txt @@ -1,3 +1,18 @@ 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. + +Как теперь собирать программы я опишу позже. diff --git a/programs/develop/fp/rtl/build.bat b/programs/develop/fp/rtl/build.bat index 4e24db7df5..0d23f565df 100644 --- a/programs/develop/fp/rtl/build.bat +++ b/programs/develop/fp/rtl/build.bat @@ -1,6 +1,6 @@ @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 UNTS=-Fu%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas set FPCARGS=-Twin32 -Se5 -Sg -n -O3pPENTIUM3 -CfSSE -di386 -FU..\units %INCS% %UNTS% diff --git a/programs/develop/fp/rtl/dos.pp b/programs/develop/fp/rtl/dos.pp index c7c0857b64..6683a7ece6 100644 --- a/programs/develop/fp/rtl/dos.pp +++ b/programs/develop/fp/rtl/dos.pp @@ -1,9 +1,80 @@ unit Dos; + 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 + +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. diff --git a/programs/develop/fp/rtl/kos.inc b/programs/develop/fp/rtl/kos.inc index 944aa0a9f0..e7e5a64580 100644 --- a/programs/develop/fp/rtl/kos.inc +++ b/programs/develop/fp/rtl/kos.inc @@ -161,6 +161,22 @@ end; { 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; asm pushl %ebx diff --git a/programs/develop/fp/rtl/kos_stdio.inc b/programs/develop/fp/rtl/kos_stdio.inc index bc6e137f7e..16165b09a0 100644 --- a/programs/develop/fp/rtl/kos_stdio.inc +++ b/programs/develop/fp/rtl/kos_stdio.inc @@ -114,8 +114,7 @@ begin while not Console^.FTerminate do begin Event := kos_getevent(); - if Console^.FTerminate then - {Console^.ProcessMessage('[CONSOLE] Terminate...'#13#10)} else + if not Console^.FTerminate then case Event of SE_PAINT: Console^.Paint(); SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey()); @@ -146,23 +145,21 @@ begin FOpened := False; FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE; FIPCBuffer := GetMem(FIPCBufferSize); - {FIPCBufferSize := SizeOf(KonsoleIPCBuffer); - FIPCBuffer := @KonsoleIPCBuffer;} FIPCBuffer^.Lock := False; FIPCBuffer^.Size := 0; FThreadSlot := -1; FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self); if FThreadID <> 0 then - while not FOpened do kos_delay(1); + {XXX: ╛╝╕╔Б ╖═╒╗А╜ЦБЛ} + while not FOpened do ThreadSwitch; end; destructor TKonsole.Done(); begin FTerminate := True; - Self.Write(#0); - if FOpened then kos_delay(1); - if FOpened then kos_delay(10); - if FOpened then kos_delay(20); + if FOpened then begin Self.Write(#0); kos_delay(01); end; + if FOpened then begin Self.Write(#0); kos_delay(10); end; + if FOpened then begin Self.Write(#0); kos_delay(20); end; if FOpened then begin FOpened := False; @@ -345,7 +342,7 @@ begin {XXX: ╒╝╖╛╝╕╜═ А╗БЦ═Ф╗О ╞Ю╗ ╙╝Б╝Ю╝╘ А╝╝║И╔╜╗╔ ╜╔ ║Ц╓╔Б ╝Б╞Ю═╒╚╔╜╝} if FOpened then begin - I := 20; + I := 100; while (kos_sendmsg(FThreadID, @Message[1], Length(Message)) = 2) and (I > 0) do begin Dec(I); diff --git a/programs/develop/fp/rtl/kosh.inc b/programs/develop/fp/rtl/kosh.inc index 3f4c32212e..9c5b6b22e1 100644 --- a/programs/develop/fp/rtl/kosh.inc +++ b/programs/develop/fp/rtl/kosh.inc @@ -26,6 +26,7 @@ procedure kos_maskevents(mask: DWord); procedure kos_setcaption(caption: PChar); { Graphics } +function kos_screensize(): TKosPoint; procedure kos_begindraw(); procedure kos_enddraw(); procedure kos_putpixel(x, y: Word; color: DWord = $000000); @@ -168,8 +169,6 @@ type path : PChar; end; -{var - KonsoleIPCBuffer: array[0..4096] of Byte;} type PKonsole = ^TKonsole; diff --git a/programs/develop/fp/rtl/systhrd.inc b/programs/develop/fp/rtl/systhrd.inc index 47daf9f2e7..34915aff0b 100644 --- a/programs/develop/fp/rtl/systhrd.inc +++ b/programs/develop/fp/rtl/systhrd.inc @@ -146,10 +146,6 @@ type Stack: Pointer; end; -procedure DoneThread; -begin - SysReleaseThreadVars; -end; procedure ThreadMain(ThreadInfo: PThreadInfo); var @@ -291,45 +287,6 @@ begin 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 KosThreadManager: TThreadManager; @@ -379,8 +336,5 @@ begin SemaphorePost := @NoSemaphorePost; end; SetThreadManager(KosThreadManager); -{$ifndef HAS_MT_MEMORYMANAGER} - InitHeapMutexes; -{$endif HAS_MT_MEMORYMANAGER} ThreadID := GetCurrentThreadID; end; diff --git a/programs/develop/fp/rtl/sysutils.pp b/programs/develop/fp/rtl/sysutils.pp index 4eea758eae..c93aba1df8 100644 --- a/programs/develop/fp/rtl/sysutils.pp +++ b/programs/develop/fp/rtl/sysutils.pp @@ -161,7 +161,7 @@ begin ReleaseFileRecord(Handle); end; -function FileTruncate(Handle: THandle; Size: Longint): Boolean; +function FileTruncate(Handle: THandle; Size: Int64): Boolean; begin Result := False; end;