Преглед на файлове

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

git-svn-id: trunk@33676 -
pierre преди 9 години
родител
ревизия
01ea38a627
променени са 1 файла, в които са добавени 33 реда и са изтрити 0 реда
  1. 33 0
      rtl/msdos/sysheap.inc

+ 33 - 0
rtl/msdos/sysheap.inc

@@ -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);