FP 2.3.1 (SVN 8373)
git-svn-id: svn://kolibrios.org@619 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
bw
parent
d01af144cb
commit
6c47c845cb
@ -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.
|
||||
|
||||
Как теперь собирать программы я опишу позже.
|
||||
|
||||
@ -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%
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user