Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 665 → Rev 666

/programs/develop/fp/rtl/_defines.inc
1,6 → 1,5
{$undef mswindows}
{$undef windows}
{$undef Windows}
{$undef win32}
{$undef os2}
{$undef linux}
/programs/develop/fp/rtl/build.bat
3,7 → 3,8
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%
set BUILDPATH=..\units
set FPCARGS=-n -Twin32 -Sge5 -O3pPENTIUM3 -CfSSE -di386 -FU%BUILDPATH% %INCS% %UNTS%
 
fpc system.pp -Us %FPCARGS%
if errorlevel 1 goto error
/programs/develop/fp/rtl/kos.inc
388,6 → 388,17
popl %eax
end;
 
{ Work with system - Get system parameters }
 
function kos_timecounter(): DWord; assembler; register;
asm
pushl %ebx
movl $26, %eax
movl $9, %ebx
int $0x40
popl %ebx
end;
 
{ Work with system - Internal system services }
 
procedure kos_switchthread(); assembler; register;
/programs/develop/fp/rtl/kos_stdio.inc
2,6 → 2,7
 
procedure OpenStdout(var f: TextRec); forward;
procedure WriteStdout(var f: TextRec); forward;
procedure FlushStdout(var f: TextRec); forward;
procedure CloseStdout(var f: TextRec); forward;
 
procedure OpenStdin(var f: TextRec); forward;
20,7 → 21,7
procedure OpenStdout(var f: TextRec);
begin
TextRec(f).InOutFunc := @WriteStdout;
TextRec(f).FlushFunc := @WriteStdout;
TextRec(f).FlushFunc := @FlushStdout;
TextRec(f).CloseFunc := @CloseStdout;
end;
 
34,6 → 35,12
Konsole.Write(msg);
end;
 
procedure FlushStdout(var f: TextRec);
begin
WriteStdout(f);
Konsole.Flush;
end;
 
procedure CloseStdout(var f: TextRec);
begin
end;
114,6 → 121,7
while not Console^.FTerminate do
begin
Event := kos_getevent();
Console^.FOnAir := True;
if not Console^.FTerminate then
case Event of
SE_PAINT: Console^.Paint();
120,6 → 128,7
SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey());
SE_IPC: while Console^.ReceiveMessage(Message) do Console^.ProcessMessage(Message);
end;
Console^.FOnAir := False;
end;
Console^.FOpened := False;
end;
143,6 → 152,7
FMaxLines := 150;
FTerminate := False;
FOpened := False;
FOnAir := False;
FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE;
FIPCBuffer := GetMem(FIPCBufferSize);
FIPCBuffer^.Lock := False;
151,7 → 161,6
FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self);
if FThreadID <> 0 then
{XXX: ¬®¦¥â § ¢¨á­ãâì}
{‚®, â ª ¨ ¥áâì ¢ 2.2.0.}
while not FOpened do ThreadSwitch;
end;
 
164,10 → 173,11
if FOpened then
begin
FOpened := False;
FOnAir := False;
KillThread(FThreadID);
end;
FreeMem(FIPCBuffer);
SetLength(FLines, 0);
{FreeMem(FIPCBuffer);
SetLength(FLines, 0);}
end;
 
function TKonsole.ReceiveMessage(var Message: ShortString): Boolean;
176,9 → 186,10
PMsg: PKosMessage;
Size: Longword;
begin
FIPCBuffer^.Lock := True;
 
if FIPCBuffer^.Size > 0 then
begin
FIPCBuffer^.Lock := True;
PMsg := Pointer(Longword(FIPCBuffer) + SizeOf(TKosIPC));
{TODO: ¯à®¢¥àª  PMsg^.SenderID}
{Size := PMsg^.Size;
210,38 → 221,25
procedure TKonsole.ProcessMessage(Message: ShortString);
{‚뢥á⨠ᮮ¡é¥­¨¥ ­  ª®­á®«ì}
var
S: String;
LinesCount: Word;
CR, LF, W: Word;
BottomRow: Boolean = True;
begin
if Length(Message) < 1 then Exit;
OnlyBottomLine: Boolean = True;
 
repeat
CR := Pos(#13, Message);
LF := Pos(#10, Message);
if (CR > 0) and ((CR < LF) or (LF <= 0)) then
W := CR else
if LF > 0 then
W := LF else
W := Length(Message) + 1;
if W > 0 then
procedure PutChar(C: Char);
var
LinesCount: Longint;
PLine: PShortString;
I: Longint;
begin
if W > 1 then
{ ¯¥à¥¢®¤ ª®à¥âª¨ ­  ¯®§¨æ¨î ¢«¥¢® }
if C = #8 then
begin
S := Copy(Message, 1, W - 1);
Delete(FLines[FCursor.Y], FCursor.X, Length(FLines[FCursor.Y]) - FCursor.X);
Insert(S, FLines[FCursor.Y], FCursor.X);
Inc(FCursor.X, Length(S));
end;
Delete(Message, 1, W);
if W = CR then
{¯¥à¥¢®¤ ª®à¥âª¨ ¢ ­ ç «® áâப¨}
FCursor.X := 1 else
if W = LF then
if FCursor.X > 1 then
Dec(FCursor.X);
end else
 
{ ¯¥à¥¢®¤ ª®à¥âª¨ ­  á«¥¤ãîéãî áâபã }
if C = #10 then
begin
{¯¥à¥¢®¤ ª®à¥âª¨ ­  á«¥¤ãîéãî áâபã}
BottomRow := False;
OnlyBottomLine := False;
Inc(FCursor.Y);
LinesCount := Length(FLines);
while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines);
252,13 → 250,48
FLines[LinesCount] := '';
Inc(LinesCount);
end;
end else
 
{ ¯¥à¥¢®¤ ª®à¥âª¨ ¢ ­ ç «® áâப¨ }
if C = #13 then
FCursor.X := 1 else
 
{ ¯®¬¥é¥­¨¥ ᨬ¢®«  ¢ áâபã }
begin
if FCursor.X > 200 then
begin
PutChar(#13);
PutChar(#10);
end;
 
{ FIXME: …᫨ ¢ PascalMain ⮫쪮 ®¤¨­ Write/Ln, â® § ¢¨á®­.
á¬. FPC_DO_EXIT, InternalExit }
PLine := @FLines[FCursor.Y];
I := Length(PLine^);
if FCursor.X > I then
begin
SetLength(PLine^, FCursor.X);
Inc(I);
while I < FCursor.X do
begin
PLine^[I] := ' ';
Inc(I);
end;
until Length(Message) <= 0;
end;
FLines[FCursor.Y][FCursor.X] := C;
 
Paint(BottomRow);
Inc(FCursor.X);
end;
end;
 
var
I: Longint;
begin
for I := 1 to Length(Message) do
PutChar(Message[I]);
Paint(OnlyBottomLine);
end;
 
procedure TKonsole.ProcessKeyboard(Key: Word);
begin
FKeyPressed := Key;
351,3 → 384,8
end;
end;
end;
 
procedure TKonsole.Flush();
begin
while FOnAir do ThreadSwitch;
end;
/programs/develop/fp/rtl/kosh.inc
1,4 → 1,4
{}
{-$codepage cp866}
 
type
TKosPoint = packed record
46,6 → 46,9
{ Work with system - Set system parameters }
procedure kos_enablepci();
 
{ Work with system - Get system parameters }
function kos_timecounter(): DWord;
 
{ Work with system - Internal system services }
procedure kos_switchthread();
function kos_initheap(): DWord;
67,7 → 70,9
MemoryUsage: DWord;
ThreadID: TThreadID;
WindowRect: TKosRect;
Unknown0: array[1..1066] of Byte;
Reserved3: DWord;
ClientRect: TKosRect;
Reserved4: array[1..1046] of Byte;
end;
 
{ãä¥à IPC}
179,7 → 184,7
TKonsole = object
private
FCaption: String;
FLines: array of String;
FLines: array of ShortString;
FCursor: TKosPoint;
FMaxLines: Word;
FThreadID: TThreadID;
188,6 → 193,7
FIPCBufferSize: DWord;
FTerminate: Boolean;
FOpened: Boolean;
FOnAir : Boolean;
FKeyPressed: Word;
function ReceiveMessage(var Message: ShortString): Boolean;
procedure ProcessMessage(Message: ShortString);
195,6 → 201,7
function GetRect(): TKosRect;
function GetKeyPressed(): Word;
procedure Paint(BottomRow: Boolean = False);
procedure Flush();
public
constructor Init(ACaption: String = '');
destructor Done();
205,7 → 212,59
property ThreadSlot: TThreadSlot read FThreadSlot; {JustForFun, must be hidden, do not use}
end;
 
IStreamIO = interface
function Read(Size: DWord = 0): AnsiString;
procedure Write(Str: AnsiString; Error: Boolean = False);
(* §à ¡®âª  â¥à¬¨­ «  ¢ à ¬ª å RTL ¯à¥ªà é¥­ . ’¥à¬¨­ « ¡ã¤¥â ¢ë¤¥«¥­ ¨§ ª®¤ 
ª®­á®«ì­®£® ¯à¨«®¦¥­¨ï ¨ ¤®«¦¥­ ¡ëâì ॠ«¨§®¢ ­ ª ª ®â¤¥«ì­ë© á¥à¢¨á á
¤¨­ ¬¨ç¥áª¨¬ ¯®¤ª«î祭¨¥¬, «¨¡® ª ª ®â¤¥«ì­ë© ¬®¤ã«ì FreePascal á® áâ â¨ç¥áª¨¬
¨«¨ ¤¨­ ¬¨ç¥áª¨¬ ¯®¤ª«î祭¨¥¬ â¥à¬¨­ «ì­®£® ä㭪樮­ « .
 
PTermKursor = ^TTermKursor;
TTermKursor = object
private
FVisible: Boolean;
procedure SetVisbile(Value: Boolean);
public
constructor Init;
procedure Repaint;
property Visible: Boolean read FVisible write SetVisbile;
end;
 
PTermKIO = ^TTermKIO;
TTermKIO = object
private
FBuffer: Pointer;
FBufferScreen: Pointer;
FBufferSize : Longword;
FBufferWidth: Longword;
FBufferLines: Longword;
FIPCBuffer: PKosIPC;
FIPCBufferSize: Longword;
FCursor: TTermKursor;
FCaption: String;
FThreadID: TThreadID;
FThreadSlot: TThreadSlot;
FTerminate: Boolean;
FOpened: Boolean;
FWindowBounds: TKosRect;
FWindowStyle : Longword;
FClientBounds: TKosRect;
FMaxWidth : Longword;
FFirstLine: Longword;
FDefaultChar: Word;
FPalette: array[0..15] of Longword;
procedure MainLoop;
procedure ReallocBuffer(Size: Longword);
procedure ResizeBuffer(NewWidth, NewLines: Longword);
procedure FillDefaultChar(var X; Count: Longword);
function GetLine(Index: Longint): Pointer;
function PrevLine(Line: Pointer): Pointer;
{function ReceiveMessage(var Message: ShortString): Boolean;
procedure ProcessMessage(Message: ShortString);}
procedure ProcessKeyboard(Key: Word);
procedure DoPaint(const Bounds: TKosRect);
procedure DoResize;
public
constructor Init(ACaption: String = '');
destructor Done;
procedure Write(Message: ShortString);
property Cursor: TTermKursor read FCursor;
end;*)
/programs/develop/fp/rtl/system.pp
136,6 → 136,7
end;
 
{$i kos_stdio.inc}
{-$i kos_term.inc}
 
procedure SysInitStdIO;
begin
186,12 → 187,13
SysResetFPU;
StackLength := CheckInitialStkLen(InitialStkLen);
StackBottom := Pointer(StackTop - StackLength);
kos_initheap();
InitHeap;
kos_initheap();
SysInitExceptions;
FPC_CpuCodeInit();
InOutRes := 0;
InitSystemThreads;
if IsConsole then
Konsole.Init();
SysInitStdIO;
SetupCmdLine;