/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; |