mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-24 02:39:11 +02:00
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 -
This commit is contained in:
Jeppe Johansen
parent
14879a9e82
commit
84ea70fddc
@ -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,
|
||||
|
||||
@ -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:=@t.UserData[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:=@t.UserData[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
|
||||
|
||||
@ -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
|
||||
interface
|
||||
|
||||
implementation
|
||||
procedure RegisterHeapBlock(AAddress: pointer; ASize: ptruint);
|
||||
|
||||
var
|
||||
Memorymanager: TMemoryManager;external name 'FPC_SYSTEM_MEMORYMANAGER';
|
||||
implementation
|
||||
|
||||
Procedure HandleError (Errno : longint);external name 'FPC_HANDLEERROR';
|
||||
const
|
||||
MinBlock = 16;
|
||||
|
||||
{*****************************************************************************
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result:=nil; // pointer($02000000);
|
||||
end;
|
||||
type
|
||||
PHeapBlock = ^THeapBlock;
|
||||
THeapBlock = record
|
||||
Size: ptruint;
|
||||
Next: PHeapBlock;
|
||||
EndAddr: pointer;
|
||||
end;
|
||||
|
||||
var
|
||||
Blocks: PHeapBlock = nil;
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
end;
|
||||
procedure InternalFreeMem(Addr: Pointer; Size: ptruint); forward;
|
||||
|
||||
{$define FPC_IN_HEAPMGR}
|
||||
{$i heap.inc}
|
||||
function FindSize(p: pointer): ptruint;
|
||||
begin
|
||||
FindSize := PPtrUInt(p)[-1];
|
||||
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: @SysGetHeapStatus;
|
||||
GetFPCHeapStatus: @SysGetFPCHeapStatus;
|
||||
);
|
||||
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.
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user