paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 23:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

sinclairql: initial heap allocation code, and minor system unit bits

Browse Source 
git-svn-id: trunk@47351 -
This commit is contained in:
Károly Balogh 2020-11-08 20:50:32 +00:00
parent b90d6e1114
commit d5596ef21d
3 changed files with 23 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/sinclairql/sysheap.inc
View File

@ -18,12 +18,15 @@
****************************************************************************}
function SysOSAlloc(size: ptruint): pointer;
begin
Result:=mt_alchp(size, nil, -1);
end;
{$define HAS_SYSOSFREE}
procedure SysOSFree(p: pointer; size: ptruint);
begin
mt_rechp(p);
end;

2
rtl/sinclairql/sysos.inc
View File

@ -15,6 +15,8 @@
**********************************************************************}
{$i qdos.inc}
procedure Error2InOutRes(errno: longint);
begin
end;

19
rtl/sinclairql/system.pp
View File

@ -122,8 +122,12 @@ var
{*****************************************************************************
System Dependent Exit code
*****************************************************************************}
procedure haltproc(e:longint); external name '_haltproc';
procedure system_exit;
begin
haltproc(exitcode);
end;
{*****************************************************************************
@ -146,6 +150,19 @@ begin
CheckInitialStkLen := StkLen;
end;
procedure PrintStr(const s: shortstring);
begin
io_sstrg($00010001,-1,@s[1],ord(s[0]));
end;
procedure PrintStr2(const s: shortstring);
var
i: smallint;
begin
for i:=1 to ord(s[0]) do
io_sbyte($00010001,-1,s[i]);
end;
begin
StackLength := CheckInitialStkLen (InitialStkLen);
@ -160,7 +177,7 @@ begin
InitUnicodeStringManager;
{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
{ Setup stdin, stdout and stderr }
SysInitStdIO;
(* SysInitStdIO;*)
{ Reset IO Error }
InOutRes:=0;
{ Setup command line arguments }