Index: .
===================================================================
--- . (revision 194)
+++ . (working copy)
Property changes on: .
___________________________________________________________________
Added: svn:ignore
## -0,0 +1,2 ##
+bin
+lib
Index: FPC/ToroException.lpi
===================================================================
--- FPC/ToroException.lpi (nonexistent)
+++ FPC/ToroException.lpi (working copy)
@@ -0,0 +1,96 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroException.pas
===================================================================
--- FPC/ToroException.pas (nonexistent)
+++ FPC/ToroException.pas (working copy)
@@ -0,0 +1,59 @@
+//
+// Toro Exceptions Example
+//
+// Changes :
+//
+// 24.8.2016 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroException;
+
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -drive format=raw,file=ToroException.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -drive format=raw,file=ToroException.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+// Adding support for FPC 2.0.4 ;)
+{$IMAGEBASE 4194304}
+
+// they are declared just the necessary units
+// the units used depend the hardware where you are running the application
+uses
+ Kernel in 'rtl\Kernel.pas',
+ Process in 'rtl\Process.pas',
+ Memory in 'rtl\Memory.pas',
+ Debug in 'rtl\Debug.pas',
+ Arch in 'rtl\Arch.pas',
+ Filesystem in 'rtl\Filesystem.pas',
+ Console in 'rtl\Drivers\Console.pas',
+ uToroException;
+
+
+begin
+ Main;
+end.
Index: FPC/ToroHello.lpi
===================================================================
--- FPC/ToroHello.lpi (nonexistent)
+++ FPC/ToroHello.lpi (working copy)
@@ -0,0 +1,123 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroHello.pas
===================================================================
--- FPC/ToroHello.pas (nonexistent)
+++ FPC/ToroHello.pas (working copy)
@@ -0,0 +1,58 @@
+//
+// Toro Hello World Example.
+// Clasical example using a minimal kernel to print "Hello World"
+//
+// Changes :
+//
+// 16/09/2011 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroHello;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+// They are declared just the necessary units
+// The needed units depend on the hardware where you are running the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Console in '..\rtl\Drivers\Console.pas';
+
+begin
+ WriteConsole('\c/RHello World, I am TORO!!!\n',[0]);
+ while True do
+ SysThreadSwitch;
+end.
Index: FPC/ToroHttp.lpi
===================================================================
--- FPC/ToroHttp.lpi (nonexistent)
+++ FPC/ToroHttp.lpi (working copy)
@@ -0,0 +1,137 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroHttp.pas
===================================================================
--- FPC/ToroHttp.pas (nonexistent)
+++ FPC/ToroHttp.pas (working copy)
@@ -0,0 +1,64 @@
+//
+// Toro Http example.
+//
+// This imple program shows how can be used the stack TCP/IP.
+// The service listens at port 80 and it says "Hello" when a new
+// connection arrives and then it closes it.
+//
+// Changes :
+// 2017 / 01 / 04 : Minor fixes
+// 2016 / 12 / 22 : First working version by Matias Vara
+// 2011 / 07 / 30 : Some stuff around the resource dedication
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroHttp;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -net nic,model=ne2k_pci -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroHttp.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -net nic,model=ne2k_pci -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroHttp.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+{$IMAGEBASE 4194304}
+
+// They are declared just the necessary units
+// The units used depend the hardware where you are running the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Network in '..\rtl\Network.pas',
+ Console in '..\rtl\Drivers\Console.pas',
+ Ne2000 in '..\rtl\Drivers\Ne2000.pas', uToroHttp;
+
+begin
+ Main;
+ while True do
+ SysThreadSwitch;
+end.
Index: FPC/ToroKernel.lpk
===================================================================
--- FPC/ToroKernel.lpk (nonexistent)
+++ FPC/ToroKernel.lpk (working copy)
@@ -0,0 +1,111 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroKernel.pas
===================================================================
--- FPC/ToroKernel.pas (nonexistent)
+++ FPC/ToroKernel.pas (working copy)
@@ -0,0 +1,23 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit ToroKernel;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+ Arch, Debug, Errno, Filesystem, fpintres, Kernel, Libc, Memory, Network,
+ Process, SysUtils, Console, E1000, Ext2, IdeDisk, Ne2000, Pci,
+ LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+ RegisterPackage('ToroKernel', @Register);
+end.
Index: FPC/ToroKeyb.lpi
===================================================================
--- FPC/ToroKeyb.lpi (nonexistent)
+++ FPC/ToroKeyb.lpi (working copy)
@@ -0,0 +1,95 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroKeyb.pas
===================================================================
--- FPC/ToroKeyb.pas (nonexistent)
+++ FPC/ToroKeyb.pas (working copy)
@@ -0,0 +1,60 @@
+//
+// ToroKeyb
+// Example that shows the keyboard apis
+//
+// Changes :
+//
+// 16/09/2011 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroKeyb;
+
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroKeyb.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroKeyb.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+// They are declared just the necessary units
+// The units used depend the hardware where you are running the application
+uses
+ Kernel in 'rtl\Kernel.pas',
+ Process in 'rtl\Process.pas',
+ Memory in 'rtl\Memory.pas',
+ Debug in 'rtl\Debug.pas',
+ Arch in 'rtl\Arch.pas',
+ Filesystem in 'rtl\Filesystem.pas',
+ Console in 'rtl\Drivers\Console.pas',
+ uToroKeyb;
+
+begin
+ Main;
+ while True do
+ SysThreadSwitch;
+end.
Index: FPC/ToroPing.lpi
===================================================================
--- FPC/ToroPing.lpi (nonexistent)
+++ FPC/ToroPing.lpi (working copy)
@@ -0,0 +1,137 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroPing.pas
===================================================================
--- FPC/ToroPing.pas (nonexistent)
+++ FPC/ToroPing.pas (working copy)
@@ -0,0 +1,60 @@
+//
+// Toro Ping example.
+//
+// Changes :
+// 08 / 12 / 2016 : First Version by Matias Vara
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroPing;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -net nic,model=e1000 -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroPing.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -net nic,model=e1000 -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroPing.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+{$IMAGEBASE 4194304}
+
+// They are declared just the necessary units
+// The units used depend on the hardware in which you run the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Network in '..\rtl\Network.pas',
+ Console in '..\rtl\Drivers\Console.pas',
+ E1000 in '..\rtl\Drivers\E1000.pas',
+ uToroPing;
+
+var ldIPAdrCompr:DWORD;
+
+begin
+ ldIPAdrCompr:=Init(PingIP);
+ Main(ldIPAdrCompr);
+end.
Index: FPC/ToroThread.lpi
===================================================================
--- FPC/ToroThread.lpi (nonexistent)
+++ FPC/ToroThread.lpi (working copy)
@@ -0,0 +1,96 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroThread.pas
===================================================================
--- FPC/ToroThread.pas (nonexistent)
+++ FPC/ToroThread.pas (working copy)
@@ -0,0 +1,66 @@
+//
+// Toro Multithreading Example
+//
+// I have implemented three task (T1, T2 and T3), T1 runs in core 0 while T2 and T3 runs in core1.
+// T1 and T2 have a data dependency, hence while T1 runs T2 must not, this was implemented with a few
+// boolean variables like a semaphore. It could be great to implemented at kernel level thus the user has not
+// take in care about that stuff.
+// Besides, this is a good example about static scheduling where we are sure about the execution order previusly.
+//
+// Changes :
+//
+// 22/06/2012 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroThread;
+
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroThread.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroThread.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+
+
+
+// they are declared just the necessary units
+// the units used depend the hardware where you are running the application
+uses
+ Kernel in 'rtl\Kernel.pas',
+ Process in 'rtl\Process.pas',
+ Memory in 'rtl\Memory.pas',
+ Debug in 'rtl\Debug.pas',
+ Arch in 'rtl\Arch.pas',
+ Filesystem in 'rtl\Filesystem.pas',
+ Console in 'rtl\Drivers\Console.pas', uToroThread;
+
+
+begin
+ Init;
+ Main;
+end.
Index: FPC/TotoDefault.xml
===================================================================
--- FPC/TotoDefault.xml (nonexistent)
+++ FPC/TotoDefault.xml (working copy)
@@ -0,0 +1,44 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/WritePacal.lpi
===================================================================
--- FPC/WritePacal.lpi (nonexistent)
+++ FPC/WritePacal.lpi (working copy)
@@ -0,0 +1,128 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/WritePacal.pas
===================================================================
--- FPC/WritePacal.pas (nonexistent)
+++ FPC/WritePacal.pas (working copy)
@@ -0,0 +1,59 @@
+// Toro Write Pascal Example.
+// Example using a minimal kernel to print "Pascal" in 3D
+
+// Changes :
+
+// 19/06/2017 First Version by Joe Care.
+
+// Copyright (c) 2017 Joe Care
+// All Rights Reserved
+
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+
+program WritePacal;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+{%RunCommand $Confirm("$env(ProgramFiles)\qemu\qemu-system-x86_64.exe") -m 512 -drive format=raw,file=WritePacal.img}
+{%RunFlags BUILD-}
+{%RunWorkingDir $(PkgOutDir)}
+{$ELSE}
+{%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
+{$ENDIF}
+
+// They are declared just the necessary units
+// The needed units depend on the hardware where you are running the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Console in '..\rtl\Drivers\Console.pas',
+ uWritePascal;
+
+begin
+ Main;
+ while True do
+ SysThreadSwitch;
+end.
+
Index: FPC
===================================================================
--- FPC (nonexistent)
+++ FPC (working copy)
Property changes on: FPC
___________________________________________________________________
Added: svn:ignore
## -0,0 +1,3 ##
+*.lps
+backup
+kernel.bin
Index: FPC/ToroException.lpi
===================================================================
--- FPC/ToroException.lpi (nonexistent)
+++ FPC/ToroException.lpi (working copy)
@@ -0,0 +1,96 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroException.pas
===================================================================
--- FPC/ToroException.pas (nonexistent)
+++ FPC/ToroException.pas (working copy)
@@ -0,0 +1,59 @@
+//
+// Toro Exceptions Example
+//
+// Changes :
+//
+// 24.8.2016 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroException;
+
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -drive format=raw,file=ToroException.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -drive format=raw,file=ToroException.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+// Adding support for FPC 2.0.4 ;)
+{$IMAGEBASE 4194304}
+
+// they are declared just the necessary units
+// the units used depend the hardware where you are running the application
+uses
+ Kernel in 'rtl\Kernel.pas',
+ Process in 'rtl\Process.pas',
+ Memory in 'rtl\Memory.pas',
+ Debug in 'rtl\Debug.pas',
+ Arch in 'rtl\Arch.pas',
+ Filesystem in 'rtl\Filesystem.pas',
+ Console in 'rtl\Drivers\Console.pas',
+ uToroException;
+
+
+begin
+ Main;
+end.
Index: FPC/ToroHello.lpi
===================================================================
--- FPC/ToroHello.lpi (nonexistent)
+++ FPC/ToroHello.lpi (working copy)
@@ -0,0 +1,123 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroHello.pas
===================================================================
--- FPC/ToroHello.pas (nonexistent)
+++ FPC/ToroHello.pas (working copy)
@@ -0,0 +1,58 @@
+//
+// Toro Hello World Example.
+// Clasical example using a minimal kernel to print "Hello World"
+//
+// Changes :
+//
+// 16/09/2011 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroHello;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+// They are declared just the necessary units
+// The needed units depend on the hardware where you are running the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Console in '..\rtl\Drivers\Console.pas';
+
+begin
+ WriteConsole('\c/RHello World, I am TORO!!!\n',[0]);
+ while True do
+ SysThreadSwitch;
+end.
Index: FPC/ToroHttp.lpi
===================================================================
--- FPC/ToroHttp.lpi (nonexistent)
+++ FPC/ToroHttp.lpi (working copy)
@@ -0,0 +1,137 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroHttp.pas
===================================================================
--- FPC/ToroHttp.pas (nonexistent)
+++ FPC/ToroHttp.pas (working copy)
@@ -0,0 +1,64 @@
+//
+// Toro Http example.
+//
+// This imple program shows how can be used the stack TCP/IP.
+// The service listens at port 80 and it says "Hello" when a new
+// connection arrives and then it closes it.
+//
+// Changes :
+// 2017 / 01 / 04 : Minor fixes
+// 2016 / 12 / 22 : First working version by Matias Vara
+// 2011 / 07 / 30 : Some stuff around the resource dedication
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroHttp;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -net nic,model=ne2k_pci -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroHttp.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -net nic,model=ne2k_pci -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroHttp.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+{$IMAGEBASE 4194304}
+
+// They are declared just the necessary units
+// The units used depend the hardware where you are running the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Network in '..\rtl\Network.pas',
+ Console in '..\rtl\Drivers\Console.pas',
+ Ne2000 in '..\rtl\Drivers\Ne2000.pas', uToroHttp;
+
+begin
+ Main;
+ while True do
+ SysThreadSwitch;
+end.
Index: FPC/ToroKernel.lpk
===================================================================
--- FPC/ToroKernel.lpk (nonexistent)
+++ FPC/ToroKernel.lpk (working copy)
@@ -0,0 +1,111 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroKernel.pas
===================================================================
--- FPC/ToroKernel.pas (nonexistent)
+++ FPC/ToroKernel.pas (working copy)
@@ -0,0 +1,23 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit ToroKernel;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+ Arch, Debug, Errno, Filesystem, fpintres, Kernel, Libc, Memory, Network,
+ Process, SysUtils, Console, E1000, Ext2, IdeDisk, Ne2000, Pci,
+ LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+ RegisterPackage('ToroKernel', @Register);
+end.
Index: FPC/ToroKeyb.lpi
===================================================================
--- FPC/ToroKeyb.lpi (nonexistent)
+++ FPC/ToroKeyb.lpi (working copy)
@@ -0,0 +1,95 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroKeyb.pas
===================================================================
--- FPC/ToroKeyb.pas (nonexistent)
+++ FPC/ToroKeyb.pas (working copy)
@@ -0,0 +1,60 @@
+//
+// ToroKeyb
+// Example that shows the keyboard apis
+//
+// Changes :
+//
+// 16/09/2011 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroKeyb;
+
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroKeyb.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroKeyb.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+// They are declared just the necessary units
+// The units used depend the hardware where you are running the application
+uses
+ Kernel in 'rtl\Kernel.pas',
+ Process in 'rtl\Process.pas',
+ Memory in 'rtl\Memory.pas',
+ Debug in 'rtl\Debug.pas',
+ Arch in 'rtl\Arch.pas',
+ Filesystem in 'rtl\Filesystem.pas',
+ Console in 'rtl\Drivers\Console.pas',
+ uToroKeyb;
+
+begin
+ Main;
+ while True do
+ SysThreadSwitch;
+end.
Index: FPC/ToroPing.lpi
===================================================================
--- FPC/ToroPing.lpi (nonexistent)
+++ FPC/ToroPing.lpi (working copy)
@@ -0,0 +1,137 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroPing.pas
===================================================================
--- FPC/ToroPing.pas (nonexistent)
+++ FPC/ToroPing.pas (working copy)
@@ -0,0 +1,60 @@
+//
+// Toro Ping example.
+//
+// Changes :
+// 08 / 12 / 2016 : First Version by Matias Vara
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroPing;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -net nic,model=e1000 -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroPing.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -net nic,model=e1000 -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroPing.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+{$IMAGEBASE 4194304}
+
+// They are declared just the necessary units
+// The units used depend on the hardware in which you run the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Network in '..\rtl\Network.pas',
+ Console in '..\rtl\Drivers\Console.pas',
+ E1000 in '..\rtl\Drivers\E1000.pas',
+ uToroPing;
+
+var ldIPAdrCompr:DWORD;
+
+begin
+ ldIPAdrCompr:=Init(PingIP);
+ Main(ldIPAdrCompr);
+end.
Index: FPC/ToroThread.lpi
===================================================================
--- FPC/ToroThread.lpi (nonexistent)
+++ FPC/ToroThread.lpi (working copy)
@@ -0,0 +1,96 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/ToroThread.pas
===================================================================
--- FPC/ToroThread.pas (nonexistent)
+++ FPC/ToroThread.pas (working copy)
@@ -0,0 +1,66 @@
+//
+// Toro Multithreading Example
+//
+// I have implemented three task (T1, T2 and T3), T1 runs in core 0 while T2 and T3 runs in core1.
+// T1 and T2 have a data dependency, hence while T1 runs T2 must not, this was implemented with a few
+// boolean variables like a semaphore. It could be great to implemented at kernel level thus the user has not
+// take in care about that stuff.
+// Besides, this is a good example about static scheduling where we are sure about the execution order previusly.
+//
+// Changes :
+//
+// 22/06/2012 First Version by Matias E. Vara.
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+program ToroThread;
+
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+ {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroThread.img}
+{$ELSE}
+ {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroThread.img}
+{$ENDIF}
+{%RunFlags BUILD-}
+
+
+
+
+// they are declared just the necessary units
+// the units used depend the hardware where you are running the application
+uses
+ Kernel in 'rtl\Kernel.pas',
+ Process in 'rtl\Process.pas',
+ Memory in 'rtl\Memory.pas',
+ Debug in 'rtl\Debug.pas',
+ Arch in 'rtl\Arch.pas',
+ Filesystem in 'rtl\Filesystem.pas',
+ Console in 'rtl\Drivers\Console.pas', uToroThread;
+
+
+begin
+ Init;
+ Main;
+end.
Index: FPC/TotoDefault.xml
===================================================================
--- FPC/TotoDefault.xml (nonexistent)
+++ FPC/TotoDefault.xml (working copy)
@@ -0,0 +1,44 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/WritePacal.lpi
===================================================================
--- FPC/WritePacal.lpi (nonexistent)
+++ FPC/WritePacal.lpi (working copy)
@@ -0,0 +1,128 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: FPC/WritePacal.pas
===================================================================
--- FPC/WritePacal.pas (nonexistent)
+++ FPC/WritePacal.pas (working copy)
@@ -0,0 +1,59 @@
+// Toro Write Pascal Example.
+// Example using a minimal kernel to print "Pascal" in 3D
+
+// Changes :
+
+// 19/06/2017 First Version by Joe Care.
+
+// Copyright (c) 2017 Joe Care
+// All Rights Reserved
+
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+
+program WritePacal;
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+{$IMAGEBASE 4194304}
+
+// Configuring the RUN for Lazarus
+{$IFDEF WIN64}
+{%RunCommand $Confirm("$env(ProgramFiles)\qemu\qemu-system-x86_64.exe") -m 512 -drive format=raw,file=WritePacal.img}
+{%RunFlags BUILD-}
+{%RunWorkingDir $(PkgOutDir)}
+{$ELSE}
+{%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
+{$ENDIF}
+
+// They are declared just the necessary units
+// The needed units depend on the hardware where you are running the application
+uses
+ Kernel in '..\rtl\Kernel.pas',
+ Process in '..\rtl\Process.pas',
+ Memory in '..\rtl\Memory.pas',
+ Debug in '..\rtl\Debug.pas',
+ Arch in '..\rtl\Arch.pas',
+ Filesystem in '..\rtl\Filesystem.pas',
+ Pci in '..\rtl\Drivers\Pci.pas',
+ Console in '..\rtl\Drivers\Console.pas',
+ uWritePascal;
+
+begin
+ Main;
+ while True do
+ SysThreadSwitch;
+end.
+
Index: rtl
===================================================================
--- rtl (revision 194)
+++ rtl (working copy)
Property changes on: rtl
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+backup
Index: rtl/Arch.pas
===================================================================
--- rtl/Arch.pas (revision 194)
+++ rtl/Arch.pas (working copy)
@@ -133,7 +133,7 @@
procedure Interruption_Ignore;
procedure IRQ_Ignore;
function PciReadDWORD(const bus, device, func, regnum: UInt32): UInt32;
-function GetMemoryRegion (ID: LongInt ; Buffer : PMemoryRegion): LongInt;
+function GetMemoryRegion (ID: LongInt ; out Buffer : TMemoryRegion): LongInt;
procedure InitCore(ApicID: Byte);
procedure SetPageCache(Add: Pointer);
procedure RemovePageCache(Add: Pointer);
@@ -274,11 +274,11 @@
// Put interruption gate in the idt
procedure CaptureInt(int: Byte; Handler: Pointer);
begin
- idt_gates^[int].handler_0_15 := Word(QWord(handler) and $ffff);
+ idt_gates^[int].handler_0_15 := Word(Ptrint(handler) and $ffff);
idt_gates^[int].selector := kernel_code_sel;
idt_gates^[int].tipe := gate_syst;
- idt_gates^[int].handler_16_31 := Word((QWord(handler) shr 16) and $ffff);
- idt_gates^[int].handler_32_63 := DWORD(QWord(handler) shr 32);
+ idt_gates^[int].handler_16_31 := Word((PtrUint(handler) shr 16) and $ffff);
+ idt_gates^[int].handler_32_63 := DWORD(PtrUint(handler) shr 32);
idt_gates^[int].res := 0;
idt_gates^[int].nu := 0;
end;
@@ -285,11 +285,11 @@
procedure CaptureException(Exception: Byte; Handler: Pointer);
begin
- idt_gates^[Exception].handler_0_15 := Word(QWord(handler) and $ffff) ;
+ idt_gates^[Exception].handler_0_15 := Word(Ptrint(handler) and $ffff) ;
idt_gates^[Exception].selector := kernel_code_sel;
idt_gates^[Exception].tipe := gate_syst ;
- idt_gates^[Exception].handler_16_31 := Word((QWord(handler) shr 16) and $ffff);
- idt_gates^[Exception].handler_32_63 := DWORD(QWord(handler) shr 32);
+ idt_gates^[Exception].handler_16_31 := Word((PtrUint(handler) shr 16) and $ffff);
+ idt_gates^[Exception].handler_32_63 := DWORD(PtrUint(handler) shr 32);
idt_gates^[Exception].res := 0 ;
idt_gates^[Exception].nu := 0 ;
end;
@@ -779,7 +779,7 @@
CounterID: LongInt; // starts with CounterID = 1
// Return information about Memory Region
-function GetMemoryRegion(ID: LongInt; Buffer: PMemoryRegion): LongInt;
+function GetMemoryRegion(ID: LongInt;out Buffer: TMemoryRegion): LongInt;
var
Desc: PInt15h_info;
begin
Index: rtl/Debug.pas
===================================================================
--- rtl/Debug.pas (revision 194)
+++ rtl/Debug.pas (working copy)
@@ -273,7 +273,7 @@
SpinLock (3,4,LockDebug);
CPUI := GetApicID;
Thread := Cpu[CPUI].CurrentThread;
- WriteSerial('\t CPU%d Thread#%d ',[CPUI, Int64(Thread)]);
+ WriteSerial('\t CPU%d Thread#%d ',[CPUI, Int64(PtrUInt(Thread))]);
WriteSerial (Format, Args);
LockDebug := 3;
RestoreInt;
Index: rtl/drivers/Console.pas
===================================================================
--- rtl/drivers/Console.pas (revision 194)
+++ rtl/drivers/Console.pas (working copy)
@@ -1,10 +1,10 @@
-//
+
// Console.pas
-//
+
// Console Manipulation.
-//
+
// Changes:
-//
+
// 18/12/2016 Adding protection to WriteConsole()
// 04/09/2016 Removing Printk_(), only WriteConsole() is used which is protected.
// 11/12/2011 Implementing "Lock" for concurrent access to the console in WriteConsole() procedure. Printk_ is still free of protection.
@@ -13,25 +13,25 @@
// The consoles's procedures are only for users, the kernel only need PrintK_().
// 15/07/2006 The code was rewrited by Matias Vara.
// 09/02/2005 First Version by Matias Vara.
-//
+
// Copyright (c) 2003-2016 Matias Vara
// All Rights Reserved
-//
-//
+
+
// This program is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
-//
+
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
-//
+
// You should have received a copy of the GNU General Public License
// along with this program. If not, see .
-//
+
unit Console;
{$I ../Toro.inc}
@@ -40,61 +40,101 @@
uses Arch, Process;
+type
+
+ { TConsole }
+
+ TConsole = record // screen text mode
+ procedure CleanConsole;
+ procedure PrintDecimal(Value: PtrUInt);
+ procedure WriteConsole(const Format: ansistring; const Args: array of PtrUInt);
+ procedure ReadConsole(var C: XChar);
+ procedure ReadlnConsole(Format: PXChar);
+ procedure DisabledConsole;
+ procedure EnabledConsole;
+ procedure ConsoleInit;
+ procedure WriteLn(s: ansistring);
+ procedure Write(s: ansistring);
+ end;
+
+// Clears the Screen of the Current Console;
procedure CleanConsole;
+
+// Prints a decimal Value to the Screen;
procedure PrintDecimal(Value: PtrUInt);
-procedure WriteConsole(const Format: AnsiString; const Args: array of PtrUInt);
+
+// Prints Prints a formated String to the Screen;
+procedure WriteConsole(const Format: ansistring; const Args: array of PtrUInt);
+
+// Reads a Character from the console
procedure ReadConsole(var C: XChar);
+
+
procedure ReadlnConsole(Format: PXChar);
procedure DisabledConsole;
procedure EnabledConsole;
procedure ConsoleInit;
+// (by JC) Writes the string to the Console with CR at the end
+procedure PrintStringLn(const S: ansistring=''); overload;
+
+// (by JC) Writes the string to the Console
+procedure PrintString(const S: ansistring=''); overload;
+
+// (by JC) Sets the Cursor to a specific Place on the Screen
+// Startingpoint (Upper-Left-Corner) is (1,1)
+procedure GotoXY(x, y: smallint);
+
+procedure PutC(const Car: XChar);
+
+procedure NewLine(ClEOL: boolean = False);
+
var
- Color: Byte = 10;
+ // default Color = ???
+ Color: byte = 10;
const
- HEX_CHAR: array[0..15] of XChar = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
+ HEX_CHAR: array[0..15] of XChar = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
implementation
const
- CHAR_CODE : array [1..57] of XChar =
- ('0','1','2','3','4','5','6','7','8','9','0','?','=','0',' ','q','w',
- 'e','r','t','y','u','i','o','p','[',']','0','0','a','s','d','f','g','h',
- 'j','k','l','¤','{','}','0','0','z','x','c','v','b','n','m',',','.','-',
- '0','*','0',' ');
+ CHAR_CODE: array [1..57] of XChar =
+ ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '?', '=', '0', ' ', 'q', 'w',
+ 'e', 'r', 't', 'y', 'u', 'i', 'o', 'p', '[', ']', '0', '0', 'a', 's', 'd', 'f', 'g', 'h',
+ 'j', 'k', 'l', '¤', '{', '}', '0', '0', 'z', 'x', 'c', 'v', 'b', 'n', 'm', ',', '.', '-',
+ '0', '*', '0', ' ');
const
- VIDEO_OFFSET = $B8000;
+ VIDEO_OFFSET = $B8000;
-type
- TConsole = record // screen text mode
- car: XChar;
- form: Byte;
- end;
-
var
- // Protection for concurrent access
- LockConsole: UInt64 = 3;
+ // Protection for concurrent access
+ LockConsole: UInt64 = 3;
-procedure PrintString(const S: AnsiString); forward;
+type
+ TConsolePixel = record
+ car: XChar;
+ form: byte;
+ end;
+
var
- PConsole: ^TConsole;
- X, Y: Byte;
- KeyBuffer: array[1..127] of XChar;
- BufferCount: LongInt = 1 ;
- ThreadInKey: PThread = nil;
- LastChar: LongInt = 1;
-
-// position the cursor in screen
-procedure SetCursor(X, Y: Byte);
+ PConsole: ^TConsolePixel;
+ X, Y: byte;
+ KeyBuffer: array[1..127] of XChar;
+ BufferCount: longint = 1;
+ ThreadInKey: PThread = nil;
+ LastChar: longint = 1;
+
+// position the cursor in screen
+procedure SetCursor(X, Y: byte);
begin
- write_portb($0E, $3D4);
- write_portb(Y, $3D5);
- write_portb($0f, $3D4);
- write_portb(X, $3D5);
+ write_portb($0E, $3D4);
+ write_portb(Y, $3D5);
+ write_portb($0f, $3D4);
+ write_portb(X, $3D5);
end;
@@ -101,22 +141,47 @@
// Flush up the screen
procedure FlushUp;
begin
- X := 0 ;
- Move(PXChar(VIDEO_OFFSET+160)^, PXChar(VIDEO_OFFSET)^, 24*80*2);
- FillWord(PXChar(VIDEO_OFFSET+160*24)^, 80, $0720);
+ X := 0;
+ Move(PXChar(VIDEO_OFFSET + 160)^, PXChar(VIDEO_OFFSET)^, 24 * 80 * 2);
+ FillWord(PXChar(VIDEO_OFFSET + 160 * 24)^, 80, $0720);
end;
-// Put caracter to screen
+procedure NewLine(ClEOL: boolean = False);
+begin
+ if ClEOL then
+ begin
+ while X < 78 do
+ PutC(' ');
+ PutC(' ');
+ end
+ else
+ if (Y >= 24) then
+ FlushUp
+ else
+ begin
+ X := 0;
+ Inc(Y);
+ end;
+end;
+
+// Put caracter to screen
procedure PutC(const Car: XChar);
begin
- Y := 24;
- if X > 79 then
- FlushUp;
- PConsole := Pointer(VIDEO_OFFSET + (80*2)*Y + (X*2));
- PConsole.form := color;
- PConsole.car := Car;
- X := X+1;
- SetCursor(X, Y);
+ if (Y > 24) then
+ Y := 24;
+ if (X > 79) then
+ NewLine;
+ if Ord(Car) <> 8 then
+ begin
+ PConsole := Pointer(VIDEO_OFFSET + (80 * 2) * Y + (X * 2));
+ PConsole.form := color;
+ PConsole.car := Car;
+ X := X + 1;
+ end
+ else
+ if X > 0 then
+ X := X - 1;
+ SetCursor(X, Y);
end;
{$IFDEF DCC}
@@ -135,275 +200,289 @@
// Print in decimal form
procedure PrintDecimal(Value: PtrUInt);
var
- I, Len: Byte;
- S: string[64];
+ I, Len: byte;
+ S: string[64];
begin
- Len := 0;
- I := 10;
- if Value = 0 then
- begin
- PutC('0');
- end else
- begin
- while Value <> 0 do
- begin
- S[I] := AnsiChar((Value mod 10) + $30);
- Value := Value div 10;
- I := I-1;
- Len := Len+1;
- end;
- if (Len <> 10) then
- begin
- S[0] := XChar(Len);
- for I := 1 to Len do
- begin
- S[I] := S[11-Len];
- Len := Len-1;
- end;
- end else
- begin
- S[0] := chr(10);
- end;
- for I := 1 to ord(S[0]) do
- begin
- PutC(S[I]);
- end;
- end;
+ Len := 0;
+ I := 10;
+ if Value = 0 then
+ PutC('0')
+ else
+ begin
+ while Value <> 0 do
+ begin
+ S[I] := AnsiChar((Value mod 10) + $30);
+ Value := Value div 10;
+ I := I - 1;
+ Len := Len + 1;
+ end;
+ if (Len <> 10) then
+ begin
+ S[0] := XChar(Len);
+ for I := 1 to Len do
+ begin
+ S[I] := S[11 - Len];
+ Len := Len - 1;
+ end;
+ end
+ else
+ S[0] := chr(10);
+ for I := 1 to Ord(S[0]) do
+ PutC(S[I]);
+ end;
end;
procedure PrintHexa(Value: PtrUInt);
var
- I: Byte;
+ I: byte;
begin
- PutC('0');
- PutC('x');
- for I := SizeOf(PtrUInt)*2-1 downto 0 do
- PutC(HEX_CHAR[(Value shr (I*4)) and $0F]);
+ PutC('0');
+ PutC('x');
+ for I := SizeOf(PtrUInt) * 2 - 1 downto 0 do
+ PutC(HEX_CHAR[(Value shr (I * 4)) and $0F]);
end;
-procedure PrintString(const S: AnsiString);
+procedure PrintStringLn(const S: ansistring);
var
- I: Integer;
+ I: Integer;
begin
- for I := 1 to Length(S) do
- PutC(S[I]);
+ for I := 1 to Length(S) do
+ PutC(S[I]);
+ NewLine(false);
end;
-// Clean the screen
+procedure PrintString(const S: ansistring);
+var
+ I: integer;
+begin
+ for I := 1 to Length(S) do
+ PutC(S[I]);
+end;
+
+procedure GotoXY(x, y: smallint);
+begin
+ SetCursor(x-1,Y-1);
+end;
+
+// Clean the screen
procedure CleanConsole;
begin
- FillWord(PXChar(video_offset)^, 2000, $0720);
- X := 0;
- Y := 0;
+ FillWord(PXChar(video_offset)^, 2000, $0720);
+ X := 0;
+ Y := 0;
end;
// Print to screen using format
-procedure WriteConsole(const Format: AnsiString; const Args: array of PtrUInt);
+procedure WriteConsole(const Format: ansistring; const Args: array of PtrUInt);
var
- ArgNo: LongInt;
- I, J: LongInt;
- Value: QWORD;
- Values: PXChar;
- tmp: TNow;
+ ArgNo: longint;
+ I, J: longint;
+ Value: QWORD;
+ Values: PXChar;
+ tmp: TNow;
begin
- DisableInt;
- SpinLock (3,4,LockConsole);
-
- ArgNo := 0 ;
- J := 1;
- while J <= Length(Format) do
- begin
- // we have an argument
- if (Format[J] = '%') and (High(Args) <> -1) and (High(Args) >= ArgNo) then
- begin
- J:= J+1;
- if J > Length(Format) then
- Exit ;
- case Format[J] of
- 'c':
+ DisableInt;
+ SpinLock(3, 4, LockConsole);
+
+ ArgNo := 0;
+ J := 1;
+ while J <= Length(Format) do
+ begin
+ // we have an argument
+ if (Format[J] = '%') and (High(Args) <> -1) and (High(Args) >= ArgNo) then
begin
- PutC(XChar(args[ArgNo]));
- end;
- 'h':
- begin
- Value := args[ArgNo];
- PrintHexa(Value);
+ J := J + 1;
+ if J > Length(Format) then
+ Exit;
+ case Format[J] of
+ 'c':
+ PutC(XChar(args[ArgNo]));
+ 'h':
+ begin
+ Value := args[ArgNo];
+ PrintHexa(Value);
+ end;
+ 'd':
+ begin
+ Value := args[ArgNo];
+ PrintDecimal(Value);
+ end;
+ '%':
+ PutC('%');
+ 'p':
+ begin
+ Values := pointer(args[ArgNo]);
+ while Values^ <> #0 do
+ begin
+ PutC(Values^);
+ Inc(Values);
+ end;
+ end;
+ else
+ begin
+ J := J + 1;
+ Continue;
+ end;
+ end;
+ J := J + 1;
+ ArgNo := ArgNo + 1;
+ Continue;
end;
- 'd':
+ if Format[J] = '\' then
begin
- Value := args[ArgNo];
- PrintDecimal (Value);
+ J := J + 1;
+ if J > Length(Format) then
+ Exit;
+ case Format[J] of
+ 'c':
+ begin
+ CleanConsole;
+ J := J + 1;
+ end;
+ 'n':
+ begin
+ FlushUp;
+ J := J + 1;
+ x := 0;
+ end;
+ '\':
+ begin
+ PutC('\');
+ J := J + 1;
+ end;
+ 'v':
+ begin
+ I := 1;
+ while I < 10 do
+ begin
+ PutC(' ');
+ Inc(I);
+ end;
+ J := J + 1;
+ end;
+ 't':
+ begin
+ Now(@tmp);
+ if (tmp.Day < 10) then
+ PrintDecimal(0);
+ PrintDecimal(tmp.Day);
+ PutC('/');
+ if (tmp.Month < 10) then
+ PrintDecimal(0);
+ PrintDecimal(tmp.Month);
+ PutC('/');
+ PrintDecimal(tmp.Year);
+ PutC('-');
+ if (tmp.Hour < 10) then
+ PrintDecimal(0);
+ PrintDecimal(tmp.Hour);
+ PutC(':');
+ if (tmp.Min < 10) then
+ PrintDecimal(0);
+ PrintDecimal(tmp.Min);
+ PutC(':');
+ if (tmp.Sec < 10) then
+ PrintDecimal(0);
+ PrintDecimal(tmp.Sec);
+
+ J := J + 1;
+ end;
+ else
+ begin
+ PutC('\');
+ PutC(Format[J]);
+ end;
+ end;
+ Continue;
end;
- '%':
+ // Terminal Color indicator
+ if Format[J] = '/' then
begin
- PutC('%');
+ Inc(J);
+ if Format[J] = #0 then
+ Exit;
+ case Format[J] of
+ 'n': color := 7;
+ 'a': color := 1;
+ 'v': color := 2;
+ 'V': color := 10;
+ 'z': color := $f;
+ 'c': color := 3;
+ 'r': color := 4;
+ 'R': color := 12;
+ 'N': color := $af;
+ end;
+ Inc(J);
+ Continue;
end;
- 'p':
- begin
- Values := pointer(args[ArgNo]);
- while Values^ <> #0 do
- begin
- PutC(Values^);
- Inc(Values);
- end;
- end;
- else
- begin
- J:= J+1;
- Continue;
- end;
+ PutC(Format[J]);
+ Inc(J);
end;
- J:= J+1;
- ArgNo := ArgNo+1;
- Continue;
- end;
- if Format[J] = '\' then
- begin
- J:= J+1;
- if J > Length(Format) then
- Exit ;
- case Format[J] of
- 'c': begin
- CleanConsole;
- J:=J+1;
- end;
- 'n': begin
- FlushUp;
- J:= J+1;
- x := 0;
- end;
- '\': begin
- PutC('\');
- J:=J+1;
- end;
- 'v':
- begin
- I := 1;
- while I < 10 do
- begin
- PutC(' ');
- Inc(I);
- end;
- J:=J+1;
- end;
- 't': begin
- Now(@tmp);
- if (tmp.Day < 10) then PrintDecimal (0);
- PrintDecimal (tmp.Day);
- PutC('/');
- if (tmp.Month < 10) then PrintDecimal (0);
- PrintDecimal (tmp.Month);
- PutC('/');
- PrintDecimal (tmp.Year);
- PutC('-');
- if (tmp.Hour < 10) then PrintDecimal (0);
- PrintDecimal (tmp.Hour);
- PutC(':');
- if (tmp.Min < 10) then PrintDecimal (0);
- PrintDecimal (tmp.Min);
- PutC(':');
- if (tmp.Sec < 10) then PrintDecimal (0);
- PrintDecimal (tmp.Sec);
-
- J:=J+1;
- end;
- else
- begin
- PutC('\');
- PutC(Format[J]);
- end;
- end;
- Continue;
- end;
- // Terminal Color indicator
- if Format[J] = '/' then
- begin
- Inc(J);
- if Format[J] = #0 then
- Exit;
- case Format[J] of
- 'n': color := 7 ;
- 'a': color := 1;
- 'v': color := 2;
- 'V': color := 10;
- 'z': color := $f;
- 'c': color := 3;
- 'r': color := 4;
- 'R': color := 12 ;
- 'N': color := $af;
- end;
- Inc(J);
- Continue;
- end;
- PutC(Format[J]);
- Inc(J);
- end;
- LockConsole := 3;
- RestoreInt;
+ LockConsole := 3;
+ RestoreInt;
end;
// Handler the irq of keyboard
procedure KeyHandler;
var
- key: Byte;
- pbuff: PXChar;
+ key: byte;
+ pbuff: PXChar;
begin
- EOI;
- while (read_portb($64) and 1) = 1 do
- begin
- key:=read_portb($60);
- key:= 127 and key;
- // Shift and Crt key are not implement
- if key and 128 <> 0 then
- Exit;
- // Manipulation of keys
- case key of
- //Shift, Crt and CpsLockk are not implement
- 29,42,58: Exit;
- 14:
- begin
- //Bkspc key
- if x<>0 then
- begin
- x := x-1;
- PutC(#0);
- x:= x-1;
- setcursor(x,y);
- end;
- end;
- 28:
- begin
- // Enter Key
- y := y+1;
- if y = 25 then
- FlushUp;
- SetCursor(x,y);
- BufferCount := BufferCount+1;
- if BufferCount > SizeOf(KeyBuffer) then
- BufferCount:=1;
- pbuff := @KeyBuffer[BufferCount];
- pbuff^ := #13;
- if ThreadinKey <> nil then
- ThreadinKey.state:=tsReady;
- end;
- 75,72,80,77: Continue;
- else
+ EOI;
+ while (read_portb($64) and 1) = 1 do
begin
- // Printing the key to the screen
- Inc(BufferCount);
- if BufferCount > SizeOf(KeyBuffer) then
- BufferCount:=1;
- pbuff := @KeyBuffer[BufferCount];
- pbuff^ := Char_Code[key];
- PutC(pbuff^);
- if ThreadinKey <> nil then
- ThreadinKey.state:=tsReady;
+ key := read_portb($60);
+ key := 127 and key;
+ // Shift and Crt key are not implement
+ if key and 128 <> 0 then
+ Exit;
+ // Manipulation of keys
+ case key of
+ //Shift, Crt and CpsLockk are not implement
+ 29, 42, 58: Exit;
+ 14:
+ if x <> 0 then
+ begin
+ x := x - 1;
+ PutC(#0);
+ x := x - 1;
+ setcursor(x, y);
+ end;//Bkspc key
+
+ 28:
+ begin
+ // Enter Key
+ y := y + 1;
+ if y = 25 then
+ FlushUp;
+ SetCursor(x, y);
+ BufferCount := BufferCount + 1;
+ if BufferCount > SizeOf(KeyBuffer) then
+ BufferCount := 1;
+ pbuff := @KeyBuffer[BufferCount];
+ pbuff^ := #13;
+ if ThreadinKey <> nil then
+ ThreadinKey.state := tsReady;
+ end;
+ 75, 72, 80, 77: Continue;
+ else
+ begin
+ // Printing the key to the screen
+ Inc(BufferCount);
+ if BufferCount > SizeOf(KeyBuffer) then
+ BufferCount := 1;
+ pbuff := @KeyBuffer[BufferCount];
+ pbuff^ := Char_Code[key];
+ PutC(pbuff^);
+ if ThreadinKey <> nil then
+ ThreadinKey.state := tsReady;
+ end;
+ end;
end;
- end;
- end;
end;
-procedure IrqKeyb; {$IFDEF FPC} [nostackframe]; {$ENDIF} assembler;
+{$IFNDEF NOFORMAT}
+procedure IrqKeyb; {$IFDEF FPC}[nostackframe];{$ENDIF} assembler;
asm
{$IFDEF DCC} .noframe {$ENDIF}
// save registers
@@ -443,58 +522,122 @@
db $48
db $cf
end;
-
+{$ENDIF}
// Read a Char from Console
procedure ReadConsole(var C: XChar);
begin
- ThreadInkey := GetCurrentThread;
- if BufferCount = LastChar then
- begin
- ThreadInKey.state := tsIOPending;
- SysThreadSwitch;
- end;
- LastChar := LastChar+1;
- if LastChar > SizeOf(KeyBuffer) then
- LastChar := SizeOf(KeyBuffer);
- C := KeyBuffer[LastChar];
- ThreadInKey := nil;
+ ThreadInkey := GetCurrentThread;
+ if BufferCount = LastChar then
+ begin
+ ThreadInKey.state := tsIOPending;
+ SysThreadSwitch;
+ end;
+ LastChar := LastChar + 1;
+ if LastChar > SizeOf(KeyBuffer) then
+ LastChar := SizeOf(KeyBuffer);
+ C := KeyBuffer[LastChar];
+ ThreadInKey := nil;
end;
// Read the console until [Enter] key is pressed
procedure ReadlnConsole(Format: PXChar);
var
- C: XChar;
+ C: XChar;
begin
- while True do
- begin
- ReadConsole(C);
- if C = #13 then
- begin
- Format^ := #0;
- Exit;
- end;
- Format^ := C;
- Inc(Format);
- end;
+ while True do
+ begin
+ ReadConsole(C);
+ if C = #13 then
+ begin
+ Format^ := #0;
+ Exit;
+ end;
+ Format^ := C;
+ Inc(Format);
+ end;
end;
// Enable the Console
procedure EnabledConsole;
begin
- // IRQ 1 is captured by BSP
- IrqOn(1);
+ // IRQ 1 is captured by BSP
+ IrqOn(1);
end;
// Disable Console
procedure DisabledConsole;
begin
- IrqOff(1);
+ IrqOff(1);
end;
procedure ConsoleInit;
begin
- CaptureInt(33,@IrqKeyb);
+ CaptureInt(33, @IrqKeyb);
end;
+{ TConsole }
+
+procedure TConsole.CleanConsole;
+begin
+
+end;
+
+procedure TConsole.PrintDecimal(Value: PtrUInt);
+begin
+
+end;
+
+procedure TConsole.WriteConsole(const Format: ansistring; const Args: array of PtrUInt);
+begin
+
+end;
+
+procedure TConsole.ReadConsole(var C: XChar);
+begin
+
+end;
+
+procedure TConsole.ReadlnConsole(Format: PXChar);
+var
+ C: XChar;
+begin
+ while True do
+ begin
+ ReadConsole(C);
+ if C = #13 then
+ begin
+ Format^ := #0;
+ Exit;
+ end;
+ Format^ := C;
+ Inc(Format);
+ end;
+end;
+
+procedure TConsole.DisabledConsole;
+begin
+ IrqOff(1);
+end;
+
+procedure TConsole.EnabledConsole;
+begin
+ IrqOn(1);
+end;
+
+procedure TConsole.ConsoleInit;
+begin
+ CaptureInt(33, @IrqKeyb);
+end;
+
+procedure TConsole.WriteLn(s: ansistring);
+begin
+
+end;
+
+procedure TConsole.Write(s: ansistring);
+begin
+
+end;
+
end.
Index: rtl/drivers/E1000.pas
===================================================================
--- rtl/drivers/E1000.pas (revision 194)
+++ rtl/drivers/E1000.pas (working copy)
@@ -1,29 +1,29 @@
-//
+
// E1000.pas
-//
+
// Driver for Intel 1000 PRO network card.
-//
+
// Changes:
-//
+
// 06.06.2017. First version.
-//
+
// Copyright (c) 2003-2017 Matias Vara
// All Rights Reserved
-//
+
// This program is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
-//
+
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
-//
+
// You should have received a copy of the GNU General Public License
// along with this program. If not, see .
-//
+
unit E1000;
interface
@@ -36,205 +36,206 @@
uses
{$IFDEF DEBUG} Debug, {$ENDIF}
- FileSystem,
- Pci,
- Arch, Console, Network, Process, Memory;
+ FileSystem,
+ Pci,
+ Arch, Console, Network, Process, Memory;
implementation
type
- PE1000 = ^TE1000;
- PE1000RxDesc = ^TE1000RxDesc;
- PE1000TxDesc = ^TE1000TxDesc;
- TE1000 = record
- Driverinterface: TNetworkInterface;
- IRQ: LongInt;
- EepromDoneBit: LongInt;
- EepromAddrOff: LongInt;
- Regs: Pointer;
- RxDescCount: LongInt;
- TxDescCount: LongInt;
- RxDesc: PE1000RxDesc;
- RxBufferSize: LongInt;
- TxBufferSize: LongInt;
- RxBuffer: Pointer;
- TxBuffer: Pointer;
- TxDesc: PE1000TxDesc;
- NextPacket: LongInt;
- end;
+ PE1000 = ^TE1000;
+ PE1000RxDesc = ^TE1000RxDesc;
+ PE1000TxDesc = ^TE1000TxDesc;
- TE1000RxDesc = record
- Buffer: DWORD;
- Buffer_h: DWORD;
- Length: word;
- Checksum: word;
- Status: Byte;
- Errors: Byte;
- Special: word;
- end;
+ TE1000 = record
+ Driverinterface: TNetworkInterface;
+ IRQ: longint;
+ EepromDoneBit: longint;
+ EepromAddrOff: longint;
+ Regs: Pointer;
+ RxDescCount: longint;
+ TxDescCount: longint;
+ RxDesc: PE1000RxDesc;
+ RxBufferSize: longint;
+ TxBufferSize: longint;
+ RxBuffer: Pointer;
+ TxBuffer: Pointer;
+ TxDesc: PE1000TxDesc;
+ NextPacket: longint;
+ end;
- TE1000TxDesc = record
- Buffer: DWORD;
- Buffer_h: DWORD;
- Length: word;
- ChecksumOff: Byte;
- Command: Byte;
- Status: Byte;
- ChecksumSt: Byte;
- Special: word;
- end;
+ TE1000RxDesc = record
+ Buffer: DWORD;
+ Buffer_h: DWORD;
+ Length: word;
+ Checksum: word;
+ Status: byte;
+ Errors: byte;
+ Special: word;
+ end;
+ TE1000TxDesc = record
+ Buffer: DWORD;
+ Buffer_h: DWORD;
+ Length: word;
+ ChecksumOff: byte;
+ Command: byte;
+ Status: byte;
+ ChecksumSt: byte;
+ Special: word;
+ end;
+
const
- E1000_REG_STATUS = $8;
- E1000_REG_CTRL = 0;
- E1000_REG_FCAL = $28;
- E1000_REG_FCAH = $2c;
- E1000_REG_FCT = $30;
- E1000_REG_FCTTV = $170;
- E1000_REG_MTA =$5200;
- E1000_REG_CRCERRS =$4000;
- E1000_REG_EERD = $14;
- E1000_REG_RAL = $5400;
- E1000_REG_RAH = $5404;
- E1000_REG_RCTL =$100;
- E1000_REG_TCTL =$400;
+ E1000_REG_STATUS = $8;
+ E1000_REG_CTRL = 0;
+ E1000_REG_FCAL = $28;
+ E1000_REG_FCAH = $2c;
+ E1000_REG_FCT = $30;
+ E1000_REG_FCTTV = $170;
+ E1000_REG_MTA = $5200;
+ E1000_REG_CRCERRS = $4000;
+ E1000_REG_EERD = $14;
+ E1000_REG_RAL = $5400;
+ E1000_REG_RAH = $5404;
+ E1000_REG_RCTL = $100;
+ E1000_REG_TCTL = $400;
- E1000_REG_CTRL_RST = 1 shl 26;
- E1000_REG_CTRL_ASDE = 1 shl 5;
- E1000_REG_CTRL_SLU = 1 shl 6;
- E1000_REG_CTRL_LRST = 1 shl 3;
- E1000_REG_CTRL_PHY_RST = 1 shl 31;
- E1000_REG_CTRL_ILOS = 1 shl 7;
- E1000_REG_CTRL_VME = 1 shl 30;
+ E1000_REG_CTRL_RST = 1 shl 26;
+ E1000_REG_CTRL_ASDE = 1 shl 5;
+ E1000_REG_CTRL_SLU = 1 shl 6;
+ E1000_REG_CTRL_LRST = 1 shl 3;
+ E1000_REG_CTRL_PHY_RST = 1 shl 31;
+ E1000_REG_CTRL_ILOS = 1 shl 7;
+ E1000_REG_CTRL_VME = 1 shl 30;
- E1000_REG_EERD_START = 1 shl 0;
- E1000_REG_EERD_DATA = $ffff shl 16;
+ E1000_REG_EERD_START = 1 shl 0;
+ E1000_REG_EERD_DATA = $ffff shl 16;
- E1000_REG_RAH_AV = 1 shl 31;
+ E1000_REG_RAH_AV = 1 shl 31;
- E1000_REG_RDBAL = $2800;
- E1000_REG_RDBAH = $2804;
- E1000_REG_RDLEN = $2808;
- E1000_REG_RCTL_EN = 1 shl 1;
- E1000_REG_RXDCTL_ENABLE = 1 shl 25;
- // 256 bytes
- E1000_REG_RCTL_BSIZE = ((1 shl 16) or (1 shl 17));
- E1000_REG_RXDCTL = $2828;
- E1000_REG_TDBAL = $3800;
- E1000_REG_TDBAH = $3804;
- E1000_REG_TDLEN = $3808;
- E1000_REG_TDH = $3810;
- E1000_REG_TDT = $3818;
- E1000_REG_RDH = $2810;
- E1000_REG_RDT = $2818;
- E1000_REG_RDTR = $2820;
- E1000_REG_TCTL_PSP = 1 shl 3;
- E1000_REG_TCTL_EN = 1 shl 1;
+ E1000_REG_RDBAL = $2800;
+ E1000_REG_RDBAH = $2804;
+ E1000_REG_RDLEN = $2808;
+ E1000_REG_RCTL_EN = 1 shl 1;
+ E1000_REG_RXDCTL_ENABLE = 1 shl 25;
+ // 256 bytes
+ E1000_REG_RCTL_BSIZE = ((1 shl 16) or (1 shl 17));
+ E1000_REG_RXDCTL = $2828;
+ E1000_REG_TDBAL = $3800;
+ E1000_REG_TDBAH = $3804;
+ E1000_REG_TDLEN = $3808;
+ E1000_REG_TDH = $3810;
+ E1000_REG_TDT = $3818;
+ E1000_REG_RDH = $2810;
+ E1000_REG_RDT = $2818;
+ E1000_REG_RDTR = $2820;
+ E1000_REG_TCTL_PSP = 1 shl 3;
+ E1000_REG_TCTL_EN = 1 shl 1;
- E1000_REG_IMS = $d0;
- E1000_REG_IMS_LSC =1 shl 2;
- E1000_REG_IMS_RXO = 1 shl 6;
- E1000_REG_IMS_RXT = 1 shl 7;
- E1000_REG_IMS_TXDW = 1 shl 0;
- E1000_REG_IMS_TXQE = 1 shl 1;
+ E1000_REG_IMS = $d0;
+ E1000_REG_IMS_LSC = 1 shl 2;
+ E1000_REG_IMS_RXO = 1 shl 6;
+ E1000_REG_IMS_RXT = 1 shl 7;
+ E1000_REG_IMS_TXDW = 1 shl 0;
+ E1000_REG_IMS_TXQE = 1 shl 1;
- E1000_REG_ICR = $c0;
- E1000_REG_ICR_LSC = 1 shl 2;
+ E1000_REG_ICR = $c0;
+ E1000_REG_ICR_LSC = 1 shl 2;
- E1000_REG_ICR_TXQE = 1 shl 1;
- E1000_REG_ICR_TXDW = 1 shl 0;
+ E1000_REG_ICR_TXQE = 1 shl 1;
+ E1000_REG_ICR_TXDW = 1 shl 0;
- E1000_REG_ICR_RXT = 1 shl 7;
- E1000_REG_ICR_RXO = 1 shl 6;
+ E1000_REG_ICR_RXT = 1 shl 7;
+ E1000_REG_ICR_RXO = 1 shl 6;
- E1000_RXDESC_NR = 256;
- E1000_TXDESC_NR = 256;
+ E1000_RXDESC_NR = 256;
+ E1000_TXDESC_NR = 256;
- E1000_IOBUF_SIZE = 2048;
+ E1000_IOBUF_SIZE = 2048;
- E1000_TX_CMD_EOP = 1 shl 0;
- E1000_TX_CMD_FCS = 1 shl 1;
- E1000_TX_CMD_RS = 1 shl 3;
+ E1000_TX_CMD_EOP = 1 shl 0;
+ E1000_TX_CMD_FCS = 1 shl 1;
+ E1000_TX_CMD_RS = 1 shl 3;
- E1000_RX_STATUS_EOP = 1 shl 1;
- E1000_RX_STATUS_DONE = 1 shl 0;
+ E1000_RX_STATUS_EOP = 1 shl 1;
+ E1000_RX_STATUS_DONE = 1 shl 0;
- E1000_REG_RCTL_UPE = 1 shl 3;
- E1000_REG_RCTL_MPE = 1 shl 4;
- E1000_REG_RCTL_BAM = 1 shl 15;
- E1000_RCTL_SECRC = 1 shl 26;
+ E1000_REG_RCTL_UPE = 1 shl 3;
+ E1000_REG_RCTL_MPE = 1 shl 4;
+ E1000_REG_RCTL_BAM = 1 shl 15;
+ E1000_RCTL_SECRC = 1 shl 26;
// Support currently 1 ethernet card
var
- NicE1000: TE1000;
+ NicE1000: TE1000;
// read e1000 register
-function E1000ReadRegister(Net: PE1000; reg: LongInt): LongInt;
+function E1000ReadRegister(Net: PE1000; reg: longint): longint;
var
- r: ^DWORD;
+ r: ^DWORD;
begin
- r := Pointer(PtrUInt(Net.Regs)+reg);
- Result := r^;
+ r := Pointer(PtrUInt(Net.Regs) + reg);
+ Result := r^;
end;
// write e1000 register
-procedure E1000WriteRegister(Net: PE1000; Reg, Value: LongInt);
+procedure E1000WriteRegister(Net: PE1000; Reg, Value: longint);
var
- r: ^DWORD;
+ r: ^DWORD;
begin
- r := Pointer(PtrUInt(Net.Regs)+Reg);
- r^ := Value;
+ r := Pointer(PtrUInt(Net.Regs) + Reg);
+ r^ := Value;
end;
// set a bit
-procedure e1000SetRegister(Net: PE1000; Reg, Value: LongInt);
+procedure e1000SetRegister(Net: PE1000; Reg, Value: longint);
var
- Data: LongInt;
+ Data: longint;
begin
- Data:= E1000ReadRegister(Net, Reg);
- E1000WriteRegister(Net, Reg, Data or Value);
+ Data := E1000ReadRegister(Net, Reg);
+ E1000WriteRegister(Net, Reg, Data or Value);
end;
// unset a bit
-procedure e1000UnsetRegister(Net: PE1000; Reg, Value: LongInt);
+procedure e1000UnsetRegister(Net: PE1000; Reg, Value: longint);
var
- Data: LongInt;
+ Data: longint;
begin
- Data:= E1000ReadRegister(Net, Reg);
- E1000WriteRegister(Net,Reg, Data and not(Value));
+ Data := E1000ReadRegister(Net, Reg);
+ E1000WriteRegister(Net, Reg, Data and not (Value));
end;
procedure E1000Reset(Net: PE1000);
begin
- E1000SetRegister(Net, E1000_REG_CTRL, E1000_REG_CTRL_RST);
- // delay one microsecond
- DelayMicro(1000);
+ E1000SetRegister(Net, E1000_REG_CTRL, E1000_REG_CTRL_RST);
+ // delay one microsecond
+ DelayMicro(1000);
end;
-function EepromEerd(Net: PE1000; Reg: LongInt): Word;
+function EepromEerd(Net: PE1000; Reg: longint): word;
var
- tmp: LongInt;
+ tmp: longint;
begin
- // Request EEPROM read.
- E1000WriteRegister(Net, E1000_REG_EERD,(Reg shl Net^.EepromAddrOff) or E1000_REG_EERD_START);
- // Wait until ready.
- tmp := E1000ReadRegister(Net, E1000_REG_EERD);
- while ((tmp and Net^.EepromDoneBit) = 0) do
- begin
- DelayMicro(1);
+ // Request EEPROM read.
+ E1000WriteRegister(Net, E1000_REG_EERD, (Reg shl Net^.EepromAddrOff) or E1000_REG_EERD_START);
+ // Wait until ready.
tmp := E1000ReadRegister(Net, E1000_REG_EERD);
- end;
- Result := tmp shr 16;
+ while ((tmp and Net^.EepromDoneBit) = 0) do
+ begin
+ DelayMicro(1);
+ tmp := E1000ReadRegister(Net, E1000_REG_EERD);
+ end;
+ Result := tmp shr 16;
end;
// Kernel starts the card
procedure e1000Start(net: PNetworkInterface);
-var
- CPU: byte;
+{$IFDEF DebugE1000}var
+ CPU: byte; {$ENDIF}
begin
- CPU := GetApicid;
- // enable the interruption
- IrqOn(NicE1000.IRQ);
+ {$IFDEF DebugE1000}CPU :={$ENDIF} GetApicid;
+ // enable the interruption
+ IrqOn(NicE1000.IRQ);
{$IFDEF DebugE1000} WriteDebug('e1000: starting on CPU%d\n', [CPU]); {$ENDIF}
end;
@@ -241,12 +242,12 @@
// Kernel stops the card
procedure e1000Stop(net: PNetworkInterface);
begin
- IrqOff(NicE1000.IRQ);
+ IrqOff(NicE1000.IRQ);
end;
type
- TByteArray = array[0..0] of Byte;
- PByteArray = ^TByteArray;
+ TByteArray = array[0..0] of byte;
+ PByteArray = ^TByteArray;
// This procedure makes all the job of sending packets
// It is limited to send one packet every time.
@@ -253,212 +254,205 @@
// TODO: To improve this by sending a bunch of packets
procedure DoSendPacket(Net: PNetworkInterface);
var
- Tail, I, Head, Next: LongInt;
- Desc: PE1000TxDesc;
- Data, P: PByteArray;
+ Tail, I, Head, Next: longint;
+ Desc: PE1000TxDesc;
+ Data, P: PByteArray;
begin
- DisableINT;
- Head := E1000ReadRegister(@NicE1000, E1000_REG_TDH);
- Tail := E1000ReadRegister(@NicE1000, E1000_REG_TDT);
- Next := (Tail + 1) mod NicE1000.TxDescCount;
+ DisableINT;
+ Head := E1000ReadRegister(@NicE1000, E1000_REG_TDH);
+ Tail := E1000ReadRegister(@NicE1000, E1000_REG_TDT);
+ Next := (Tail + 1) mod NicE1000.TxDescCount;
- // transmission queue is full
- if (Head = Next) then
- begin
- {$IFDEF DebugE1000} WriteDebug('e1000: DoSendPacket with Head = Next, exiting\n', []); {$ENDIF}
- exit;
- end;
+ // transmission queue is full
+ if (Head = Next) then
+ exit
+{$IFDEF DebugE1000}
+{$ENDIF}
+ ;
- // pointer to the descriptor
- Desc := NicE1000.TxDesc;
- inc(Desc, Tail);
+ // pointer to the descriptor
+ Desc := NicE1000.TxDesc;
+ Inc(Desc, Tail);
- Data := Pointer(PtrUInt(NicE1000.TxBuffer) + (Tail*E1000_IOBUF_SIZE));
- P := net.OutgoingPackets.data;
+ Data := Pointer(PtrUInt(NicE1000.TxBuffer) + (Tail * E1000_IOBUF_SIZE));
+ P := net.OutgoingPackets.Data;
- // copy bytes to TX queue buffers
- // TODO : we are not checking if the packet size is longer that the buffer!!
- for I:= 0 to (net.OutgoingPackets.size-1) do
- Data^[I] := P^[I];
+ // copy bytes to TX queue buffers
+ // TODO : we are not checking if the packet size is longer that the buffer!!
+ for I := 0 to (net.OutgoingPackets.size - 1) do
+ Data^[I] := P^[I];
- // mark this descriptor ready
- Desc.Status := E1000_RX_STATUS_DONE;
- Desc.Length := net.OutgoingPackets.size;
+ // mark this descriptor ready
+ Desc.Status := E1000_RX_STATUS_DONE;
+ Desc.Length := net.OutgoingPackets.size;
- // this marks the end of the packet
- Desc.Command := E1000_TX_CMD_EOP or E1000_TX_CMD_FCS or E1000_TX_CMD_RS;
+ // this marks the end of the packet
+ Desc.Command := E1000_TX_CMD_EOP or E1000_TX_CMD_FCS or E1000_TX_CMD_RS;
- // increment tail and Start transmission
- E1000WriteRegister(@NicE1000, E1000_REG_TDT, Next);
+ // increment tail and Start transmission
+ E1000WriteRegister(@NicE1000, E1000_REG_TDT, Next);
- RestoreInt;
+ RestoreInt;
end;
// Send a packet
procedure e1000Send(Net: PNetworkInterface; Packet: PPacket);
var
- PacketQueue: PPacket;
+ PacketQueue: PPacket;
begin
- // queue the packet
- PacketQueue := Net.OutgoingPackets;
- if PacketQueue = nil then
- begin
- // i have to enque it
- Net.OutgoingPackets := Packet;
- // send Directly
- DoSendPacket(Net);
- end else
- begin
- // we need local protection
- DisableInt;
- // it is a FIFO queue
- while PacketQueue.Next <> nil do
- PacketQueue := PacketQueue.Next;
- PacketQueue.Next := Packet;
- RestoreInt;
- end;
+ // queue the packet
+ PacketQueue := Net.OutgoingPackets;
+ if PacketQueue = nil then
+ begin
+ // i have to enque it
+ Net.OutgoingPackets := Packet;
+ // send Directly
+ DoSendPacket(Net);
+ end
+ else
+ begin
+ // we need local protection
+ DisableInt;
+ // it is a FIFO queue
+ while PacketQueue.Next <> nil do
+ PacketQueue := PacketQueue.Next;
+ PacketQueue.Next := Packet;
+ RestoreInt;
+ end;
end;
// Initializes RX and TX buffers
-function e1000initbuf(Net: PE1000): Boolean;
+function e1000initbuf(Net: PE1000): boolean;
var
- I: LongInt;
- RxBuff: PE1000RxDesc;
- TxBuff: PE1000TxDesc;
- r: ^char;
+ I: longint;
+ RxBuff: PE1000RxDesc;
+ TxBuff: PE1000TxDesc;
+ r: ^char;
begin
- // number of descriptors
- Net.RxDescCount := E1000_RXDESC_NR;
- Net.TxDescCount := E1000_TXDESC_NR;
+ // number of descriptors
+ Net.RxDescCount := E1000_RXDESC_NR;
+ Net.TxDescCount := E1000_TXDESC_NR;
- // allocate RX descriptors
- Net.RxDesc := ToroGetMem(Net.RxDescCount*SizeOf(TE1000RxDesc) + 16);
+ // allocate RX descriptors
+ Net.RxDesc := ToroGetMem(Net.RxDescCount * SizeOf(TE1000RxDesc) + 16);
- if Net.RxDesc = nil then
- begin
- Result := False;
- Exit;
- end;
+ if Net.RxDesc = nil then
+ begin
+ Result := False;
+ Exit;
+ end;
- // aligned RxDesc address
- if (PtrUInt(Net.RxDesc) mod 16 <> 0) then
- begin
- Net.RxDesc := PE1000RxDesc(PtrUInt(Net.RxDesc) + 16 - PtrUInt(Net.RxDesc) mod 16);
- end;
+ // aligned RxDesc address
+ if (PtrUInt(Net.RxDesc) mod 16 <> 0) then
+ Net.RxDesc := PE1000RxDesc(PtrUInt(Net.RxDesc) + 16 - PtrUInt(Net.RxDesc) mod 16);
{$IFDEF DebugE1000} WriteDebug('e1000: RxDesc base address: %d\n', [PtrUInt(Net.RxDesc)]); {$ENDIF}
- r := pointer(Net.RxDesc) ;
- for I := 0 to ((Net.RxDescCount*SizeOf(TE1000RxDesc)+16)-1) do
- r[I] := #0;
+ r := pointer(Net.RxDesc);
+ for I := 0 to ((Net.RxDescCount * SizeOf(TE1000RxDesc) + 16) - 1) do
+ r[I] := #0;
- // allocate 2048-Byte buffers
- Net.RxBufferSize := E1000_RXDESC_NR * E1000_IOBUF_SIZE;
+ // allocate 2048-Byte buffers
+ Net.RxBufferSize := E1000_RXDESC_NR * E1000_IOBUF_SIZE;
- // TODO: this memory should not be aligned?
- Net.RxBuffer := ToroGetMem(Net.RxBufferSize+16);
+ // TODO: this memory should not be aligned?
+ Net.RxBuffer := ToroGetMem(Net.RxBufferSize + 16);
- if Net.RxBuffer = nil then
- begin
- ToroFreeMem(Net.RxDesc);
- Result := False;
- Exit;
- end;
+ if Net.RxBuffer = nil then
+ begin
+ ToroFreeMem(Net.RxDesc);
+ Result := False;
+ Exit;
+ end;
- // aligned RxDesc address
- if (PtrUInt(Net.RxBuffer) mod 16 <> 0) then
- begin
- Net.RxBuffer := Pointer(PtrUInt(Net.RxBuffer) + 16 - PtrUInt(Net.RxBuffer) mod 16);
- end;
+ // aligned RxDesc address
+ if (PtrUInt(Net.RxBuffer) mod 16 <> 0) then
+ Net.RxBuffer := Pointer(PtrUInt(Net.RxBuffer) + 16 - PtrUInt(Net.RxBuffer) mod 16);
{$IFDEF DebugE1000} WriteDebug('e1000: RxBuffer base address: %d\n', [PtrUInt(Net.RxBuffer)]); {$ENDIF}
- // setup RX descriptors
- RxBuff := Net.RxDesc;
- for I := 0 to E1000_RXDESC_NR-1 do
- begin
- RxBuff.Buffer := DWORD(PtrUInt(Net.RxBuffer) + (I * E1000_IOBUF_SIZE));
- RxBuff.status := 0;
- inc(RxBuff);
- end;
+ // setup RX descriptors
+ RxBuff := Net.RxDesc;
+ for I := 0 to E1000_RXDESC_NR - 1 do
+ begin
+ RxBuff.Buffer := DWORD(PtrUInt(Net.RxBuffer) + (I * E1000_IOBUF_SIZE));
+ RxBuff.status := 0;
+ Inc(RxBuff);
+ end;
- Net.TxDesc := ToroGetMem(Net.TxDescCount * SizeOf(TE1000TxDesc) + 16);
- if Net.TxDesc = nil then
- begin
- ToroFreeMem(Net.RxBuffer);
- ToroFreeMem(Net.RxDesc);
- Result := False;
- Exit;
- end;
+ Net.TxDesc := ToroGetMem(Net.TxDescCount * SizeOf(TE1000TxDesc) + 16);
+ if Net.TxDesc = nil then
+ begin
+ ToroFreeMem(Net.RxBuffer);
+ ToroFreeMem(Net.RxDesc);
+ Result := False;
+ Exit;
+ end;
- // aligned TxDesc address
- if (PtrUInt(Net.TxDesc) mod 16 <> 0) then
- begin
- Net.TxDesc := PE1000TxDesc(PtrUInt(Net.TxDesc) + 16 - PtrUInt(Net.TxDesc) mod 16);
- end;
+ // aligned TxDesc address
+ if (PtrUInt(Net.TxDesc) mod 16 <> 0) then
+ Net.TxDesc := PE1000TxDesc(PtrUInt(Net.TxDesc) + 16 - PtrUInt(Net.TxDesc) mod 16);
{$IFDEF DebugE1000} WriteDebug('e1000: TxDesc base address: %d\n', [PtrUInt(Net.TxDesc)]); {$ENDIF}
- r := pointer(Net.TxDesc) ;
- for I := 0 to ((Net.TxDescCount*SizeOf(TE1000TxDesc))-1) do
- r[I] := #0;
+ r := pointer(Net.TxDesc);
+ for I := 0 to ((Net.TxDescCount * SizeOf(TE1000TxDesc)) - 1) do
+ r[I] := #0;
- // allocate 2048-Byte buffers
- Net.TxBufferSize := E1000_TXDESC_NR * E1000_IOBUF_SIZE;
- Net.TxBuffer := ToroGetMem(Net.TxBufferSize + 16);
+ // allocate 2048-Byte buffers
+ Net.TxBufferSize := E1000_TXDESC_NR * E1000_IOBUF_SIZE;
+ Net.TxBuffer := ToroGetMem(Net.TxBufferSize + 16);
- if Net.TxBuffer = nil then
- begin
- ToroFreeMem(Net.TxDesc);
- ToroFreeMem(Net.RxBuffer);
- ToroFreeMem(Net.RxDesc);
- Result := False;
- Exit;
- end;
+ if Net.TxBuffer = nil then
+ begin
+ ToroFreeMem(Net.TxDesc);
+ ToroFreeMem(Net.RxBuffer);
+ ToroFreeMem(Net.RxDesc);
+ Result := False;
+ Exit;
+ end;
- // aligned TxBuffer address
- if (PtrUInt(Net.TxBuffer) mod 16 <> 0) then
- begin
- Net.TxBuffer := Pointer(PtrUInt(Net.TxBuffer) + 16 - PtrUInt(Net.TxBuffer) mod 16);
- end;
+ // aligned TxBuffer address
+ if (PtrUInt(Net.TxBuffer) mod 16 <> 0) then
+ Net.TxBuffer := Pointer(PtrUInt(Net.TxBuffer) + 16 - PtrUInt(Net.TxBuffer) mod 16);
- // Setup TX descriptors
- TxBuff := Net.TxDesc;
- for I := 0 to E1000_TXDESC_NR-1 do
- begin
- TxBuff.Buffer := DWORD(PtrUInt(Net.TxBuffer) + (I * E1000_IOBUF_SIZE));
- TxBuff.Command:= 0;
- Inc(TxBuff);
- end;
+ // Setup TX descriptors
+ TxBuff := Net.TxDesc;
+ for I := 0 to E1000_TXDESC_NR - 1 do
+ begin
+ TxBuff.Buffer := DWORD(PtrUInt(Net.TxBuffer) + (I * E1000_IOBUF_SIZE));
+ TxBuff.Command := 0;
+ Inc(TxBuff);
+ end;
- // Setup the receive ring registers.
- e1000WriteRegister(Net, E1000_REG_RDBAL, PtrUInt(Net.RxDesc) and $FFFFFFFF);
- e1000WriteRegister(Net, E1000_REG_RDBAH, PtrUInt(Net.RxDesc) shr 32);
- e1000WriteRegister(Net, E1000_REG_RDLEN, Net.RxDescCount *SizeOf(TE1000RxDesc));
- e1000WriteRegister(Net, E1000_REG_RDH, 0);
- e1000WriteRegister(Net, E1000_REG_RDT, Net.RxDescCount -1);
+ // Setup the receive ring registers.
+ e1000WriteRegister(Net, E1000_REG_RDBAL, PtrInt(Net.RxDesc) and $FFFFFFFF);
+ e1000WriteRegister(Net, E1000_REG_RDBAH, PtrUInt(Net.RxDesc) shr 32);
+ e1000WriteRegister(Net, E1000_REG_RDLEN, Net.RxDescCount * SizeOf(TE1000RxDesc));
+ e1000WriteRegister(Net, E1000_REG_RDH, 0);
+ e1000WriteRegister(Net, E1000_REG_RDT, Net.RxDescCount - 1);
- // No delay time for reception ints
- e1000WriteRegister(Net, E1000_REG_RDTR , 0);
+ // No delay time for reception ints
+ e1000WriteRegister(Net, E1000_REG_RDTR, 0);
- // set packet size
- e1000UnsetRegister(Net, E1000_REG_RCTL, E1000_REG_RCTL_BSIZE);
+ // set packet size
+ e1000UnsetRegister(Net, E1000_REG_RCTL, E1000_REG_RCTL_BSIZE);
- // No loopback
- e1000UnsetRegister(Net, E1000_REG_RCTL, (1 shl 7) or (1 shl 6));
+ // No loopback
+ e1000UnsetRegister(Net, E1000_REG_RCTL, (1 shl 7) or (1 shl 6));
- // enable reception, disable unicast promiscous, broadcast accept mode
- e1000SetRegister(Net, E1000_REG_RCTL, E1000_REG_RCTL_EN {or E1000_REG_RCTL_UPE} or E1000_REG_RCTL_BAM or E1000_RCTL_SECRC );
+ // enable reception, disable unicast promiscous, broadcast accept mode
+ e1000SetRegister(Net, E1000_REG_RCTL, E1000_REG_RCTL_EN {or E1000_REG_RCTL_UPE} or E1000_REG_RCTL_BAM or E1000_RCTL_SECRC);
- // Setup the transmit ring registers.
- E1000WriteRegister(Net, E1000_REG_TDBAL, PtrUInt(Net.TxDesc) and $FFFFFFFF );
- E1000WriteRegister(Net, E1000_REG_TDBAH, PtrUInt(Net.TxDesc) shr 32);
- E1000WriteRegister(Net, E1000_REG_TDLEN, Net.TxDescCount * SizeOf(TE1000TxDesc));
- E1000WriteRegister(Net, E1000_REG_TDH, 0);
- E1000WriteRegister(Net, E1000_REG_TDT, 0);
- E1000SetRegister(Net, E1000_REG_TCTL, E1000_REG_TCTL_EN or E1000_REG_TCTL_PSP);
+ // Setup the transmit ring registers.
+ E1000WriteRegister(Net, E1000_REG_TDBAL, PtrUInt(Net.TxDesc) and $FFFFFFFF);
+ E1000WriteRegister(Net, E1000_REG_TDBAH, PtrUInt(Net.TxDesc) shr 32);
+ E1000WriteRegister(Net, E1000_REG_TDLEN, Net.TxDescCount * SizeOf(TE1000TxDesc));
+ E1000WriteRegister(Net, E1000_REG_TDH, 0);
+ E1000WriteRegister(Net, E1000_REG_TDT, 0);
+ E1000SetRegister(Net, E1000_REG_TCTL, E1000_REG_TCTL_EN or E1000_REG_TCTL_PSP);
- Result := True;
+ Result := True;
end;
@@ -466,19 +460,19 @@
// This is called only by the interruption handler
procedure ReadPacket(Net: PE1000);
var
- Tail, Head, Current, I: LongInt;
- RxDesc: PE1000RxDesc;
- Packet: PPacket;
- Data, P: PByteArray;
- // this flag is used to drop packets in some situation
- dropflag: Boolean = false;
+ Tail, Head, Current, I: longint;
+ RxDesc: PE1000RxDesc;
+ Packet: PPacket;
+ Data, P: PByteArray;
+ // this flag is used to drop packets in some situation
+ dropflag: boolean = False;
begin
- // Find the head, tail and current descriptors
- Head := E1000ReadRegister(Net, E1000_REG_RDH);
- Tail := E1000ReadRegister(Net, E1000_REG_RDT);
- Current := (Tail + 1) mod Net.RxDescCount;
- RxDesc := Net.RxDesc;
- Inc(RxDesc, Current);
+ // Find the head, tail and current descriptors
+ Head := E1000ReadRegister(Net, E1000_REG_RDH);
+ Tail := E1000ReadRegister(Net, E1000_REG_RDT);
+ Current := (Tail + 1) mod Net.RxDescCount;
+ RxDesc := Net.RxDesc;
+ Inc(RxDesc, Current);
{$IFDEF DebugE1000}
WriteDebug('e1000: new packet, head: %d, tail: %d\n', [Head,Tail]);
@@ -485,91 +479,91 @@
WriteDebug('e1000: new packet, status: %d\n', [RxDesc.Status]);
{$ENDIF}
- // this never should happen
- if (RxDesc.Status and E1000_RX_STATUS_DONE) = 0 then
- begin
- {$IFDEF DebugE1000} WriteDebug('e1000: new packet, E1000_RX_STATUS_DONE exiting\n', []); {$ENDIF}
- dropflag := true;
- end;
+ // this never should happen
+ if (RxDesc.Status and E1000_RX_STATUS_DONE) = 0 then
+ dropflag := True
+{$IFDEF DebugE1000}
+{$ENDIF}
+ ;
- // this driver does not hable such a kind of packets
- if (RxDesc.Status and E1000_RX_STATUS_EOP) = 0 then
- begin
- {$IFDEF DebugE1000} WriteDebug('e1000: new packet, E1000_RX_STATUS_EOP exiting\n', []); {$ENDIF}
- dropflag := true;
- end;
+ // this driver does not hable such a kind of packets
+ if (RxDesc.Status and E1000_RX_STATUS_EOP) = 0 then
+ dropflag := True
+{$IFDEF DebugE1000}
+{$ENDIF}
+ ;
- if dropflag then
- begin
- // reset the descriptor
- RxDesc.Status := E1000_RX_STATUS_DONE;
- // incrementing the tail
- E1000WriteRegister(Net, E1000_REG_RDT, (Tail + 1) mod Net.RxDescCount);
+ if dropflag then
+ begin
+ // reset the descriptor
+ RxDesc.Status := E1000_RX_STATUS_DONE;
+ // incrementing the tail
+ E1000WriteRegister(Net, E1000_REG_RDT, (Tail + 1) mod Net.RxDescCount);
{$IFDEF DebugE1000} WriteDebug('e1000: packet has been drop\n', []); {$ENDIF}
- exit;
- end;
+ exit;
+ end;
- // get memory for new packet
- Packet := ToroGetMem(RxDesc.Length+SizeOf(TPacket));
+ // get memory for new packet
+ Packet := ToroGetMem(RxDesc.Length + SizeOf(TPacket));
- // if we don't have memory just drop the packets
- if Packet = nil then
- begin
- RxDesc.Status := E1000_RX_STATUS_DONE;
- E1000WriteRegister(Net, E1000_REG_RDT, (Tail + 1) mod Net.RxDescCount);
+ // if we don't have memory just drop the packets
+ if Packet = nil then
+ begin
+ RxDesc.Status := E1000_RX_STATUS_DONE;
+ E1000WriteRegister(Net, E1000_REG_RDT, (Tail + 1) mod Net.RxDescCount);
{$IFDEF DebugE1000} WriteDebug('e1000: no more memory, dropping packets\n', []); {$ENDIF}
- exit;
- end;
+ exit;
+ end;
- // set up the packet for higher layer
- Packet.data:= Pointer(PtrUInt(Packet) + SizeOf(TPacket));
- Packet.size:= RxDesc.Length;
- Packet.Delete:= false;
- Packet.Ready:= false;
- Packet.Next:= nil;
+ // set up the packet for higher layer
+ Packet.Data := Pointer(PtrUInt(Packet) + SizeOf(TPacket));
+ Packet.size := RxDesc.Length;
+ Packet.Delete := False;
+ Packet.Ready := False;
+ Packet.Next := nil;
- // copy to the buffer
- Data := Packet.data;
- P := Pointer(PtrUInt(Net.RxBuffer) + ((Tail + 1) mod Net.RxDescCount) * E1000_IOBUF_SIZE);
+ // copy to the buffer
+ Data := Packet.Data;
+ P := Pointer(PtrUInt(Net.RxBuffer) + ((Tail + 1) mod Net.RxDescCount) * E1000_IOBUF_SIZE);
{$IFDEF DebugE1000} WriteDebug('e1000: new packet, Size: %d\n', [RxDesc.Length]); {$ENDIF}
- for I:= 0 to RxDesc.Length-1 do
- Data^[I] := P^[I];
+ for I := 0 to RxDesc.Length - 1 do
+ Data^[I] := P^[I];
- // reset the descriptor
- RxDesc.Status := E1000_RX_STATUS_DONE;
+ // reset the descriptor
+ RxDesc.Status := E1000_RX_STATUS_DONE;
- // incrementing the tail
- E1000WriteRegister(Net, E1000_REG_RDT, (Tail + 1) mod Net.RxDescCount);
+ // incrementing the tail
+ E1000WriteRegister(Net, E1000_REG_RDT, (Tail + 1) mod Net.RxDescCount);
- // report to kernel
- EnqueueIncomingPacket(Packet);
+ // report to kernel
+ EnqueueIncomingPacket(Packet);
end;
// Read all the packets in the reception ring
procedure EmptyReadRing(Net: PE1000);
var
- Tail, Head, Current, Diff: LongInt;
- tmpHead: Longint;
+ Tail, Head, Diff: longint;
+
begin
- Head := E1000ReadRegister(Net, E1000_REG_RDH);
- Tail := E1000ReadRegister(Net, E1000_REG_RDT);
- If (Head < Tail) then
- diff := Net.RxDescCount - Tail + Head - 1
- else
- diff := Head - Tail - 1;
- {$IFDEF DebugE1000} WriteDebug('e1000: EmptyReadRing will read %d packets\n', [diff]); {$ENDIF}
- while diff <> 0 do
- begin
- // ReadPacket() moves tail
- ReadPacket(Net);
- // we recalculate Tail and we continue getting packets from the ring
Head := E1000ReadRegister(Net, E1000_REG_RDH);
Tail := E1000ReadRegister(Net, E1000_REG_RDT);
- If (Head < Tail) then
- diff := Net.RxDescCount - Tail + Head - 1
+ if (Head < Tail) then
+ diff := Net.RxDescCount - Tail + Head - 1
else
- diff := Head - Tail - 1;
- end;
+ diff := Head - Tail - 1;
+ {$IFDEF DebugE1000} WriteDebug('e1000: EmptyReadRing will read %d packets\n', [diff]); {$ENDIF}
+ while diff <> 0 do
+ begin
+ // ReadPacket() moves tail
+ ReadPacket(Net);
+ // we recalculate Tail and we continue getting packets from the ring
+ Head := E1000ReadRegister(Net, E1000_REG_RDH);
+ Tail := E1000ReadRegister(Net, E1000_REG_RDT);
+ if (Head < Tail) then
+ diff := Net.RxDescCount - Tail + Head - 1
+ else
+ diff := Head - Tail - 1;
+ end;
end;
@@ -577,41 +571,42 @@
// E1000 Irq Handler
procedure e1000Handler;
var
- Packet: PPacket;
- cause: LongInt;
+ Packet: PPacket;
+ cause: longint;
begin
- // Read the Interrupt Cause Read register
- cause:= E1000ReadRegister(@NicE1000, E1000_REG_ICR);
+ // Read the Interrupt Cause Read register
+ cause := E1000ReadRegister(@NicE1000, E1000_REG_ICR);
{$IFDEF DebugE1000} WriteDebug('e1000: Interruption, cause=%d\n', [cause]); {$ENDIF}
- if (cause <> 0) then
- begin
- // link signal
- if (cause and E1000_REG_ICR_LSC) <> 0 then
- begin
- {$IFDEF DebugE1000} WriteDebug('e1000: Link interruption\n', []); {$ENDIF}
- end;
+ if (cause <> 0) then
+ begin
+ // link signal
+ if (cause and E1000_REG_ICR_LSC) <> 0 then
+ {$IFDEF DebugE1000}
+{$ENDIF}
+ ;
- // packets received
- if ((cause and (E1000_REG_ICR_RXO or E1000_REG_ICR_RXT)) <> 0) then
- begin
- {$IFDEF DebugE1000} WriteDebug('e1000: new packet received\n', []); {$ENDIF}
- EmptyReadRing(@NicE1000);
- end;
+ // packets received
+ if ((cause and (E1000_REG_ICR_RXO or E1000_REG_ICR_RXT)) <> 0) then
+ EmptyReadRing(@NicE1000)
+{$IFDEF DebugE1000}
+{$ENDIF}
+ ;
- // packets transmitted
- if ((cause and (E1000_REG_ICR_TXQE or E1000_REG_ICR_TXDW)) <> 0) then
- begin
+ // packets transmitted
+ if ((cause and (E1000_REG_ICR_TXQE or E1000_REG_ICR_TXDW)) <> 0) then
+ begin
{$IFDEF DebugE1000} WriteDebug('e1000: Packet transmitted\n', []); {$ENDIF}
// inform the kernel that last packet has been sent, and fetch the next packet to send
Packet := DequeueOutgoingPacket;
// there are more packets?
if Packet <> nil then
- DoSendPacket(@NicE1000.DriverInterface);
- end;
- end;
- eoi;
+ DoSendPacket(@NicE1000.DriverInterface);
+ end;
+ end;
+ eoi;
end;
+{$IFNDEF NOFORMAT}
procedure e1000irqhandler; {$IFDEF FPC} [nostackframe]; assembler; {$ENDIF}
asm
{$IFDEF DCC} .noframe {$ENDIF}
@@ -651,142 +646,139 @@
db $48
db $cf
end;
+{$ENDIF}
// Look for e1000 cards on PCI bus and register it.
// Currently support for one NIC
procedure DetectE1000onPCI;
var
- I: LongInt;
- Net: PNetworkInterface;
- PciCard: PBusDevInfo;
- wd: word;
- lowadd: ^dword;
- highadd: ^word;
+ I: longint;
+ Net: PNetworkInterface;
+ PciCard: PBusDevInfo;
+ wd: word;
+ lowadd: ^dword;
+ highadd: ^word;
begin
- PciCard := PCIDevices;
+ PciCard := PCIDevices;
{$IFDEF DebugE1000} WriteDebug('e1000: scanning pci bus for e1000 driver\n', []); {$ENDIF}
- DisableInt;
- while PciCard <> nil do
- begin
- // looking for ethernet network card
- if (PciCard.mainclass = $02) and (PciCard.subclass = $00) then
- begin
- // looking for e1000 card
- if (PciCard.vendor = $8086) and (PciCard.device = $100E) then
+ DisableInt;
+ while PciCard <> nil do
begin
- NicE1000.IRQ:= PciCard.irq;
- NicE1000.Regs:= Pointer(PCIcard.io[0]);
+ // looking for ethernet network card
+ if (PciCard.mainclass = $02) and (PciCard.subclass = $00) then
+ if (PciCard.vendor = $8086) and (PciCard.device = $100E) then
+ begin
+ NicE1000.IRQ := PciCard.irq;
+ NicE1000.Regs := Pointer(PtrInt(PCIcard.io[0]));
{$IFDEF DebugE1000} WriteDebug('e1000: found e1000 device, Irq: %d, Regs: %h\n', [PciCard.irq, PCIcard.io[0]]); {$ENDIF}
- // Enable bus mastering for this device
- PciSetMaster(PciCard);
+ // Enable bus mastering for this device
+ PciSetMaster(PciCard);
- // specific for E1000_DEV_ID_82540EM
- NicE1000.eepromdonebit := 1 shl 4;
- NicE1000.eepromaddroff := 8;
+ // specific for E1000_DEV_ID_82540EM
+ NicE1000.eepromdonebit := 1 shl 4;
+ NicE1000.eepromaddroff := 8;
- // Reset network card
- e1000Reset(@NicE1000);
+ // Reset network card
+ e1000Reset(@NicE1000);
- // Link is set up
- e1000SetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_ASDE or E1000_REG_CTRL_SLU);
- e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_LRST);
- e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_PHY_RST);
- e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_ILOS);
+ // Link is set up
+ e1000SetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_ASDE or E1000_REG_CTRL_SLU);
+ e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_LRST);
+ e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, longint(E1000_REG_CTRL_PHY_RST));
+ e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_ILOS);
- // Flow control is disabled
- // TODO: qemu logs says this is invalid write
- e1000WriteRegister(@NicE1000, E1000_REG_FCAL, 0);
- e1000WriteRegister(@NicE1000, E1000_REG_FCAH, 0);
- e1000WriteRegister(@NicE1000, E1000_REG_FCT, 0);
- e1000WriteRegister(@NicE1000, E1000_REG_FCTTV, 0);
+ // Flow control is disabled
+ // TODO: qemu logs says this is invalid write
+ e1000WriteRegister(@NicE1000, E1000_REG_FCAL, 0);
+ e1000WriteRegister(@NicE1000, E1000_REG_FCAH, 0);
+ e1000WriteRegister(@NicE1000, E1000_REG_FCT, 0);
+ e1000WriteRegister(@NicE1000, E1000_REG_FCTTV, 0);
- // VLAN is disable
- e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_VME);
+ // VLAN is disable
+ e1000UnsetRegister(@NicE1000, E1000_REG_CTRL, E1000_REG_CTRL_VME);
- // Initialize statistics registers
- for I := 0 to 63 do
- e1000WriteRegister(@NicE1000, E1000_REG_CRCERRS + (I * 4), 0);
+ // Initialize statistics registers
+ for I := 0 to 63 do
+ e1000WriteRegister(@NicE1000, E1000_REG_CRCERRS + (I * 4), 0);
- // Configure the MAC address
- // read the MAC from the eeprom
- for I:=0 to 2 do
- begin
- wd := EepromEerd (@NicE1000,I);
- NicE1000.Driverinterface.HardAddress[I*2]:= wd and $ff;
- NicE1000.Driverinterface.HardAddress[(I*2+1)]:= (wd and $ff00) shr 8;
- end;
+ // Configure the MAC address
+ // read the MAC from the eeprom
+ for I := 0 to 2 do
+ begin
+ wd := EepromEerd(@NicE1000, I);
+ NicE1000.Driverinterface.HardAddress[I * 2] := wd and $ff;
+ NicE1000.Driverinterface.HardAddress[(I * 2 + 1)] := (wd and $ff00) shr 8;
+ end;
- lowadd := @NicE1000.Driverinterface.HardAddress[0];
- highadd := @NicE1000.Driverinterface.HardAddress[4];
+ lowadd := @NicE1000.Driverinterface.HardAddress[0];
+ highadd := @NicE1000.Driverinterface.HardAddress[4];
- // Set receive address
- e1000WriteRegister(@NicE1000, E1000_REG_RAL, lowadd^);
- e1000WriteRegister(@NicE1000, E1000_REG_RAH, highadd^);
- e1000SetRegister(@NicE1000, E1000_REG_RAH, E1000_REG_RAH_AV);
+ // Set receive address
+ e1000WriteRegister(@NicE1000, E1000_REG_RAL, lowadd^);
+ e1000WriteRegister(@NicE1000, E1000_REG_RAH, highadd^);
+ e1000SetRegister(@NicE1000, E1000_REG_RAH, longint(E1000_REG_RAH_AV));
- // Clear Multicast Table Array (MTA)
- for I := 0 to 127 do
- e1000WriteRegister(@NicE1000, E1000_REG_MTA + (I * 4), 0);
+ // Clear Multicast Table Array (MTA)
+ for I := 0 to 127 do
+ e1000WriteRegister(@NicE1000, E1000_REG_MTA + (I * 4), 0);
- WriteConsole('e1000: /Vdetected/n, Irq:%d\n',[PciCard.irq]);
- WriteConsole('e1000: mac /V%d:%d:%d:%d:%d:%d/n\n', [NicE1000.Driverinterface.HardAddress[0], NicE1000.Driverinterface.HardAddress[1],NicE1000.Driverinterface.HardAddress[2], NicE1000.Driverinterface.HardAddress[3], NicE1000.Driverinterface.HardAddress[4], NicE1000.Driverinterface.HardAddress[5]]);
+ WriteConsole('e1000: /Vdetected/n, Irq:%d\n', [PciCard.irq]);
+ WriteConsole('e1000: mac /V%d:%d:%d:%d:%d:%d/n\n', [NicE1000.Driverinterface.HardAddress[0], NicE1000.Driverinterface.HardAddress[1], NicE1000.Driverinterface.HardAddress[2], NicE1000.Driverinterface.HardAddress[3], NicE1000.Driverinterface.HardAddress[4], NicE1000.Driverinterface.HardAddress[5]]);
{$IFDEF DebugE1000} WriteDebug('e1000: mac %d:%d:%d:%d:%d:%d\n', [NicE1000.Driverinterface.HardAddress[0], NicE1000.Driverinterface.HardAddress[1],NicE1000.Driverinterface.HardAddress[2], NicE1000.Driverinterface.HardAddress[3], NicE1000.Driverinterface.HardAddress[4], NicE1000.Driverinterface.HardAddress[5]]); {$ENDIF}
- // buffer initialization
- if e1000initbuf(@NicE1000) then
- begin
- WriteConsole('e1000: buffer init ... /VOk/n\n',[]);
- {$IFDEF DebugE1000} WriteDebug('e1000: initbuffer() sucesses\n', []); {$ENDIF}
- end
- else
- begin
- WriteConsole('e1000: buffer init ... /RFault/n\n',[]);
+ // buffer initialization
+ if e1000initbuf(@NicE1000) then
+ WriteConsole('e1000: buffer init ... /VOk/n\n', [])
+{$IFDEF DebugE1000}
+{$ENDIF}
+ else
+ begin
+ WriteConsole('e1000: buffer init ... /RFault/n\n', []);
{$IFDEF DebugE1000} WriteDebug('e1000: initbuffer() fails, exiting\n', []); {$ENDIF}
- continue;
- end;
+ continue;
+ end;
- // enable interrupt
- e1000SetRegister(@NicE1000, E1000_REG_IMS, E1000_REG_IMS_LSC or E1000_REG_IMS_RXO or E1000_REG_IMS_RXT or E1000_REG_IMS_TXQE or E1000_REG_IMS_TXDW);
+ // enable interrupt
+ e1000SetRegister(@NicE1000, E1000_REG_IMS, E1000_REG_IMS_LSC or E1000_REG_IMS_RXO or E1000_REG_IMS_RXT or E1000_REG_IMS_TXQE or E1000_REG_IMS_TXDW);
- // clear any spurius irq
- E1000ReadRegister(@NicE1000, E1000_REG_ICR);
+ // clear any spurius irq
+ E1000ReadRegister(@NicE1000, E1000_REG_ICR);
- // get link status
- i := e1000ReadRegister(@NicE1000, E1000_REG_STATUS);
- if (i and 3 <> 0) then
- begin
- WriteConsole('e1000: link is /VUp/n\n', []);
- {$IFDEF DebugE1000} WriteDebug('e1000: Link Up\n', []); {$ENDIF}
- end
- else
- begin
- WriteConsole('e1000: link is /RDown/n\n', []);
- {$IFDEF DebugE1000} WriteDebug('e1000: Link Down\n', []); {$ENDIF}
- end;
+ // get link status
+ i := e1000ReadRegister(@NicE1000, E1000_REG_STATUS);
+ if (i and 3 <> 0) then
+ WriteConsole('e1000: link is /VUp/n\n', [])
+{$IFDEF DebugE1000}
+{$ENDIF}
+ else
+ WriteConsole('e1000: link is /RDown/n\n', [])
+{$IFDEF DebugE1000}
+{$ENDIF}
+ ;
- // capture de interrupt
- CaptureInt(32+NicE1000.IRQ, @e1000irqhandler);
+ // capture de interrupt
+ CaptureInt(32 + NicE1000.IRQ, @e1000irqhandler);
- // registre network driver
- Net := @NicE1000.Driverinterface;
- Net.Name:= 'e1000';
- Net.MaxPacketSize:= E1000_IOBUF_SIZE;
- Net.start:= @e1000Start;
- Net.send:= @e1000Send;
- Net.stop:= @e1000Stop;
- Net.Reset:= @e1000Reset;
- Net.TimeStamp := 0;
- RegisterNetworkInterface(Net);
- end;
+ // registre network driver
+ Net := @NicE1000.Driverinterface;
+ Net.Name := 'e1000';
+ Net.MaxPacketSize := E1000_IOBUF_SIZE;
+ Net.start := @e1000Start;
+ Net.send := @e1000Send;
+ Net.stop := @e1000Stop;
+ Net.Reset := @e1000Reset;
+ Net.TimeStamp := 0;
+ RegisterNetworkInterface(Net);
+ end// looking for e1000 card
+ ;
+ PciCard := PciCard.Next;
end;
- PciCard := PciCard.Next;
- end;
RestoreInt;
{$IFDEF DebugE1000} WriteDebug('e1000: scan ended\n', []); {$ENDIF}
end;
initialization
- DetectE1000onPCI;
+ DetectE1000onPCI;
end.
Index: rtl/libc.pas
===================================================================
--- rtl/libc.pas (revision 194)
+++ rtl/libc.pas (working copy)
@@ -321,7 +321,7 @@
procedure _lldiv;
asm
- PUSH EBX
+ PUSHd EBX
PUSH ESI
PUSH EDI
MOV EBX, [RSP+16]
Index: rtl/Memory.pas
===================================================================
--- rtl/Memory.pas (revision 194)
+++ rtl/Memory.pas (working copy)
@@ -763,7 +763,7 @@
PageStart := PageStart-PAGE_SIZE;
// StartPage is a Page_Size multipler
StartPage := Pointer(PageStart);
- Size := Size + PtrUInt(Add) mod PAGE_SIZE;
+ Size := Size + {%H-}PtrUInt(Add) mod PAGE_SIZE;
PageCount := Size div PAGE_SIZE;
if Size mod PAGE_SIZE <> 0 then
Inc(PageCount);
@@ -796,7 +796,7 @@
PageStart := PageStart-PAGE_SIZE;
// StartPage is a Page_Size multipler
StartPage := Pointer(PageStart);
- Size := Size + PtrUInt(Add) mod PAGE_SIZE;
+ Size := Size + {%H-}PtrUInt(Add) mod PAGE_SIZE;
PageCount := Size div PAGE_SIZE;
if Size mod PAGE_SIZE <> 0 then
Inc(PageCount);
@@ -865,7 +865,7 @@
ID := 1;
// First Region must start at ALLOC_MEMORY_START
// Starts at ALLOC_MEMORY_START. The first ALLOC_MEMORY_START are used for internal usage
- while GetMemoryRegion(ID, @Buff) <> 0 do
+ while GetMemoryRegion(ID, Buff) <> 0 do
begin
if (Buff.Base < ALLOC_MEMORY_START) and (Buff.Base+Buff.Length-1 > ALLOC_MEMORY_START) and (Buff.Flag <> MEM_RESERVED) then
Break;
@@ -902,7 +902,7 @@
Counter := 0;
// looking for a free block of memory
Inc(ID);
- while GetMemoryRegion(ID, @Buff) <> 0 do
+ while GetMemoryRegion(ID, Buff) <> 0 do
begin
if Buff.Flag = MEM_AVAILABLE then
Break;
@@ -917,7 +917,7 @@
Counter := Counter-Amount;
// looking for a free block of memory
Inc(ID);
- while GetMemoryRegion(ID, @Buff) <> 0 do
+ while GetMemoryRegion(ID, Buff) <> 0 do
begin
if Buff.Flag = MEM_AVAILABLE then
Break;
Index: rtl/system.pas
===================================================================
--- rtl/system.pas (revision 194)
+++ rtl/system.pas (working copy)
@@ -12,7 +12,7 @@
**********************************************************************}
unit System;
-
+{$WARN 5033 off : Function result does not seem to be set}
interface
{$DEFINE FPC_IS_SYSTEM}
@@ -35,6 +35,7 @@
{$maxfpuregisters 0}
{$endif CPUI386}
+{$undef FPC_HAS_FEATURE_WIDESTRINGS}
{ needed for insert,delete,readln }
{$P+}
@@ -151,6 +152,12 @@
PVariant = ^Variant;
POleVariant = ^OleVariant;
+{by JC (from FCL)}
+ TFileTextRecChar = {$if defined(FPC_ANSI_TEXTFILEREC) or not(defined(FPC_HAS_FEATURE_WIDESTRINGS))}AnsiChar{$else}UnicodeChar{$endif};
+ PFileTextRecChar = ^TFileTextRecChar;
+
+ CodePointer = pointer;
+
TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR);
LARGE_INTEGER = record
@@ -1599,12 +1606,15 @@
procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
procedure RTLeventsync(m:trtlmethod;p:tprocedure);
+{by JC includes from FP-RTL}
+{$I filerec.inc}
+{$I textrec.inc}
{*****************************************************************************
Resources support
*****************************************************************************}
const
- LineEnding = #10;
+ LineFeed = #10;
LFNSupport = true;
DirectorySeparator = '/';
DriveSeparator = ':';
@@ -1622,7 +1632,7 @@
FileNameCaseSensitive : boolean = true;
CtrlZMarksEOF: boolean = false;
- sLineBreak = LineEnding;
+ sLineBreak = LineFeed;
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
@@ -4778,7 +4788,21 @@
AnsiRecLen = SizeOf(TAnsiRec);
FirstOff = SizeOf(TAnsiRec)-1;
+ {****************************************************************************}
+ { Memory manager }
+ const
+ MemoryManager: TMemoryManager = (
+ NeedLock: true;
+ GetMem: @SysGetMem;
+ FreeMem: @SysFreeMem;
+ FreeMemSize: @SysFreeMemSize;
+ AllocMem: @SysAllocMem;
+ ReAllocMem: @SysReAllocMem;
+ MemSize: nil;
+ );
+
+
{****************************************************************************
Internal functions, not in interface.
****************************************************************************}
@@ -5046,7 +5070,7 @@
If Size>high_of_res then
Size:=high_of_res;
Move (S2[1],fpc_AnsiStr_To_ShortStr[1],Size);
- byte(fpc_AnsiStr_To_ShortStr[0]):=byte(Size);
+ setlength(fpc_AnsiStr_To_ShortStr,Size);
end;
end;
@@ -5059,7 +5083,7 @@
Size : SizeInt;
begin
Size:=Length(S2);
- Setlength (fpc_ShortStr_To_AnsiStr,Size);
+ Setlength (result,Size);
if Size>0 then
Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
end;
@@ -5318,7 +5342,10 @@
else if PAnsiRec(Pointer(S)-AnsiFirstOff)^.Ref=1 then
begin
Temp:=Pointer(s)-AnsiFirstOff;
- //lens:=MemSize(Temp);
+ if assigned(memoryManager.MemSize) then
+ lens:=memoryManager.MemSize(Temp)
+ else
+ lens := AnsiFirstOff+L+sizeof(AnsiChar);
lena:=AnsiFirstOff+L+sizeof(AnsiChar);
{ allow shrinking string if that saves at least half of current size }
if (lena>lens) or ((lens>32) and (lena<=(lens div 2))) then
@@ -5386,10 +5413,10 @@
{
Make sure reference count of S is 1,
using copy-on-write semantics.
-}
Var
SNew : Pointer;
- L : SizeInt;
+ L : SizeInt; }
+
begin
pointer(result) := pointer(s);
// todo: to check this
@@ -5436,8 +5463,7 @@
Index := 0;
{ Check Size. Accounts for Zero-length S, the double check is needed because
Size can be maxint and will get <0 when adding index }
- if (Size>Length(S)) or
- (Index+Size>Length(S)) then
+ if Index+Size>Length(S) then
Size:=Length(S)-Index;
If Size>0 then
begin
@@ -7206,22 +7232,22 @@
variantmanager.varneg(dest);
end;
-operator =(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator {%H-}=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
// dest:=variantmanager.cmpop(op1,op2,opcmpeq);
end;
-operator <(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator {%H-}<(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
// dest:=variantmanager.cmpop(op1,op2,opcmplt);
end;
-operator >(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator {%H-}>(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
// dest:=variantmanager.cmpop(op1,op2,opcmpgt);
end;
-operator >=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator {%H-}>=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
// dest:=variantmanager.cmpop(op1,op2,opcmpge);
end;
@@ -8331,21 +8357,7 @@
{$endif}
-{****************************************************************************}
-{ Memory manager }
-const
- MemoryManager: TMemoryManager = (
- NeedLock: true;
- GetMem: @SysGetMem;
- FreeMem: @SysFreeMem;
- FreeMemSize: @SysFreeMemSize;
- AllocMem: @SysAllocMem;
- ReAllocMem: @SysReAllocMem;
- MemSize: nil;
- );
-
-
{*****************************************************************************
Memory Manager
*****************************************************************************}
@@ -8362,7 +8374,7 @@
end;
-function IsMemoryManagerSet:Boolean;
+function {%H-}IsMemoryManagerSet:Boolean;
begin
//IsMemoryManagerSet := (MemoryManager.GetMem<>@SysGetMem) or (MemoryManager.FreeMem<>@SysFreeMem);
end;
@@ -8382,7 +8394,7 @@
end;
{ Delphi style }
-function FreeMem(P: Pointer): PtrInt;
+function {%H-}FreeMem(P: Pointer): PtrInt;
begin
//Freemem := MemoryManager.FreeMem(P);
end;
@@ -8394,13 +8406,13 @@
//Result := MemoryManager.GetMem(Size);
end;
-function GetMemory(size:ptrint):pointer;
+function {%H-}GetMemory(size:ptrint):pointer;
begin
//GetMemory := Getmem(size);
end;
-function ReAllocMem(var P: Pointer; NewSize: PtrUInt): Pointer;
+function {%H-}ReAllocMem(var P: Pointer; NewSize: PtrUInt): Pointer;
begin
//Result := MemoryManager.g(P, NewSize);
end;
@@ -8438,7 +8450,7 @@
Result := 0;
end;
-function SysAllocMem(Size: PtrInt): Pointer;
+function {%H-}SysAllocMem(Size: PtrInt): Pointer;
begin
// Result := MemoryManager.GetMem(size);
// if Result <> nil then
Index: tests
===================================================================
--- tests (revision 194)
+++ tests (working copy)
Property changes on: tests
___________________________________________________________________
Added: svn:ignore
## -0,0 +1,2 ##
+*.qemu
+backup
Index: tests/ToroException.lpi
===================================================================
--- tests/ToroException.lpi (revision 194)
+++ tests/ToroException.lpi (nonexistent)
@@ -1,94 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Index: tests/ToroException.pas
===================================================================
--- tests/ToroException.pas (revision 194)
+++ tests/ToroException.pas (nonexistent)
@@ -1,99 +0,0 @@
-//
-// Toro Exceptions Example
-//
-// Changes :
-//
-// 24.8.2016 First Version by Matias E. Vara.
-//
-// Copyright (c) 2003-2017 Matias Vara
-// All Rights Reserved
-//
-//
-// This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation, either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see .
-//
-
-program ToroException;
-
-
-{$IFDEF FPC}
- {$mode delphi}
-{$ENDIF}
-
-// Configuring the RUN for Lazarus
-{$IFDEF WIN64}
- {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -drive format=raw,file=ToroException.img}
-{$ELSE}
- {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -drive format=raw,file=ToroException.img}
-{$ENDIF}
-{%RunFlags BUILD-}
-
-// Adding support for FPC 2.0.4 ;)
-{$IMAGEBASE 4194304}
-
-// they are declared just the necessary units
-// the units used depend the hardware where you are running the application
-uses
- Kernel in 'rtl\Kernel.pas',
- Process in 'rtl\Process.pas',
- Memory in 'rtl\Memory.pas',
- Debug in 'rtl\Debug.pas',
- Arch in 'rtl\Arch.pas',
- Filesystem in 'rtl\Filesystem.pas',
- Console in 'rtl\Drivers\Console.pas';
-
-var
- tmp: TThreadID;
-
-function Exception_Core2(Param: Pointer):PtrInt;
-begin
- {$ASMMODE intel}
- asm
- mov rbx, 1987
- mov rax, 166
- mov rcx, 0
- mov rdx, 555
- div rcx
- end;
-end;
-
-// This procedure is a exception handler.
-// It has to enable the interruptions and finish the thread who made the exception
-procedure MyOwnHandler;
-begin
- WriteConsole('Hello from My Handler!\n',[]);
- // enable interruptions
- asm
- sti
- end;
- ThreadExit(True);
-end;
-
-
-begin
- WriteConsole('\c',[]);
-
- //CaptureInt(EXC_DIVBYZERO, @MyOwnHandler);
-
- tmp:= BeginThread(nil, 4096, Exception_Core2, nil, 1, tmp);
- SysThreadSwitch;
-
- {$ASMMODE intel}
- asm
- mov rbx, 1987
- mov rax, 166
- mov rcx, 0
- mov rdx, 555
- div rcx
- end;
-end.
Index: tests/ToroHello.lpi
===================================================================
--- tests/ToroHello.lpi (revision 194)
+++ tests/ToroHello.lpi (nonexistent)
@@ -1,94 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Index: tests/ToroHello.pas
===================================================================
--- tests/ToroHello.pas (revision 194)
+++ tests/ToroHello.pas (nonexistent)
@@ -1,58 +0,0 @@
-//
-// Toro Hello World Example.
-// Clasical example using a minimal kernel to print "Hello World"
-//
-// Changes :
-//
-// 16/09/2011 First Version by Matias E. Vara.
-//
-// Copyright (c) 2003-2017 Matias Vara
-// All Rights Reserved
-//
-// This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation, either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see .
-//
-
-program ToroHello;
-
-{$IFDEF FPC}
- {$mode delphi}
-{$ENDIF}
-
-{$IMAGEBASE 4194304}
-
-// Configuring the RUN for Lazarus
-{$IFDEF WIN64}
- {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
-{$ELSE}
- {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroHello.img}
-{$ENDIF}
-{%RunFlags BUILD-}
-
-// They are declared just the necessary units
-// The needed units depend on the hardware where you are running the application
-uses
- Kernel in '..\rtl\Kernel.pas',
- Process in '..\rtl\Process.pas',
- Memory in '..\rtl\Memory.pas',
- Debug in '..\rtl\Debug.pas',
- Arch in '..\rtl\Arch.pas',
- Filesystem in '..\rtl\Filesystem.pas',
- Pci in '..\rtl\Drivers\Pci.pas',
- Console in '..\rtl\Drivers\Console.pas';
-
-begin
- WriteConsole('\c/RHello World, I am TORO!!!\n',[0]);
- while True do
- SysThreadSwitch;
-end.
Index: tests/ToroHttp.lpi
===================================================================
--- tests/ToroHttp.lpi (revision 194)
+++ tests/ToroHttp.lpi (nonexistent)
@@ -1,94 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Index: tests/ToroHttp.pas
===================================================================
--- tests/ToroHttp.pas (revision 194)
+++ tests/ToroHttp.pas (nonexistent)
@@ -1,131 +0,0 @@
-//
-// Toro Http example.
-//
-// This imple program shows how can be used the stack TCP/IP.
-// The service listens at port 80 and it says "Hello" when a new
-// connection arrives and then it closes it.
-//
-// Changes :
-// 2017 / 01 / 04 : Minor fixes
-// 2016 / 12 / 22 : First working version by Matias Vara
-// 2011 / 07 / 30 : Some stuff around the resource dedication
-//
-// Copyright (c) 2003-2017 Matias Vara
-// All Rights Reserved
-//
-// This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation, either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see .
-//
-
-program ToroHttp;
-
-{$IFDEF FPC}
- {$mode delphi}
-{$ENDIF}
-
-// Configuring the RUN for Lazarus
-{$IFDEF WIN64}
- {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -net nic,model=ne2k_pci -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroHttp.img}
-{$ELSE}
- {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -net nic,model=ne2k_pci -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroHttp.img}
-{$ENDIF}
-{%RunFlags BUILD-}
-
-{$IMAGEBASE 4194304}
-
-// They are declared just the necessary units
-// The units used depend the hardware where you are running the application
-uses
- Kernel in '..\rtl\Kernel.pas',
- Process in '..\rtl\Process.pas',
- Memory in '..\rtl\Memory.pas',
- Debug in '..\rtl\Debug.pas',
- Arch in '..\rtl\Arch.pas',
- Filesystem in '..\rtl\Filesystem.pas',
- Pci in '..\rtl\Drivers\Pci.pas',
- Network in '..\rtl\Network.pas',
- Console in '..\rtl\Drivers\Console.pas',
- Ne2000 in '..\rtl\Drivers\Ne2000.pas';
-
-const
- Welcome: PChar = 'Hello from Toro!'+#13#10;
- MaskIP: array[0..3] of Byte = (255, 255, 255, 0);
- Gateway: array[0..3] of Byte = (192, 100, 200, 1);
- LocalIP: array[0..3] of Byte = (192, 100, 200, 100);
-
-var
- HttpServer: PSocket;
- Buffer: char;
-
-// Socket initialization
-procedure HttpInit;
-begin
- HttpServer := SysSocket(SOCKET_STREAM);
- HttpServer.Sourceport := 80;
- SysSocketListen(HttpServer, 50);
-end;
-
-// callback when a new connection arrives
-function HttpAccept(Socket: PSocket): LongInt;
-begin
- WriteConsole('New connection on port 80\n',[0]);
- // we wait for a new event or a timeout, i.e., 50s
- SysSocketSelect(Socket, 500000);
- Result := 0;
-end;
-
-// New data received from Socket, we can read the data and return to Network Service thread
-function HttpReceive(Socket: PSocket): LongInt;
-begin
- // we keep reading until there is no more data
- while SysSocketRecv(Socket, @Buffer,1,0) <> 0 do;
- SysSocketSend(Socket, Welcome, strlen(Welcome), 0);
- WriteConsole ('Closing conection\n',[]);
- // todo: this can close the socket two times!!!!!
- SysSocketClose(Socket);
- Result := 0;
-end;
-
- // Peer socket disconnected
-function HttpClose(Socket: PSocket): LongInt;
-begin
- WriteConsole ('Remote Host Closed the conection\n',[]);
- SysSocketClose(Socket);
- Result := 0;
-end;
-
- // TimeOut
-function HttpTimeOut(Socket: PSocket): LongInt;
-begin
- WriteConsole ('Closing connection for timeout\n',[]);
- SysSocketClose(Socket);
- Result := 0;
-end;
-
-var
- HttpHandler: TNetworkHandler;
-begin
- // Dedicate the ne2000 network card to local cpu
- DedicateNetwork('ne2000', LocalIP, Gateway, MaskIP, nil);
- WriteConsole('Listening at port 80\n',[0]);
- // we set the call backs used by the kernel
- HttpHandler.DoInit := @HttpInit;
- HttpHandler.DoAccept := @HttpAccept;
- HttpHandler.DoTimeOut := @HttpTimeOut;
- HttpHandler.DoReceive := @HttpReceive;
- HttpHandler.DoClose := @HttpClose;
- // we register the service
- SysRegisterNetworkService(@HttpHandler);
- while True do
- SysThreadSwitch;
-end.
Index: tests/ToroKeyb.lpi
===================================================================
--- tests/ToroKeyb.lpi (revision 194)
+++ tests/ToroKeyb.lpi (nonexistent)
@@ -1,94 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Index: tests/ToroKeyb.pas
===================================================================
--- tests/ToroKeyb.pas (revision 194)
+++ tests/ToroKeyb.pas (nonexistent)
@@ -1,60 +0,0 @@
-//
-// ToroKeyb
-// Example that shows the keyboard apis
-//
-// Changes :
-//
-// 16/09/2011 First Version by Matias E. Vara.
-//
-// Copyright (c) 2003-2017 Matias Vara
-// All Rights Reserved
-//
-//
-// This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation, either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see .
-//
-
-program ToroKeyb;
-
-
-{$IFDEF FPC}
- {$mode delphi}
-{$ENDIF}
-
-{$IMAGEBASE 4194304}
-
-// Configuring the RUN for Lazarus
-{$IFDEF WIN64}
- {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroKeyb.img}
-{$ELSE}
- {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroKeyb.img}
-{$ENDIF}
-{%RunFlags BUILD-}
-
-// They are declared just the necessary units
-// The units used depend the hardware where you are running the application
-uses
- Kernel in 'rtl\Kernel.pas',
- Process in 'rtl\Process.pas',
- Memory in 'rtl\Memory.pas',
- Debug in 'rtl\Debug.pas',
- Arch in 'rtl\Arch.pas',
- Filesystem in 'rtl\Filesystem.pas',
- Console in 'rtl\Drivers\Console.pas';
-
-begin
- WriteConsole('\c/vPress a Key ...\n',[0]);
- EnabledConsole;
- while True do
- SysThreadSwitch;
-end.
Index: tests/ToroPing.lpi
===================================================================
--- tests/ToroPing.lpi (revision 194)
+++ tests/ToroPing.lpi (nonexistent)
@@ -1,94 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Index: tests/ToroPing.pas
===================================================================
--- tests/ToroPing.pas (revision 194)
+++ tests/ToroPing.pas (nonexistent)
@@ -1,100 +0,0 @@
-//
-// Toro Ping example.
-//
-// Changes :
-// 08 / 12 / 2016 : First Version by Matias Vara
-//
-// Copyright (c) 2003-2017 Matias Vara
-// All Rights Reserved
-//
-// This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation, either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see .
-//
-
-program ToroPing;
-
-{$IFDEF FPC}
- {$mode delphi}
-{$ENDIF}
-
-// Configuring the RUN for Lazarus
-{$IFDEF WIN64}
- {%RunCommand qemu-system-x86_64.exe -m 256 -smp 2 -net nic,model=e1000 -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroPing.img}
-{$ELSE}
- {%RunCommand qemu-system-x86_64 -m 256 -smp 2 -net nic,model=e1000 -net tap,ifname=TAP2 -serial file:torodebug.txt -drive format=raw,file=ToroPing.img}
-{$ENDIF}
-{%RunFlags BUILD-}
-
-{$IMAGEBASE 4194304}
-
-// They are declared just the necessary units
-// The units used depend on the hardware in which you run the application
-uses
- Kernel in '..\rtl\Kernel.pas',
- Process in '..\rtl\Process.pas',
- Memory in '..\rtl\Memory.pas',
- Debug in '..\rtl\Debug.pas',
- Arch in '..\rtl\Arch.pas',
- Filesystem in '..\rtl\Filesystem.pas',
- Pci in '..\rtl\Drivers\Pci.pas',
- Network in '..\rtl\Network.pas',
- Console in '..\rtl\Drivers\Console.pas',
- E1000 in '..\rtl\Drivers\E1000.pas';
-
-const
- MaskIP: array[0..3] of Byte = (255, 255, 255, 0);
- Gateway: array[0..3] of Byte = (192, 100, 200, 1);
- LocalIP: array[0..3] of Byte = (192, 100, 200, 100);
- // this ip may change depending on windows or linux host
- PingIP: array[0..3] of Byte = (192, 100, 200, 10);
- // wait for ping in seconds
- WAIT_FOR_PING = 1;
-var
- PingIPDword: Dword;
- PingPacket: PPacket;
- PingContent: Pchar = 'abcdefghijklmtororstuvwabcdefghi';
- seq: word = 90;
- IP: PIPHeader;
- ICMP: PICMPHeader;
-begin
- // Dedicate the ne2000 network card to local cpu
- DedicateNetwork('e1000', LocalIP, Gateway, MaskIP, nil);
-
- // I convert the IP to a DWord
- _IPAddress (PingIP, PingIPDword);
-
- // I keep sending ICMP packets and waiting for an answer
- WriteConsole ('\t ToroPing: This test sends ICMP packets every %ds\n',[WAIT_FOR_PING]);
- while true do
- begin
- WriteConsole ('\t ToroPing: /Vsending/n ping to %d.%d.%d.%d, seq: %d\n',[PingIP[0],PingIP[1],PingIP[2],PingIP[3],seq]);
- ICMPSendEcho (PingIPDword,PingContent, 32,seq,0);
- PingPacket := ICMPPoolPackets;
- if (PingPacket <> nil) then
- begin
- IP := Pointer(PtrUInt(PingPacket.Data)+SizeOf(TEthHeader));
- ICMP := Pointer(PtrUInt(PingPacket.Data)+SizeOf(TEthHeader)+SizeOf(TIPHeader));
- if ((IP.SourceIP = PingIPDword) and (ICMP.seq = SwapWORD(seq))) then
- begin
- WriteConsole ('\t ToroPing: /areceived/n ping from %d.%d.%d.%d\n',[PingIP[0],PingIP[1],PingIP[2],PingIP[3]]);
- end else WriteConsole ('\t ToroPing: /rwrong/n received ping, seq=%d\n',[SwapWORD(ICMP.seq)]);
- ToroFreeMem (PingPacket);
- end else WriteConsole ('\t ToroPing: /rno received/n ping from %d.%d.%d.%d\n',[PingIP[0],PingIP[1],PingIP[2],PingIP[3]]);
-
- // I increment the seq for next packet
- seq := seq + 1;
-
- // I wait WAIT_FOR_PING seconds
- sleep (WAIT_FOR_PING * 1000);
- end;
-end.
Index: tests/ToroThread.lpi
===================================================================
--- tests/ToroThread.lpi (revision 194)
+++ tests/ToroThread.lpi (nonexistent)
@@ -1,93 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Index: tests/ToroThread.pas
===================================================================
--- tests/ToroThread.pas (revision 194)
+++ tests/ToroThread.pas (nonexistent)
@@ -1,119 +0,0 @@
-//
-// Toro Multithreading Example
-//
-// I have implemented three task (T1, T2 and T3), T1 runs in core 0 while T2 and T3 runs in core1.
-// T1 and T2 have a data dependency, hence while T1 runs T2 must not, this was implemented with a few
-// boolean variables like a semaphore. It could be great to implemented at kernel level thus the user has not
-// take in care about that stuff.
-// Besides, this is a good example about static scheduling where we are sure about the execution order previusly.
-//
-// Changes :
-//
-// 22/06/2012 First Version by Matias E. Vara.
-//
-// Copyright (c) 2003-2017 Matias Vara
-// All Rights Reserved
-//
-//
-// This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation, either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see .
-//
-
-program ToroThread;
-
-
-{$IFDEF FPC}
- {$mode delphi}
-{$ENDIF}
-
-{$IMAGEBASE 4194304}
-// Configuring the RUN for Lazarus
-{$IFDEF WIN64}
- {%RunCommand qemu-system-x86_64.exe -m 512 -smp 2 -drive format=raw,file=ToroThread.img}
-{$ELSE}
- {%RunCommand qemu-system-x86_64 -m 512 -smp 2 -drive format=raw,file=ToroThread.img}
-{$ENDIF}
-{%RunFlags BUILD-}
-
-
-
-
-// they are declared just the necessary units
-// the units used depend the hardware where you are running the application
-uses
- Kernel in 'rtl\Kernel.pas',
- Process in 'rtl\Process.pas',
- Memory in 'rtl\Memory.pas',
- Debug in 'rtl\Debug.pas',
- Arch in 'rtl\Arch.pas',
- Filesystem in 'rtl\Filesystem.pas',
- Console in 'rtl\Drivers\Console.pas';
-
-
-var
- tmp: TThreadID;
- var1, var2, var3: longint;
- // sincronization variable to avoid the execution of task2 and task1 at the same time
- n1: boolean = true;
- n2: boolean = false;
-
-// task 2
-function ThreadF2(Param: Pointer):PtrInt;
-begin
- while true do
- begin
- while n2=false do SysThreadSwitch;
- var3:=var2+7;
- n2:= false;
- n1:= true ;
- end
-end;
-
-
-// task3
-function ThreadF3(Param: Pointer):PtrInt;
-begin
- while true do
- begin
- var1:=var3 mod 11;
- SysThreadSwitch;
- end;
-end;
-
-
-begin
-
- WriteConsole('\c',[0]);
- // initial values
- var1:=0;
- var2:=4;
- var3:=11;
-
- // we create a remote thread
- tmp:= BeginThread(nil, 4096, ThreadF3, nil, 1, tmp);
- tmp:= BeginThread(nil, 4096, ThreadF2, nil, 1, tmp);
-
- // task1 is implemented using main thread in order to keep the scheduler
- // as stable as possible
- while true do
- begin
- while n1=false do SysThreadSwitch;
- var2:=var1+5;
- // this WriteConsole() adds much noise given that it implements atomic operations
- WriteConsole('%d',[var1]);
- // syncro flags
- n1:=false;
- n2:=true;
- end;
-
-end.
Index: tests/uToroException.pas
===================================================================
--- tests/uToroException.pas (nonexistent)
+++ tests/uToroException.pas (working copy)
@@ -0,0 +1,85 @@
+// Toro Exceptions Example
+
+// Changes :
+
+// 24.8.2016 First Version by Matias E. Vara.
+
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+
+
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+unit uToroException;
+
+{$mode delphi}
+
+interface
+
+uses
+ Process,
+ Console;
+
+procedure Main;
+
+implementation
+
+
+var
+ tmp: TThreadID;
+
+function Exception_Core2(Param: Pointer): PtrInt;
+begin
+{$ASMMODE intel}
+ asm
+ MOV RBX, 1987
+ MOV RAX, 166
+ MOV RCX, 0
+ MOV RDX, 555
+ DIV RCX
+ end;
+end;
+
+// This procedure is a exception handler.
+// It has to enable the interruptions and finish the thread who made the exception
+procedure MyOwnHandler;
+begin
+ WriteConsole('Hello from My Handler!\n', []);
+ // enable interruptions
+ asm
+ STI
+ end;
+ ThreadExit(True);
+end;
+
+procedure Main;
+
+begin
+ WriteConsole('\c', []);
+
+ //CaptureInt(EXC_DIVBYZERO, @MyOwnHandler);
+
+ tmp := BeginThread(nil, 4096, Exception_Core2, nil, 1, tmp);
+ SysThreadSwitch;
+
+{$ASMMODE intel}
+ asm
+ MOV RBX, 1987
+ MOV RAX, 166
+ MOV RCX, 0
+ MOV RDX, 555
+ DIV RCX
+ end;
+end;
+
+end.
Index: tests/uToroHttp.pas
===================================================================
--- tests/uToroHttp.pas (nonexistent)
+++ tests/uToroHttp.pas (working copy)
@@ -0,0 +1,116 @@
+//
+// Toro Http example.
+//
+// This imple program shows how can be used the stack TCP/IP.
+// The service listens at port 80 and it says "Hello" when a new
+// connection arrives and then it closes it.
+//
+// Changes :
+// 2017 / 01 / 04 : Minor fixes
+// 2016 / 12 / 22 : First working version by Matias Vara
+// 2011 / 07 / 30 : Some stuff around the resource dedication
+//
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+//
+
+unit uToroHttp;
+
+{$mode delphi}
+
+interface
+
+
+Procedure Main;
+
+implementation
+
+uses
+ Console,Network;
+
+const
+ Welcome: PChar = 'Hello from Toro!'+#13#10;
+ MaskIP: array[0..3] of Byte = (255, 255, 255, 0);
+ Gateway: array[0..3] of Byte = (192, 100, 200, 1);
+ LocalIP: array[0..3] of Byte = (192, 100, 200, 100);
+
+var
+ HttpServer: PSocket;
+ Buffer: char;
+
+// Socket initialization
+procedure HttpInit;
+begin
+ HttpServer := SysSocket(SOCKET_STREAM);
+ HttpServer.Sourceport := 80;
+ SysSocketListen(HttpServer, 50);
+end;
+
+// callback when a new connection arrives
+function HttpAccept(Socket: PSocket): LongInt;
+begin
+ WriteConsole('New connection on port 80\n',[0]);
+ // we wait for a new event or a timeout, i.e., 50s
+ SysSocketSelect(Socket, 500000);
+ Result := 0;
+end;
+
+// New data received from Socket, we can read the data and return to Network Service thread
+function HttpReceive(Socket: PSocket): LongInt;
+begin
+ // we keep reading until there is no more data
+ while SysSocketRecv(Socket, @Buffer,1,0) <> 0 do;
+ SysSocketSend(Socket, Welcome, strlen(Welcome), 0);
+ WriteConsole ('Closing conection\n',[]);
+ // todo: this can close the socket two times!!!!!
+ SysSocketClose(Socket);
+ Result := 0;
+end;
+
+ // Peer socket disconnected
+function HttpClose(Socket: PSocket): LongInt;
+begin
+ WriteConsole ('Remote Host Closed the conection\n',[]);
+ SysSocketClose(Socket);
+ Result := 0;
+end;
+
+ // TimeOut
+function HttpTimeOut(Socket: PSocket): LongInt;
+begin
+ WriteConsole ('Closing connection for timeout\n',[]);
+ SysSocketClose(Socket);
+ Result := 0;
+end;
+
+Procedure Main;
+var
+ HttpHandler: TNetworkHandler;
+begin
+ // Dedicate the ne2000 network card to local cpu
+ DedicateNetwork('ne2000', LocalIP, Gateway, MaskIP, nil);
+ WriteConsole('Listening at port 80\n',[0]);
+ // we set the call backs used by the kernel
+ HttpHandler.DoInit := @HttpInit;
+ HttpHandler.DoAccept := @HttpAccept;
+ HttpHandler.DoTimeOut := @HttpTimeOut;
+ HttpHandler.DoReceive := @HttpReceive;
+ HttpHandler.DoClose := @HttpClose;
+ // we register the service
+ SysRegisterNetworkService(@HttpHandler);
+end;
+end.
+
Index: tests/uToroKeyb.pas
===================================================================
--- tests/uToroKeyb.pas (nonexistent)
+++ tests/uToroKeyb.pas (working copy)
@@ -0,0 +1,45 @@
+
+// ToroKeyb
+// Example that shows the keyboard apis
+
+// Changes :
+
+// 16/09/2011 First Version by Matias E. Vara.
+
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+
+
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+unit uToroKeyb;
+
+{$mode delphi}
+
+interface
+
+uses
+ Console;
+
+procedure Main;
+
+implementation
+
+procedure Main;
+
+begin
+ WriteConsole('\c/vPress a Key ...\n', [0]);
+ EnabledConsole;
+end;
+
+end.
Index: tests/uToroPing.pas
===================================================================
--- tests/uToroPing.pas (nonexistent)
+++ tests/uToroPing.pas (working copy)
@@ -0,0 +1,100 @@
+
+// Toro Ping example.
+
+// Changes :
+// 08 / 12 / 2016 : First Version by Matias Vara
+
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+
+unit uToroPing;
+
+{$mode delphi}
+
+interface
+
+type
+ TIPAddr = array[0..3] of byte;
+
+procedure Main(PingIPDword: Dword);
+function Init(const PingIP: TIPAddr): Dword;
+
+const
+ MaskIP: TIPAddr = (255, 255, 255, 0);
+ Gateway: TIPAddr = (192, 100, 200, 1);
+ LocalIP: TIPAddr = (192, 100, 200, 100);
+ // this ip may change depending on windows or linux host
+ PingIP: TIPAddr = (192, 168, 0, 98);// (192, 100, 200, 10);
+ // wait for ping in seconds
+ WAIT_FOR_PING = 1;
+
+implementation
+
+uses
+ Process,
+ Memory,
+ Network,
+ Console;
+// E1000;
+
+function Init(const PingIP: TIPAddr): Dword;
+begin
+ // Dedicate the ne2000 network card to local cpu
+ {Network.}DedicateNetwork('e1000', LocalIP, Gateway, MaskIP, nil);
+
+ // I convert the IP to a DWord
+ {Network.}_IPAddress(PingIP, Result);
+
+ // I keep sending ICMP packets and waiting for an answer
+ {Console.}WriteConsole('\t/R ToroPing: This test sends ICMP packets every %ds\n', [WAIT_FOR_PING]);
+end;
+
+procedure Main(PingIPDword: Dword);
+var
+
+ PingPacket: {Network.}PPacket;
+ PingContent: PChar = 'abcdefghijklmtororstuvwabcdefghi';
+ seq: word = 90;
+ IP: {Network.}PIPHeader;
+ ICMP: {Network.}PICMPHeader;
+begin
+ while True do
+ begin
+ {Console.}WriteConsole('\t ToroPing: /Vsending/n ping to %d.%d.%d.%d, seq: %d\n', [PingIP[0], PingIP[1], PingIP[2], PingIP[3], seq]);
+ {Network.}ICMPSendEcho(PingIPDword, PingContent, 32, seq, 0);
+ PingPacket := {Network.}ICMPPoolPackets;
+ if (PingPacket <> nil) then
+ begin
+ IP := Pointer(PtrUInt(PingPacket.Data) + SizeOf(TEthHeader));
+ ICMP := Pointer(PtrUInt(PingPacket.Data) + SizeOf(TEthHeader) + SizeOf(TIPHeader));
+ if ((IP.SourceIP = PingIPDword) and (ICMP.seq = SwapWORD(seq))) then
+ {Console.}WriteConsole('\t ToroPing: /areceived/n ping from %d.%d.%d.%d\n', [PingIP[0], PingIP[1], PingIP[2], PingIP[3]])
+ else
+ {Console.}WriteConsole('\t ToroPing: /rwrong/n received ping, seq=%d\n', [SwapWORD(ICMP.seq)]);
+ {Memory.}ToroFreeMem(PingPacket);
+ end
+ else
+ {Console.}WriteConsole('\t ToroPing: /rno received/n ping from %d.%d.%d.%d\n', [PingIP[0], PingIP[1], PingIP[2], PingIP[3]]);
+
+ // I increment the seq for next packet
+ seq := seq + 1;
+
+ // I wait WAIT_FOR_PING seconds
+ {Process.}sleep(WAIT_FOR_PING * 1000);
+ end;
+end;
+
+end.
Index: tests/uToroThread.pas
===================================================================
--- tests/uToroThread.pas (nonexistent)
+++ tests/uToroThread.pas (working copy)
@@ -0,0 +1,117 @@
+
+// Toro Multithreading Example
+
+// I have implemented three task (T1, T2 and T3), T1 runs in core 0 while T2 and T3 runs in core1.
+// T1 and T2 have a data dependency, hence while T1 runs T2 must not, this was implemented with a few
+// boolean variables like a semaphore. It could be great to implemented at kernel level thus the user has not
+// take in care about that stuff.
+// Besides, this is a good example about static scheduling where we are sure about the execution order previusly.
+
+// Changes :
+
+// 22/06/2012 First Version by Matias E. Vara.
+
+// Copyright (c) 2003-2017 Matias Vara
+// All Rights Reserved
+
+
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see .
+
+unit uToroThread;
+
+{$mode delphi}
+
+interface
+
+procedure Main;
+
+procedure Init;
+
+implementation
+
+uses
+ Process,
+ Console;
+
+var
+ tmp: TThreadID;
+ var1, var2, var3: longint;
+ // sincronization variable to avoid the execution of task2 and task1 at the same time
+ n1: boolean = True;
+ n2: boolean = False;
+
+// task 2
+function ThreadF2(Param: Pointer): PtrInt;
+begin
+ result := 0;
+ while True do
+ begin
+ while n2 = False do
+ SysThreadSwitch;
+ var3 := var2 + 7;
+ n2 := False;
+ n1 := True;
+ end;
+end;
+
+
+// task3
+function ThreadF3(Param: Pointer): PtrInt;
+begin
+ result := 0;
+ while True do
+ begin
+ var1 := var3 mod 11;
+ SysThreadSwitch;
+ end;
+end;
+
+var
+ FInitialized: boolean = False;
+
+procedure Init;
+begin
+ WriteConsole('\c/R', [0]);
+ // initial values
+ var1 := 0;
+ var2 := 4;
+ var3 := 11;
+
+ // we create a remote thread
+ tmp := BeginThread(nil, 4096, ThreadF3, nil, 1, tmp);
+ tmp := BeginThread(nil, 4096, ThreadF2, nil, 1, tmp);
+ FInitialized := True;
+end;
+
+procedure Main;
+
+begin
+ Assert(FInitialized,'Application has to Initialized with "Init"');
+ // task1 is implemented using main thread in order to keep the scheduler
+ // as stable as possible
+ while True do
+ begin
+ while n1 = False do
+ SysThreadSwitch;
+ var2 := var1 + 5;
+ // this WriteConsole() adds much noise given that it implements atomic operations
+ WriteConsole('%d', [var1]);
+ // syncro flags
+ n1 := False;
+ n2 := True;
+ end;
+
+end;
+
+end.
Index: tests/uWritePascal.pas
===================================================================
--- tests/uWritePascal.pas (nonexistent)
+++ tests/uWritePascal.pas (working copy)
@@ -0,0 +1,52 @@
+// Toro Write Pascal Example.
+// Example using a minimal kernel to print "Pascal" in 3D
+
+// Changes :
+
+// 19/06/2017 First Version by Joe Care.
+
+// Copyright (c) 2017 Joe Care
+// All Rights Reserved
+unit uWritePascal;
+
+{$mode delphi}
+
+interface
+
+uses
+ Console;
+
+Procedure Main;
+
+implementation
+
+const
+ i64: int64 = 1055120232691680095; (* This defines "Pascal" *)
+ cc: array[-3..3] of ShortString = (* Here are all string-constants *)
+ ('\ '#8' \ ',
+ #8'__ ',
+ #8'__/\ ',
+ ' '#8' ',
+ #8'__/\ ',
+ ' '#8' ',
+ #8'__/\ ');
+
+Procedure Main;
+var
+ x, y, c: integer;
+
+begin
+ PrintStringLn(StringOfChar(cc[1][1], 78));
+ for y := 0 to 11 do
+ begin
+ PrintString(StringOfChar(cc[0][1], 13 - y));
+ for x := 0 to 16 do
+ for c := 1 to 5 + (x mod 3) and 2 do
+ if c <= length(cc[(x - 5) mod 4]) then
+ PutC(cc[(((i64 shr ((x and 15) * 4 + y div 3)) and (3 -
+ (y div 9) shl 1)) - 4 + (2 - y mod 3) shl 2) mod 4][c]);
+ PrintStringln();
+ end;
+end;
+end.
+
Index: ToroKernel.lpg
===================================================================
--- ToroKernel.lpg (nonexistent)
+++ ToroKernel.lpg (working copy)
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+