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 @@ + + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="ToroException.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\tests\uToroException.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o..\bin\$(TargetCPU)-$(TargetOS)\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="..\bin\$(TargetCPU)-$(TargetOS)\build.exe 2 ..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o ..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroHello"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="9"> + <Unit0> + <Filename Value="ToroHello.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Optimizations> + <OptimizationLevel Value="0"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o..\bin\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="..\bin\build.exe 2 ..\bin\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o ..\bin\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroHttp"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <LazDoc Paths="..\FPDoc"/> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="12"> + <Unit0> + <Filename Value="ToroHttp.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\Network.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + <Unit9> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit9> + <Unit10> + <Filename Value="..\rtl\drivers\Ne2000.pas"/> + <IsPartOfProject Value="True"/> + </Unit10> + <Unit11> + <Filename Value="..\tests\uToroHttp.pas"/> + <IsPartOfProject Value="True"/> + </Unit11> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <Package Version="4"> + <PathDelim Value="\"/> + <Name Value="ToroKernel"/> + <Type Value="RunAndDesignTime"/> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <SearchPaths> + <IncludeFiles Value="..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> + <UnitOutputDirectory Value="..\lib\$(PkgName)\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <Style Value="1"/> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + </CompilerOptions> + <Files Count="19"> + <Item1> + <HasRegisterProc Value="True"/> + </Item1> + <Item2> + <Filename Value="..\rtl\Arch.pas"/> + <UnitName Value="Arch"/> + </Item2> + <Item3> + <Filename Value="..\rtl\Debug.pas"/> + <UnitName Value="Debug"/> + </Item3> + <Item4> + <Filename Value="..\rtl\Errno.pas"/> + <UnitName Value="ErrNo"/> + </Item4> + <Item5> + <Filename Value="..\rtl\Filesystem.pas"/> + <UnitName Value="FileSystem"/> + </Item5> + <Item6> + <Filename Value="..\rtl\fpintres.pp"/> + <UnitName Value="fpintres"/> + </Item6> + <Item7> + <Filename Value="..\rtl\Kernel.pas"/> + <UnitName Value="Kernel"/> + </Item7> + <Item8> + <Filename Value="..\rtl\libc.pas"/> + <UnitName Value="Libc"/> + </Item8> + <Item9> + <Filename Value="..\rtl\Memory.pas"/> + <UnitName Value="Memory"/> + </Item9> + <Item10> + <Filename Value="..\rtl\Network.pas"/> + <UnitName Value="Network"/> + </Item10> + <Item11> + <Filename Value="..\rtl\Process.pas"/> + <UnitName Value="Process"/> + </Item11> + <Item12> + <Filename Value="..\rtl\SysUtils.pas"/> + <UnitName Value="SysUtils"/> + </Item12> + <Item13> + <Filename Value="..\rtl\Toro.inc"/> + <Type Value="Include"/> + </Item13> + <Item14> + <Filename Value="..\rtl\drivers\Console.pas"/> + <UnitName Value="Console"/> + </Item14> + <Item15> + <Filename Value="..\rtl\drivers\E1000.pas"/> + <UnitName Value="E1000"/> + </Item15> + <Item16> + <Filename Value="..\rtl\drivers\Ext2.pas"/> + <UnitName Value="Ext2"/> + </Item16> + <Item17> + <Filename Value="..\rtl\drivers\IdeDisk.pas"/> + <UnitName Value="IdeDisk"/> + </Item17> + <Item18> + <Filename Value="..\rtl\drivers\Ne2000.pas"/> + <UnitName Value="Ne2000"/> + </Item18> + <Item19> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <UnitName Value="Pci"/> + </Item19> + </Files> + <RequiredPkgs Count="1"> + <Item1> + <PackageName Value="FCL"/> + </Item1> + </RequiredPkgs> + <UsageOptions> + <UnitPath Value="$(PkgOutDir)"/> + </UsageOptions> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + </Package> +</CONFIG> 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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroKeyb"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="ToroKeyb.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\tests\uToroKeyb.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Optimizations> + <OptimizationLevel Value="0"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o..\bin\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="..\bin\build.exe 2 ..\bin\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o ..\bin\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroPing"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="12"> + <Unit0> + <Filename Value="ToroPing.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="FileSystem"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\Network.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + <Unit9> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit9> + <Unit10> + <Filename Value="..\rtl\drivers\E1000.pas"/> + <IsPartOfProject Value="True"/> + </Unit10> + <Unit11> + <Filename Value="..\tests\uToroPing.pas"/> + <IsPartOfProject Value="True"/> + </Unit11> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroThread"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="ToroThread.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\tests\uToroThread.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> +</CONFIG> Index: FPC/WritePacal.lpi =================================================================== --- FPC/WritePacal.lpi (nonexistent) +++ FPC/WritePacal.lpi (working copy) @@ -0,0 +1,128 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="WritePacal"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="10"> + <Unit0> + <Filename Value="WritePacal.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + <Unit9> + <Filename Value="..\tests\uWritePascal.pas"/> + <IsPartOfProject Value="True"/> + </Unit9> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$(ProjOutDir)\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$(ProjOutDir)\build.exe 2 $(ProjOutDir)\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o $(ProjOutDir)\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <http://www.gnu.org/licenses/>. + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroException"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="ToroException.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\tests\uToroException.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o..\bin\$(TargetCPU)-$(TargetOS)\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="..\bin\$(TargetCPU)-$(TargetOS)\build.exe 2 ..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o ..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroHello"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="9"> + <Unit0> + <Filename Value="ToroHello.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Optimizations> + <OptimizationLevel Value="0"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o..\bin\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="..\bin\build.exe 2 ..\bin\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o ..\bin\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroHttp"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <LazDoc Paths="..\FPDoc"/> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="12"> + <Unit0> + <Filename Value="ToroHttp.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\Network.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + <Unit9> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit9> + <Unit10> + <Filename Value="..\rtl\drivers\Ne2000.pas"/> + <IsPartOfProject Value="True"/> + </Unit10> + <Unit11> + <Filename Value="..\tests\uToroHttp.pas"/> + <IsPartOfProject Value="True"/> + </Unit11> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <Package Version="4"> + <PathDelim Value="\"/> + <Name Value="ToroKernel"/> + <Type Value="RunAndDesignTime"/> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <SearchPaths> + <IncludeFiles Value="..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> + <UnitOutputDirectory Value="..\lib\$(PkgName)\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <Style Value="1"/> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + </CompilerOptions> + <Files Count="19"> + <Item1> + <HasRegisterProc Value="True"/> + </Item1> + <Item2> + <Filename Value="..\rtl\Arch.pas"/> + <UnitName Value="Arch"/> + </Item2> + <Item3> + <Filename Value="..\rtl\Debug.pas"/> + <UnitName Value="Debug"/> + </Item3> + <Item4> + <Filename Value="..\rtl\Errno.pas"/> + <UnitName Value="ErrNo"/> + </Item4> + <Item5> + <Filename Value="..\rtl\Filesystem.pas"/> + <UnitName Value="FileSystem"/> + </Item5> + <Item6> + <Filename Value="..\rtl\fpintres.pp"/> + <UnitName Value="fpintres"/> + </Item6> + <Item7> + <Filename Value="..\rtl\Kernel.pas"/> + <UnitName Value="Kernel"/> + </Item7> + <Item8> + <Filename Value="..\rtl\libc.pas"/> + <UnitName Value="Libc"/> + </Item8> + <Item9> + <Filename Value="..\rtl\Memory.pas"/> + <UnitName Value="Memory"/> + </Item9> + <Item10> + <Filename Value="..\rtl\Network.pas"/> + <UnitName Value="Network"/> + </Item10> + <Item11> + <Filename Value="..\rtl\Process.pas"/> + <UnitName Value="Process"/> + </Item11> + <Item12> + <Filename Value="..\rtl\SysUtils.pas"/> + <UnitName Value="SysUtils"/> + </Item12> + <Item13> + <Filename Value="..\rtl\Toro.inc"/> + <Type Value="Include"/> + </Item13> + <Item14> + <Filename Value="..\rtl\drivers\Console.pas"/> + <UnitName Value="Console"/> + </Item14> + <Item15> + <Filename Value="..\rtl\drivers\E1000.pas"/> + <UnitName Value="E1000"/> + </Item15> + <Item16> + <Filename Value="..\rtl\drivers\Ext2.pas"/> + <UnitName Value="Ext2"/> + </Item16> + <Item17> + <Filename Value="..\rtl\drivers\IdeDisk.pas"/> + <UnitName Value="IdeDisk"/> + </Item17> + <Item18> + <Filename Value="..\rtl\drivers\Ne2000.pas"/> + <UnitName Value="Ne2000"/> + </Item18> + <Item19> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <UnitName Value="Pci"/> + </Item19> + </Files> + <RequiredPkgs Count="1"> + <Item1> + <PackageName Value="FCL"/> + </Item1> + </RequiredPkgs> + <UsageOptions> + <UnitPath Value="$(PkgOutDir)"/> + </UsageOptions> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + </Package> +</CONFIG> 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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroKeyb"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="ToroKeyb.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\tests\uToroKeyb.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Optimizations> + <OptimizationLevel Value="0"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o..\bin\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="..\bin\build.exe 2 ..\bin\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o ..\bin\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroPing"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="12"> + <Unit0> + <Filename Value="ToroPing.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="FileSystem"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\Network.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + <Unit9> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit9> + <Unit10> + <Filename Value="..\rtl\drivers\E1000.pas"/> + <IsPartOfProject Value="True"/> + </Unit10> + <Unit11> + <Filename Value="..\tests\uToroPing.pas"/> + <IsPartOfProject Value="True"/> + </Unit11> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToroThread"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="ToroThread.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\tests\uToroThread.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$Path($(TargetFile))\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$Path($(TargetFile))\build.exe 2 $(TargetFile) ..\tests\boot.o $Path($(TargetFile))\$NameOnly($(TargetFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> +</CONFIG> Index: FPC/WritePacal.lpi =================================================================== --- FPC/WritePacal.lpi (nonexistent) +++ FPC/WritePacal.lpi (working copy) @@ -0,0 +1,128 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="WritePacal"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="10"> + <Unit0> + <Filename Value="WritePacal.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\rtl\Kernel.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\rtl\Process.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="..\rtl\Memory.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="..\rtl\Debug.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="..\rtl\Arch.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="..\rtl\Filesystem.pas"/> + <IsPartOfProject Value="True"/> + </Unit6> + <Unit7> + <Filename Value="..\rtl\drivers\Pci.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="..\rtl\drivers\Console.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + <Unit9> + <Filename Value="..\tests\uWritePascal.pas"/> + <IsPartOfProject Value="True"/> + </Unit9> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\$(TargetCPU)-$(TargetOS)\$Nameonly($Project(InfoFile))"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\rtl;$(CompPath)\..\..\..\source\rtl\inc"/> + <OtherUnitFiles Value="..\rtl;..\rtl\drivers;..\tests"/> + <UnitOutputDirectory Value="..\lib\$Nameonly($Project(InfoFile))\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <RelocatableUnit Value="True"/> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <WriteFPCLogo Value="False"/> + <ExecuteBefore> + <Command Value="$(CompPath) ..\tests\build.pas -FU..\lib\build\$(TargetCPU)-$(TargetOS) -o$(ProjOutDir)\build.exe"/> + <CompileReasons Run="False"/> + </ExecuteBefore> + <ExecuteAfter> + <Command Value="$(ProjOutDir)\build.exe 2 $(ProjOutDir)\$Nameonly($Project(InfoFile)).exe ..\tests\boot.o $(ProjOutDir)\$Nameonly($Project(InfoFile)).img"/> + <ShowAllMessages Value="True"/> + <CompileReasons Run="False"/> + </ExecuteAfter> + </Other> + <CompileReasons Run="False"/> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> 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 <http://www.gnu.org/licenses/>. + +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 <matiasevara@gmail.com> // 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 <http://www.gnu.org/licenses/>. -// + 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 <matiasevara@gmail.com> // 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 <http://www.gnu.org/licenses/>. -// + 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 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="ToroException"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <VersionInfo> - <StringTable ProductVersion=""/> - </VersionInfo> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="1"> - <Unit0> - <Filename Value="ToroException.pas"/> - <IsPartOfProject Value="True"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="ToroException" ApplyConventions="False"/> - </Target> - <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="False"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <Optimizations> - <OptimizationLevel Value="0"/> - </Optimizations> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - </Debugging> - </Linking> - <Other> - <ExecuteBefore> - <Command Value="$(CompPath) build.pas"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteBefore> - <ExecuteAfter> - <Command Value="build.exe 2 ToroException boot.o ToroException.img"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteAfter> - </Other> - <CompileReasons Run="False"/> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> 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 <matiasevara@gmail.com> -// 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 <http://www.gnu.org/licenses/>. -// - -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 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="ToroHello"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <VersionInfo> - <StringTable ProductVersion=""/> - </VersionInfo> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="1"> - <Unit0> - <Filename Value="ToroHello.pas"/> - <IsPartOfProject Value="True"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="ToroHello" ApplyConventions="False"/> - </Target> - <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="False"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <Optimizations> - <OptimizationLevel Value="0"/> - </Optimizations> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - </Debugging> - </Linking> - <Other> - <WriteFPCLogo Value="False"/> - <ExecuteBefore> - <Command Value="$(CompPath) build.pas"/> - <CompileReasons Run="False"/> - </ExecuteBefore> - <ExecuteAfter> - <Command Value="build.exe 2 ToroHello boot.o ToroHello.img"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteAfter> - </Other> - <CompileReasons Run="False"/> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> 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 <matiasevara@gmail.com> -// 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 <http://www.gnu.org/licenses/>. -// - -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 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="ToroHttp"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <VersionInfo> - <StringTable ProductVersion=""/> - </VersionInfo> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="1"> - <Unit0> - <Filename Value="ToroHttp.pas"/> - <IsPartOfProject Value="True"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="ToroHttp" ApplyConventions="False"/> - </Target> - <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="False"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <Optimizations> - <OptimizationLevel Value="0"/> - </Optimizations> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - </Debugging> - </Linking> - <Other> - <ExecuteBefore> - <Command Value="$(CompPath) build.pas"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteBefore> - <ExecuteAfter> - <Command Value="build.exe 2 ToroHttp boot.o ToroHttp.img"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteAfter> - </Other> - <CompileReasons Run="False"/> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> 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 <matiasevara@gmail.com> -// 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 <http://www.gnu.org/licenses/>. -// - -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 = '<b>Hello from Toro!</b>'+#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 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="ToroKeyb"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <VersionInfo> - <StringTable ProductVersion=""/> - </VersionInfo> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="1"> - <Unit0> - <Filename Value="ToroKeyb.pas"/> - <IsPartOfProject Value="True"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="ToroKeyb" ApplyConventions="False"/> - </Target> - <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="False"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <Optimizations> - <OptimizationLevel Value="0"/> - </Optimizations> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - </Debugging> - </Linking> - <Other> - <ExecuteBefore> - <Command Value="$(CompPath) build.pas"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteBefore> - <ExecuteAfter> - <Command Value="build.exe 2 ToroKeyb boot.o ToroKeyb.img"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteAfter> - </Other> - <CompileReasons Run="False"/> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> 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 <matiasevara@gmail.com> -// 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 <http://www.gnu.org/licenses/>. -// - -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 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="ToroPing"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <VersionInfo> - <StringTable ProductVersion=""/> - </VersionInfo> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="1"> - <Unit0> - <Filename Value="ToroPing.pas"/> - <IsPartOfProject Value="True"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="ToroPing" ApplyConventions="False"/> - </Target> - <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="False"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <Optimizations> - <OptimizationLevel Value="0"/> - </Optimizations> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - </Debugging> - </Linking> - <Other> - <ExecuteBefore> - <Command Value="$(CompPath) build.pas"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteBefore> - <ExecuteAfter> - <Command Value="build.exe 2 ToroPing boot.o ToroPing.img"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteAfter> - </Other> - <CompileReasons Run="False"/> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> 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 <matiasevara@gmail.com> -// 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 <http://www.gnu.org/licenses/>. -// - -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 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="ToroThread"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <VersionInfo> - <StringTable ProductVersion=""/> - </VersionInfo> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="1"> - <Unit0> - <Filename Value="ToroThread.pas"/> - <IsPartOfProject Value="True"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="ToroThread" ApplyConventions="False"/> - </Target> - <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\rtl;..\rtl\drivers"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="False"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <Optimizations> - <OptimizationLevel Value="0"/> - </Optimizations> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - </Debugging> - </Linking> - <Other> - <ExecuteBefore> - <Command Value="$(CompPath) build.pas"/> - <CompileReasons Run="False"/> - </ExecuteBefore> - <ExecuteAfter> - <Command Value="build.exe 2 ToroThread boot.o ToroThread.img"/> - <ShowAllMessages Value="True"/> - <CompileReasons Run="False"/> - </ExecuteAfter> - </Other> - <CompileReasons Run="False"/> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> 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 <matiasevara@gmail.com> -// 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 <http://www.gnu.org/licenses/>. -// - -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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +// + +unit uToroHttp; + +{$mode delphi} + +interface + + +Procedure Main; + +implementation + +uses + Console,Network; + +const + Welcome: PChar = '<b>Hello from Toro!</b>'+#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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. +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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. + +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 <matiasevara@gmail.com> +// 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 <http://www.gnu.org/licenses/>. + +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 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectGroup FileVersion="1"> + <Targets Count="8"> + <Target0 FileName="FPC\ToroKernel.lpk"/> + <Target1 FileName="FPC\ToroHello.lpi"> + <BuildModes Count="1"/> + <Mode1 Name="Default"/> + </Target1> + <Target2 FileName="FPC\WritePacal.lpi"> + <BuildModes Count="1"/> + <Mode1 Name="Default"/> + </Target2> + <Target3 FileName="tests\ToroKeyb.lpi"> + <BuildModes Count="1"/> + <Mode1 Name="Default"/> + </Target3> + <Target4 FileName="FPC\ToroException.lpi"> + <BuildModes Count="1"/> + <Mode1 Name="Default"/> + </Target4> + <Target5 FileName="FPC\ToroHttp.lpi"> + <BuildModes Count="1"/> + <Mode1 Name="Default"/> + </Target5> + <Target6 FileName="FPC\ToroPing.lpi"> + <BuildModes Count="1"/> + <Mode1 Name="Default"/> + </Target6> + <Target7 FileName="FPC\ToroThread.lpi"> + <BuildModes Count="1"/> + <Mode1 Name="Default"/> + </Target7> + </Targets> + </ProjectGroup> +</CONFIG>