FP 2.3.1 (SVN 8373)

git-svn-id: svn://kolibrios.org@619 a494cfbc-eb01-0410-851d-a64ba20cac60

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.
+
+Как теперь собирать программы я опишу позже.

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%

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.

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

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
+    if not Console^.FTerminate then
-      {Console^.ProcessMessage('[CONSOLE] Terminate...'#13#10)} else
     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 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
   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);

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;

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;

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;