Fixed some minor formating issues

Implemented a small heap mananger
Implemented console IO
Changed default LineEnding to CrLf(to ease console IO parsing)

git-svn-id: branches/laksen/arm-embedded@22646 -

compiler/arm/cpuinfo.pas

@@ -423,9 +423,9 @@ Const
         (controllertypestr:'STM32F103XE';     controllerunitstr:'STM32F10X_HD';     flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00010000),
         (controllertypestr:'STM32F103XF';     controllerunitstr:'STM32F10X_XL';     flashbase:$08000000; flashsize:$000C0000; srambase:$20000000; sramsize:$00018000),
         (controllertypestr:'STM32F103XG';     controllerunitstr:'STM32F10X_XL';     flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00018000),
-        (controllertypestr:'STM32F107X8';     controllerunitstr:'STM32F10X_CONN';     flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00010000),
-        (controllertypestr:'STM32F107XB';     controllerunitstr:'STM32F10X_CONN';     flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
-        (controllertypestr:'STM32F107XC';     controllerunitstr:'STM32F10X_CONN';     flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+        (controllertypestr:'STM32F107X8';     controllerunitstr:'STM32F10X_CONN';   flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00010000),
+        (controllertypestr:'STM32F107XB';     controllerunitstr:'STM32F10X_CONN';   flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+        (controllertypestr:'STM32F107XC';     controllerunitstr:'STM32F10X_CONN';   flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
 
       { TI - 64 K Flash, 16 K SRAM Devices }
       	// ct_lm3s1110,

rtl/embedded/consoleio.pp

@@ -17,28 +17,130 @@ Unit consoleio;
 
   interface
 
+    type
+      TWriteCharFunc = function(ACh: char; AUserData: pointer): boolean;
+      TReadCharFunc = function(var ACh: char; AUserData: pointer): boolean;
+
+    procedure OpenIO(var f: Text; AWrite: TWriteCharFunc; ARead: TReadCharFunc; AMode:longint; AUserData: pointer);
+
   implementation
 
+    {$i textrec.inc}
+
+    type
+      PUserData = ^TUserData;
+      TUserData = record
+        WriteChar: TWriteCharFunc;
+        ReadChar: TReadCharFunc;
+        UserData: Pointer;
+      end;
+
+    function EmptyWrite(ACh: char; AUserData: pointer): boolean;
+      begin
+        result:=true;
+      end;
+
+    function EmptyRead(var ACh: char; AUserData: pointer): boolean;
+      begin
+        result:=true;
+        ACh:=#0;
+      end;
+
+    procedure Console_Close(var t:TextRec);
+      begin
+      end;
+
+    function ReadData(Func: TReadCharFunc; UserData: pointer; Buffer: pchar; count: longint): longint;
+      var
+        c: char;
+        got_linechar: boolean;
+      begin
+        result:=0;
+        got_linechar:=false;
+        while (result < count) and (not got_linechar) do
+          begin
+            if Func(c, UserData) then
+              begin
+                if c = #10 then
+                  got_linechar:=true;
+                buffer^:=c;
+                inc(buffer);
+                inc(result);
+              end;
+          end;
+      end;
+
+    Procedure Console_Read(var t:TextRec);
+      var
+        userdata: PUserData;
+      begin
+        userdata:[email protected][1];
+        InOutRes:=0;
+        t.bufend:=ReadData(userdata^.ReadChar,userdata^.UserData,pchar(t.bufptr),t.bufsize);
+        t.bufpos:=0;
+      end;
+
+    Procedure Console_Write(var t:TextRec);
+      var
+        userdata: PUserData;
+        p: pchar;
+        i: longint;
+      begin
+        if t.BufPos=0 then exit;
+        userdata:[email protected][1];
+        i := 0;
+        p := pchar(t.bufptr);
+        while i < t.bufpos do
+          begin
+            if not userdata^.WriteChar(p^, userdata^.UserData) then
+              break;
+            inc(p);
+            inc(i);
+          end;
+        if i<>t.BufPos then
+          InOutRes:=101
+        else
+          InOutRes:=0;
+        t.BufPos:=0;
+      end;
+
+    procedure OpenIO(var f: Text; AWrite: TWriteCharFunc; ARead: TReadCharFunc; AMode:longint; AUserData: pointer);
+      var
+        userdata: PUserData;
+      begin
+        Assign(f,'');
+        userdata:=@TextRec(f).UserData[1];
+        TextRec(f).Mode:=AMode;
+        case AMode of
+          fmInput: TextRec(f).Handle:=StdInputHandle;
+          fmOutput: TextRec(f).Handle:=StdOutputHandle;
+        end;
+        TextRec(f).CloseFunc:=@Console_Close;
+        TextRec(f).FlushFunc:=nil;
+        case AMode of
+          fmInput: TextRec(f).InOutFunc:=@Console_Read;
+          fmOutput: 
+            begin
+              TextRec(f).InOutFunc:=@Console_Write;
+              TextRec(f).FlushFunc:=@Console_Write;
+            end;
+        end;
+        userdata^.WriteChar := AWrite;
+        userdata^.ReadChar := ARead;
+        userdata^.UserData := AUserData;
+      end;
+
     procedure SysInitStdIO;
       begin
-        // OpenStdIO(Input,fmInput,0);
-        // OpenStdIO(Output,fmOutput,0);
-        // OpenStdIO(ErrOutput,fmOutput,0);
-        // OpenStdIO(StdOut,fmOutput,0);
-        // OpenStdIO(StdErr,fmOutput,0);
+        OpenIO(Input, @EmptyWrite, @EmptyRead, fmInput, nil);
+        OpenIO(Output, @EmptyWrite, @EmptyRead, fmOutput, nil);
+        OpenIO(ErrOutput, @EmptyWrite, @EmptyRead, fmOutput, nil);
+        OpenIO(StdOut, @EmptyWrite, @EmptyRead, fmOutput, nil);
+        OpenIO(StdErr, @EmptyWrite, @EmptyRead, fmOutput, nil);
       end;
 
    procedure SysFlushStdIO;
      begin
-       { Make sure that all output is written to the redirected file }
-{!!!!!!!!       if Textrec(Output).Mode=fmOutput then
-         Flush(Output);
-       if Textrec(ErrOutput).Mode=fmOutput then
-         Flush(ErrOutput);
-       if Textrec(stdout).Mode=fmOutput then
-         Flush(stdout);
-       if Textrec(StdErr).Mode=fmOutput then
-         Flush(StdErr);  }
      end;
 
 var

rtl/embedded/heapmgr.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 2011 by the Free Pascal development team.
 
-    Heap manager for the FPC embedded target
+    Tiny heap manager for the FPC embedded target
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -15,52 +15,234 @@
 {$mode objfpc}
 Unit heapmgr;
 
-interface
-
-implementation
-
-  var
-    Memorymanager: TMemoryManager;external name 'FPC_SYSTEM_MEMORYMANAGER';
-
-  Procedure HandleError (Errno : longint);external name 'FPC_HANDLEERROR';
-
-  {*****************************************************************************
-        OS Memory allocation / deallocation
-   ****************************************************************************}
-  function SysOSAlloc(size: ptruint): pointer;
-  begin
-    result:=nil; // pointer($02000000);
-  end;
-
-
-  procedure SysOSFree(p: pointer; size: ptruint);
-  begin
-  end;
-
-  {$define FPC_IN_HEAPMGR}
-  {$i heap.inc}
-
-  const
-    MyMemoryManager: TMemoryManager = (
-      NeedLock: false;  // Obsolete
-      GetMem: @SysGetMem;
-      FreeMem: @SysFreeMem;
-      FreeMemSize: @SysFreeMemSize;
-      AllocMem: @SysAllocMem;
-      ReAllocMem: @SysReAllocMem;
-      MemSize: @SysMemSize;
-      InitThread: nil;
-      DoneThread: nil;
-      RelocateHeap: nil;
-      GetHeapStatus: @SysGetHeapStatus;
-      GetFPCHeapStatus: @SysGetFPCHeapStatus;
-    );
+  interface
+
+    procedure RegisterHeapBlock(AAddress: pointer; ASize: ptruint);
+
+  implementation
+
+    const
+      MinBlock = 16;
+
+    type
+      PHeapBlock = ^THeapBlock;
+      THeapBlock = record
+        Size: ptruint;
+        Next: PHeapBlock;
+        EndAddr: pointer;
+      end;
+
+    var
+      Blocks: PHeapBlock = nil;
+
+    procedure InternalFreeMem(Addr: Pointer; Size: ptruint); forward;
+
+    function FindSize(p: pointer): ptruint;
+      begin
+        FindSize := PPtrUInt(p)[-1];
+      end;
+
+    function SysGetMem(Size: ptruint): pointer;
+      var
+        p, prev: PHeapBlock;
+        AllocSize, RestSize: ptruint;
+      begin
+        AllocSize := align(size+sizeof(ptruint), sizeof(pointer));
+
+        p := Blocks;
+        prev := nil;
+        while assigned(p) and (p^.Size < AllocSize) do
+          begin
+            prev := p;
+            p := p^.Next;
+          end;
+
+        if assigned(p) then
+          begin
+            result := @pptruint(p)[1];
+
+            if p^.Size-AllocSize >= MinBlock then
+              RestSize := p^.Size-AllocSize
+            else
+              begin
+                AllocSize := p^.Size;
+                RestSize := 0;
+              end;
+
+            if prev = nil then
+              Blocks := p^.Next
+            else
+              prev^.next := p^.next;
+
+            pptruint(p)^ := size;
+
+            InternalFreemem(pointer(ptruint(p)+AllocSize), RestSize);
+          end
+        else
+          Result := nil;
+      end;
+
+    function GetAlignedMem(Size, Alignment: ptruint): pointer;
+      var
+        mem: Pointer;
+        memp: ptruint;
+      begin
+        if alignment <= sizeof(pointer) then
+          result := GetMem(size)
+        else
+          begin
+            mem := GetMem(Size+Alignment-1);
+            memp := align(ptruint(mem), Alignment);
+            InternalFreemem(mem, ptruint(memp)-ptruint(mem));
+            result := pointer(memp);
+          end;
+      end;
+
+    procedure InternalFreeMem(Addr: Pointer; Size: ptruint);
+      var 
+        b, p, prev: PHeapBlock;
+        concatenated: boolean;
+      begin
+        concatenated := true;
+        while concatenated do
+          begin
+            concatenated := false;
+            b := addr;
+
+            b^.Next := Blocks;
+            b^.Size := Size;
+            b^.EndAddr := pointer(ptruint(addr)+size);
+
+            if Blocks = nil then
+              Blocks := b
+            else
+              begin
+                p := Blocks;
+                prev := nil;
+
+                while assigned(p) do
+                  begin
+                    if p^.EndAddr = addr then
+                      begin
+                        addr:=p;
+                        size:=p^.size+size;
+                        if prev = nil then
+                          blocks:=p^.next
+                        else
+                          prev^.next:=p^.next;
+                        concatenated:=true;
+                        break;
+                      end
+                    else if p = b^.EndAddr then
+                      begin
+                        size:=p^.size+size;
+                        if prev = nil then
+                          blocks:=p^.next
+                        else
+                          prev^.next:=p^.next;
+                        concatenated:=true;
+                        break;
+                      end;
+                    
+                    prev := p;
+                    p := p^.next;
+                  end;
+
+                if not concatenated then
+                  begin
+                    p := Blocks;
+                    prev := nil;
+
+                    while assigned(p) and (p^.Size < size) do
+                      begin
+                        prev := p;
+                        p := p^.Next;
+                      end;
+
+                    if assigned(prev) then
+                      begin
+                        b^.Next := p;
+                        prev^.Next := b;
+                      end
+                    else
+                      Blocks := b;
+                  end;
+              end;
+          end;
+      end;
+
+    function SysFreeMem(Addr: Pointer): ptruint;
+      var
+        sz: ptruint;
+      begin
+        sz := Align(FindSize(addr)+SizeOf(ptruint), sizeof(pointer));
+
+        InternalFreeMem(@pptruint(addr)[-1], sz);
+        
+        result := sz;
+      end;
+
+    function SysFreeMemSize(Addr: Pointer; Size: Ptruint): ptruint;
+      begin
+        result := SysFreeMem(addr);
+      end;
+
+    function SysMemSize(p: pointer): ptruint;
+      begin
+        result := findsize(p);
+      end;
+
+    function SysAllocMem(size: ptruint): pointer;
+      begin
+        result := SysGetMem(size);
+        if result<>nil then
+          FillChar(result^,SysMemSize(result),0);
+      end;
+
+    function SysReAllocMem(var p: pointer; size: ptruint):pointer;
+      var
+        sz: ptruint;
+      begin
+        result := AllocMem(size);
+        if result <> nil then
+          begin
+            if p <> nil then
+              begin
+                sz := FindSize(p);
+                if sz > size then
+                  sz := size;
+                move(pbyte(p)^, pbyte(result)^, sz);
+              end;
+          end;
+        SysFreeMem(p);
+        p := result;
+      end;
+
+    procedure RegisterHeapBlock(AAddress: pointer; ASize: ptruint);
+      begin
+        FreeMem(AAddress, ASize);
+      end;
+
+    const
+      MyMemoryManager: TMemoryManager = (
+        NeedLock: false;  // Obsolete
+        GetMem: @SysGetMem;
+        FreeMem: @SysFreeMem;
+        FreeMemSize: @SysFreeMemSize;
+        AllocMem: @SysAllocMem;
+        ReAllocMem: @SysReAllocMem;
+        MemSize: @SysMemSize;
+        InitThread: nil;
+        DoneThread: nil;
+        RelocateHeap: nil;
+        GetHeapStatus: nil;
+        GetFPCHeapStatus: nil;
+      );
 
 
 initialization
   SetMemoryManager(MyMemoryManager);
-  InitHeap;
 finalization
-  FinalizeHeap;
+  //FinalizeHeap;
 end.
 

rtl/embedded/system.pp

@@ -67,7 +67,7 @@ const
   CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
 
   sLineBreak = LineEnding;
-  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
+  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCrLF;
 {$endif FPC_HAS_FEATURE_TEXTIO}
 
 {$ifdef FPC_HAS_FEATURE_COMMANDARGS}