paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-10 22:29:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

Implement basic SysOSAlloc using MSDOS Interrrupt 0x21, AH=0x48 function

Browse Source 
git-svn-id: trunk@33676 -
This commit is contained in:
pierre 2016-05-11 14:29:11 +00:00
parent 2a3b5bec86
commit 01ea38a627
1 changed files with 33 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
rtl/msdos/sysheap.inc
View File

@ -21,8 +21,41 @@
*****************************************************************************}
function SysOSAlloc (size: ptruint): pointer;
var
regs : Registers;
nb_para : longint;
begin
{$ifdef DEBUG_TINY_HEAP}
writeln('SysOSAlloc called size=',size);
{$endif}
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
regs.ax:=$4800;
nb_para:=size div 16;
if nb_para > $ffff then
result:=nil
else
begin
regs.bx:=nb_para;
msdos(regs);
if (regs.Flags and fCarry) <> 0 then
begin
{$ifdef DEBUG_TINY_HEAP}
writeln('SysOSAlloc failed, err = ',regs.AX);
{$endif}
GetInOutRes(regs.AX);
Result := nil;
end
else
begin
result:=ptr(regs.ax,0);
{$ifdef DEBUG_TINY_HEAP}
writeln('SysOSAlloc returned= $',hexstr(seg(result),4),':$',hexstr(ofs(result),4));
{$endif}
end;
end;
{$else not DATA_FAR}
Result := nil;
{$endif not DATA_FAR}
end;
procedure SysOSFree(p: pointer; size: ptruint);