Sfoglia il codice sorgente

* sbrk returns pointer

peter 22 anni fa
parent
commit
3d8d9c96f8

+ 8 - 5
rtl/amiga/system.pas

@@ -914,7 +914,7 @@ end ['D0'];
   { This routine is used to grow the heap.  }
   { But here we do a trick, we say that the }
   { heap cannot be regrown!                 }
-  function sbrk( size: longint): longint;
+  function sbrk( size: longint): pointer;
   var
   { on exit -1 = if fails.               }
    p: longint;
@@ -925,13 +925,13 @@ end ['D0'];
     if pointerlist[8] <> 0 then
     begin
      { yes, then don't allocate and simply exit }
-     sbrk:=-1;
+     sbrk:=nil;
      exit;
     end;
     { Allocate best available memory }
     p:=AllocVec(size,0);
     if p = 0 then
-     sbrk:=-1
+     sbrk:=nil
     else
     Begin
        i:=1;
@@ -940,7 +940,7 @@ end ['D0'];
        while (i < 8) and (pointerlist[i] <> 0) do
          i:=i+1;
        pointerlist[i]:=p;
-       sbrk:=p;
+       sbrk:=pointer(p);
     end;
   end;
 
@@ -1826,7 +1826,10 @@ end.
 
 {
   $Log$
-  Revision 1.6  2002-10-20 12:00:52  carl
+  Revision 1.7  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.6  2002/10/20 12:00:52  carl
     - remove objinc.inc (unused file)
     * update makefiles accordingly
 

+ 7 - 4
rtl/atari/system.pas

@@ -259,10 +259,10 @@ end ['D0'];
   { This routine is used to grow the heap.  }
   { But here we do a trick, we say that the }
   { heap cannot be regrown!                 }
-  function sbrk( size: longint): longint;
-  { on exit -1 = if fails.               }
+  function sbrk( size: longint): pointer;
+  { on exit nil = if fails.               }
   Begin
-   sbrk:=-1;
+   sbrk:=nil;
   end;
 
 {$I heap.inc}
@@ -758,7 +758,10 @@ end.
 
 {
   $Log$
-  Revision 1.6  2002-10-20 12:00:52  carl
+  Revision 1.7  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.6  2002/10/20 12:00:52  carl
     - remove objinc.inc (unused file)
     * update makefiles accordingly
 

+ 12 - 9
rtl/beos/system.pp

@@ -63,7 +63,7 @@ implementation
 
 function sys_unlink (a:cardinal;name:pchar):longint; cdecl; external name 'sys_unlink';
 function sys_rename (a:cardinal;p1:pchar;b:cardinal;p2:pchar):longint; cdecl; external name 'sys_rename';
-function sys_create_area (name:pchar; var start:longint; a,b,c,d:longint):longint; cdecl; external name 'sys_create_area';
+function sys_create_area (name:pchar; var start:pointer; a,b,c,d:longint):longint; cdecl; external name 'sys_create_area';
 function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
 function sys_mkdir (a:cardinal; name:pchar; mode:cardinal):longint; cdecl; external name 'sys_mkdir';
 function sys_chdir (a:cardinal; name:pchar):longint; cdecl; external name 'sys_chdir';
@@ -134,7 +134,7 @@ end;
                               Heap Management
 *****************************************************************************}
 
-var myheapstart:longint;
+var myheapstart:pointer;
     myheapsize:longint;
     myheaprealsize:longint;
     heap_handle:longint;
@@ -143,7 +143,7 @@ var myheapstart:longint;
 { first address of heap }
 function getheapstart:pointer;
 begin
-   getheapstart:=pointer(myheapstart);
+   getheapstart:=myheapstart;
 end;
 
 { current length of heap }
@@ -153,8 +153,8 @@ begin
 end;
 
 { function to allocate size bytes more for the program }
-{ must return the first address of new data space or -1 if fail }
-function Sbrk(size : longint):longint;
+{ must return the first address of new data space or nil if fail }
+function Sbrk(size : longint):pointer;
 var newsize,newrealsize:longint;
 begin
   if (myheapsize+size)<=myheaprealsize then begin
@@ -170,7 +170,7 @@ begin
         myheaprealsize:=newrealsize;
         exit;
   end;
-  Sbrk:=-1;
+  Sbrk:=nil;
 end;
 
 
@@ -517,8 +517,8 @@ begin
   zero:=0;
   myheapsize:=$2000;
   myheaprealsize:=$2000;
-  myheapstart:=0;
-  heap_handle:=sys_create_area('fpcheap',myheapstart,0,myheaprealsize,0,3);
+  myheapstart:=nil;
+  heap_handle:=sys_create_area('fpcheap',myheapstart,0,myheaprealsize,0,3);//!!
   if heap_handle>0 then begin
     InitHeap;
   end else system_exit;
@@ -535,7 +535,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2003-01-08 22:32:28  marco
+  Revision 1.9  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.8  2003/01/08 22:32:28  marco
    * Small fixes and quick merge with 1.0.x. At least the compiler builds now,
       but it could crash hard, since there are lots of unimplemented funcs.
 

+ 7 - 4
rtl/emx/system.pas

@@ -295,10 +295,10 @@ end;
 { this function allows to extend the heap by calling
 syscall $7f00 resizes the brk area}
 
-function sbrk(size:longint):longint;
+function sbrk(size:longint):pointer;
 {$IFDEF DUMPGROW}
 var
-  L: longint;
+  L: longword;
 begin
   WriteLn ('Trying to grow heap by ', Size, ' to ', HeapSize + Size);
 {$IFDEF CONTHEAP}
@@ -311,7 +311,7 @@ begin
     mov  %eax,L
   end;
   WriteLn ('New heap at ', L);
-  Sbrk := L;
+  Sbrk := pointer(L);
 end;
 {$ELSE DUMPGROW}
                                      assembler;
@@ -1241,7 +1241,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2003-09-24 11:13:09  yuri
+  Revision 1.7  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.6  2003/09/24 11:13:09  yuri
   * Cosmetic changes
   * Slightly improved emx.pas
 

+ 6 - 3
rtl/go32v2/system.pp

@@ -846,12 +846,12 @@ end;
 
 function ___sbrk(size:longint):longint;cdecl;external name '___sbrk';
 
-function Sbrk(size : longint):longint;assembler;
+function Sbrk(size : longint):pointer;assembler;
 asm
 {$ifdef SYSTEMDEBUG}
         cmpb    $1,accept_sbrk
         je      .Lsbrk
-        movl    $-1,%eax
+        movl    $0,%eax
         jmp     .Lsbrk_fail
       .Lsbrk:
 {$endif}
@@ -1494,7 +1494,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.23  2002-10-14 19:39:16  peter
+  Revision 1.24  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.23  2002/10/14 19:39:16  peter
     * threads unit added for thread support
 
   Revision 1.22  2002/10/13 09:28:44  florian

+ 5 - 2
rtl/go32v2/v2prt0.as

@@ -481,7 +481,7 @@ brk_nochange:                              /* successful return */
 brk_error:                                    /* error return */
         movl    __what_we_return_to_app_as_old_size, %eax
         movl    %eax, __what_size_app_thinks_it_is
-        movl    $-1, %eax
+        movl    $0, %eax
 
 brk_return:
         popl    %ebx
@@ -935,7 +935,10 @@ ___PROXY_LEN:
 
 /*
   $Log$
-  Revision 1.6  2002-09-08 09:16:15  jonas
+  Revision 1.7  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.6  2002/09/08 09:16:15  jonas
     * added closing of comment for logs to avoid warning
 
   Revision 1.5  2002/09/07 16:01:19  peter

+ 14 - 11
rtl/inc/heap.inc

@@ -1132,8 +1132,8 @@ end;
 
 function growheap(size : SizeInt) : integer;
 var
-  sizeleft,s1,
-  NewPos    : SizeInt;
+  sizeleft,s1 : longword;
+  NewPos    : pointer;
   pcurr     : pfreerecord;
 begin
 {$ifdef DUMPGROW}
@@ -1146,7 +1146,7 @@ begin
   if size<=GrowHeapSize1 then
    begin
      NewPos:=Sbrk(GrowHeapSize1);
-     if NewPos>=0 then
+     if NewPos<>nil then
       size:=GrowHeapSize1;
    end
   else
@@ -1154,17 +1154,17 @@ begin
    if size<=GrowHeapSize2 then
     begin
       NewPos:=Sbrk(GrowHeapSize2);
-      if NewPos>=0 then
+      if NewPos<>nil then
        size:=GrowHeapSize2;
     end
   { else alloate the needed bytes }
   else
     NewPos:=SBrk(size);
   { try again }
-  if NewPos<0 then
+  if NewPos=nil then
    begin
      NewPos:=Sbrk(size);
-     if NewPos<0 then
+     if NewPos<>nil then
       begin
         if ReturnNilIfGrowHeapFails then
           GrowHeap:=1
@@ -1174,9 +1174,9 @@ begin
       end;
    end;
 { increase heapend or add to freelist }
-  if heapend=pointer(newpos) then
+  if heapend=newpos then
    begin
-     heapend:=pointer(newpos+size);
+     heapend:=newpos+size;
    end
   else
    begin
@@ -1200,8 +1200,8 @@ begin
 {$endif SYSTEMDEBUG}
       end;
      { now set the new heapptr,heapend to the new block }
-     heapptr:=pointer(newpos);
-     heapend:=pointer(newpos+size);
+     heapptr:=newpos;
+     heapend:=newpos+size;
    end;
 { set the total new heap size }
   inc(internal_memavail,size);
@@ -1265,7 +1265,10 @@ end;
 
 {
   $Log$
-  Revision 1.21  2003-05-23 14:53:48  peter
+  Revision 1.22  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.21  2003/05/23 14:53:48  peter
     * check newpos < 0 instead of = -1
 
   Revision 1.20  2003/05/01 08:05:23  florian

+ 7 - 5
rtl/linux/ossysc.inc

@@ -380,12 +380,11 @@ begin
   Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(Adr),TSysParam(Len));
 end;
 
-Function sbrk(size : longint) : longint;
+Function sbrk(size : longint) : pointer;
 begin
-  sbrk:=longint(Fpmmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
-  if sbrk<>-1 then
+  sbrk:=pointer(Fpmmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
+  if sbrk<>nil then
    errno:=0;
-  {! It must be -1, not 0 as before, see heap.inc. Should be in sysmmap?}
 end;
 
 {
@@ -454,7 +453,10 @@ end;
 
 {
  $Log$
- Revision 1.5  2003-09-15 20:29:50  marco
+ Revision 1.6  2003-09-27 11:52:35  peter
+   * sbrk returns pointer
+
+ Revision 1.5  2003/09/15 20:29:50  marco
   * small fix
 
  Revision 1.4  2003/09/14 20:15:01  marco

+ 31 - 43
rtl/macos/system.pp

@@ -50,7 +50,7 @@ var
 implementation
 
 {$define MACOS_USE_STDCLIB}
- 
+
 
 { include system independent routines }
 {$I system.inc}
@@ -61,7 +61,7 @@ implementation
 ensure it is a supported version. }
 
 {Below is some MacOS API routines needed for internal use.
-Note, because the System unit is the most low level, it should not 
+Note, because the System unit is the most low level, it should not
 depend on any other units, and in particcular not the MacOS unit.
 
 Note: Types like Mac_XXX corresponds to the type XXX defined
@@ -94,8 +94,8 @@ const
   fsFromStart = 1;
   fsFromLEOF = 2;
 
-function NewPtr(logicalSize: Longint): Mac_Ptr ;
-external 'InterfaceLib';
+function Sbrk(logicalSize: Longint): Mac_Ptr ;
+external 'InterfaceLib' name 'NewPtr';
 
 procedure DisposeHandle(hdl: Mac_Handle);
 external 'InterfaceLib';
@@ -164,15 +164,15 @@ external 'InterfaceLib';
 {The reason StdCLib is used is that it can easily be connected
 to either SIOW or, in case of MPWTOOL, to MPW }
 
-{The prefix C_ or c_ is used where names conflicts with pascal 
+{The prefix C_ or c_ is used where names conflicts with pascal
 keywords and names. Suffix Ptr is added for pointer to a type.}
 
 type
   size_t = Longint;
   off_t = Longint;
   C_int = Longint;
-  C_short = Integer;  
-  C_long = Longint;  
+  C_short = Integer;
+  C_long = Longint;
   C_unsigned_int = Cardinal;
 
 var
@@ -204,16 +204,16 @@ const
 
   FIOINTERACTIVE = $00006602; // If device is interactive
   FIOBUFSIZE     = $00006603; // Return optimal buffer size
-  FIOFNAME       = $00006604;	// Return filename
-  FIOREFNUM	     = $00006605; // Return fs refnum
-  FIOSETEOF	     = $00006606; // Set file length
+  FIOFNAME       = $00006604;   // Return filename
+  FIOREFNUM          = $00006605; // Return fs refnum
+  FIOSETEOF          = $00006606; // Set file length
 
-  TIOFLUSH = $00007408;	      // discard unread input.  arg is ignored
+  TIOFLUSH = $00007408;       // discard unread input.  arg is ignored
 
 function C_open(path: PChar; oflag: C_int): C_int;
   external 'StdCLib' name 'open';
 
-function C_close(filedes: C_int): C_int; 
+function C_close(filedes: C_int): C_int;
   external 'StdCLib' name 'close';
 
 function C_write(filedes: C_int; buf: pointer; nbyte: size_t): size_t;
@@ -354,7 +354,7 @@ end;
 *****************************************************************************}
 
 var
-  { Pointer to a block allocated with the MacOS Memory Manager, which 
+  { Pointer to a block allocated with the MacOS Memory Manager, which
     is used as the initial FPC heap. }
   theHeap: Mac_Ptr;
   intern_heapsize : longint;external name 'HEAPSIZE';
@@ -371,21 +371,6 @@ begin
   getheapsize:= intern_heapsize ;
 end;
 
-{ function to allocate size bytes more for the program }
-{ must return the first address of new data space or -1 if fail }
-function Sbrk(size : longint):longint;
-
-var
-  p: Mac_Ptr;
-
-begin
-  p:= NewPtr(size);
-  if p = nil then
-    Sbrk:= -1	//Tell its failed
-  else
-    Sbrk:= longint(p)
-end;
-
 { include standard heap management }
 {$I heap.inc}
 
@@ -417,7 +402,7 @@ begin
   remove(p);
   Errno2InoutRes;
   {$else}
-  InOutRes:=1;  
+  InOutRes:=1;
   {$endif}
 end;
 
@@ -427,7 +412,7 @@ begin
   c_rename(p1,p2);
   Errno2InoutRes;
   {$else}
-  InOutRes:=1;  
+  InOutRes:=1;
   {$endif}
 end;
 
@@ -437,9 +422,9 @@ begin
   do_write:= C_write(h, pointer(addr), len);
   Errno2InoutRes;
   {$else}
-  InOutRes:=1;	
+  InOutRes:=1;
   if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
-    InOutRes:=0;	
+    InOutRes:=0;
   do_write:= len;
   {$endif}
 end;
@@ -464,7 +449,7 @@ begin
   {$else}
   InOutRes:=1;
   if FSread(h, len, Mac_Ptr(addr)) = noErr then
-    InOutRes:=0;	
+    InOutRes:=0;
   do_read:= len;
   {$endif}
 end;
@@ -523,7 +508,7 @@ begin
     begin
       do_filesize := lseek(handle, 0, SEEK_END);
       Errno2InOutRes; {Report the error from this operation.}
-      lseek(handle, aktfilepos, SEEK_SET);   {Always try to move back, 
+      lseek(handle, aktfilepos, SEEK_SET);   {Always try to move back,
          even in presence of error.}
     end
   else
@@ -544,7 +529,7 @@ begin
   Errno2InoutRes;
   {$else}
   InOutRes:=1;
-  do_seek(handle,pos);	//TODO: Is this needed (Does the user anticipate the filemarker is at the end?) 
+  do_seek(handle,pos);  //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
   if SetEOF(handle, pos) = noErr then
     InOutRes:=0;
   {$endif}
@@ -566,7 +551,7 @@ begin
              fullPath, nullString, nullString, alias);
   if res = noErr then
     begin
-      res:= ResolveAlias(nil, alias, spec, wasChanged);    
+      res:= ResolveAlias(nil, alias, spec, wasChanged);
       DisposeHandle(Mac_Handle(alias));
 end;
   FSpLocationFromFullPath:= res;
@@ -671,10 +656,10 @@ begin
   {$else}
 
   InOutRes:=1;
-  //creator:= $522A6368;	{'MPS ' -- MPW}
-  //creator:= $74747874;	{'ttxt'}
-  creator:= $522A6368;	{'R*ch' -- BBEdit}
-  fileType:= $54455854;	{'TEXT'}
+  //creator:= $522A6368;        {'MPS ' -- MPW}
+  //creator:= $74747874;        {'ttxt'}
+  creator:= $522A6368;  {'R*ch' -- BBEdit}
+  fileType:= $54455854; {'TEXT'}
 
   { reset file handle }
   filerec(f).handle:=UnusedHandle;
@@ -787,7 +772,7 @@ end;
 begin
   if false then //To save it from the dead code stripper
     begin
-      //Included only to make them available for debugging in asm. 
+      //Included only to make them available for debugging in asm.
       Debugger;
       DebugStr('');
     end;
@@ -802,7 +787,7 @@ begin
   { Setup heap }
   if Mac_FreeMem - intern_heapsize < 30000 then
     Halt(3);
-  theHeap:= NewPtr(intern_heapsize);
+  theHeap:= Sbrk(intern_heapsize);
   if theHeap = nil then
     Halt(3);  //According to MPW
   InitHeap;
@@ -822,7 +807,10 @@ end.
 
 {
   $Log$
-  Revision 1.6  2003-09-12 12:45:15  olle
+  Revision 1.7  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.6  2003/09/12 12:45:15  olle
     + filehandling complete
     + heaphandling complete
     + support for random

+ 14 - 14
rtl/netware/system.pp

@@ -253,24 +253,21 @@ var  HeapSbrkBlockList : ^THeapSbrkBlockList = nil;
      HeapSbrkAllocated : dword = 0;
 
 { function to allocate size bytes more for the program }
-{ must return the first address of new data space or -1 if fail }
+{ must return the first address of new data space or nil if fail }
 { for netware all allocated blocks are saved to free them at }
 { exit (to avoid message "Module did not release xx resources") }
-Function Sbrk(size : longint):longint;
-var P,P2 : POINTER;
+Function Sbrk(size : longint):pointer;
+var P2 : POINTER;
 begin
-  P := _malloc (size);
-  if P = nil then
-    Sbrk := -1
-  else begin
-    Sbrk := LONGINT (P);
+  Sbrk := _malloc (size);
+  if Sbrk <> nil then begin
     if HeapSbrkBlockList = nil then
     begin
       Pointer (HeapSbrkBlockList) := _malloc (sizeof (HeapSbrkBlockList^));
       if HeapSbrkBlockList = nil then
       begin
-        _free (P);
-        Sbrk := -1;
+        _free (Sbrk);
+        Sbrk := nil;
         exit;
       end;
       fillchar (HeapSbrkBlockList^,sizeof(HeapSbrkBlockList^),0);
@@ -281,14 +278,14 @@ begin
       p2 := _realloc (HeapSbrkBlockList, HeapSbrkAllocated + HeapInitialMaxBlocks);
       if p2 = nil then
       begin
-        _free (P);
-         Sbrk := -1;
+        _free (Sbrk);
+         Sbrk := nil;
          exit;
       end;
       inc (HeapSbrkAllocated, HeapInitialMaxBlocks);
     end;
     inc (HeapSbrkLastUsed);
-    HeapSbrkBlockList^[HeapSbrkLastUsed] := P;
+    HeapSbrkBlockList^[HeapSbrkLastUsed] := Sbrk;
   end;
 end;
 
@@ -815,7 +812,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.17  2003-03-25 18:17:54  armin
+  Revision 1.18  2003-09-27 11:52:35  peter
+    * sbrk returns pointer
+
+  Revision 1.17  2003/03/25 18:17:54  armin
   * support for fcl, support for linking without debug info
   * renamed winsock2 to winsock for win32 compatinility
   * new sockets unit for netware

+ 7 - 4
rtl/os2/system.pas

@@ -295,10 +295,10 @@ end;
 { this function allows to extend the heap by calling
 syscall $7f00 resizes the brk area}
 
-function sbrk(size:longint):longint;
+function sbrk(size:longint):pointer;
 {$IFDEF DUMPGROW}
 var
-  L: longint;
+  L: longword;
 begin
   WriteLn ('Trying to grow heap by ', Size, ' to ', HeapSize + Size);
 {$IFDEF CONTHEAP}
@@ -311,7 +311,7 @@ begin
     mov  %eax,L
   end;
   WriteLn ('New heap at ', L);
-  Sbrk := L;
+  Sbrk := pointer(L);
 end;
 {$ELSE DUMPGROW}
                                      assembler;
@@ -1241,7 +1241,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2003-03-30 09:20:30  hajny
+  Revision 1.33  2003-09-27 11:52:36  peter
+    * sbrk returns pointer
+
+  Revision 1.32  2003/03/30 09:20:30  hajny
     * platform extension unification
 
   Revision 1.31  2003/01/15 22:16:12  hajny

+ 7 - 4
rtl/template/system.pp

@@ -127,8 +127,8 @@ begin
 end;
 
 { function to allocate size bytes more for the program }
-{ must return the first address of new data space or -1 if fail }
-function Sbrk(size : longint):longint;{assembler;
+{ must return the first address of new data space or nil if fail }
+function Sbrk(size : longint):pointer;{assembler;
 asm
         movl    size,%eax
         pushl   %eax
@@ -136,7 +136,7 @@ asm
         addl    $4,%esp
 end;}
 begin
-  Sbrk:=-1;
+  Sbrk:=nil;
 end;
 
 
@@ -291,7 +291,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.8  2002-09-07 16:01:27  peter
+  Revision 1.9  2003-09-27 11:52:36  peter
+    * sbrk returns pointer
+
+  Revision 1.8  2002/09/07 16:01:27  peter
     * old logs removed and tabs fixed
 
   Revision 1.7  2002/04/21 15:55:14  carl

+ 7 - 5
rtl/unix/sysunix.inc

@@ -161,12 +161,11 @@ end;
 {$endif not fpc_getheapsize_ok}
 
 
-Function sbrk(size : longint) : Longint;
+Function sbrk(size : longint) : pointer;
 begin
-  sbrk:=Sys_mmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
-  if sbrk<>-1 then
+  sbrk:=pointer(Sys_mmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
+  if sbrk<>nil then
    errno:=0;
-  {! It must be -1, not 0 as before, see heap.inc. Should be in sysmmap?}
 end;
 
 
@@ -804,7 +803,10 @@ End.
 
 {
   $Log$
-  Revision 1.33  2003-09-03 14:09:37  florian
+  Revision 1.34  2003-09-27 11:52:36  peter
+    * sbrk returns pointer
+
+  Revision 1.33  2003/09/03 14:09:37  florian
     * arm fixes to the common rtl code
     * some generic math code fixed
     * ...

+ 36 - 33
rtl/watcom/prt0.asm

@@ -5,47 +5,50 @@
 .387
 .386p
 
-	name cstart
-	assume nothing
-	extrn PASCALMAIN : near
-	public _cstart_
-	public ___exit
-	public ___sbrk
+        name prt0
+        assume nothing
+        extrn PASCALMAIN : near
+        public start
+        public ___exit
+        public ___sbrk
 
 .STACK 1000h
 .CODE
 
-_cstart_ proc near
-        	jmp     short main
-        	db      "WATCOM"
-	main:
-		push	ds
-		pop	es
-		push	ds
-		pop	fs
-        	call    PASCALMAIN
-_cstart_ endp
+start proc near
+                jmp     short main
+                db      "WATCOM"
+        main:
+                push    ds
+                pop     es
+                push    ds
+                pop     fs
+                call    PASCALMAIN
+                mov     ah,4Ch
+                int     21h
+start endp
 
 ___exit proc near
-		pop	eax
-		mov	ah,4Ch
-		int	21h
+                pop     eax
+                mov     ah,4Ch
+                int     21h
 ___exit endp
 
 ___sbrk proc near
-		mov	ebx,dword ptr [esp+4]
-		mov	ecx,ebx
-		shr	ebx,16
-		mov	ax,501h
-		int	31h
-		jnc	sbrk_ok
-		mov	eax,-1
-		ret
-	sbrk_ok:
-		shl	ebx,16
-		mov	bx,cx
-		mov	eax,ebx
-		ret
+                mov     ebx,dword ptr [esp+4] ; size
+                mov     cx,bx
+                shr     ebx,16
+                mov     ax,501h
+                int     31h
+                jnc     sbrk_ok
+        sbrk_failed:
+                xor     eax,eax
+                ret
+        sbrk_ok:
+                shl     ebx,16
+                mov     bx,cx
+                mov     eax,ebx
+                ret
 ___sbrk endp
 
-end _cstart_
+end start

+ 37 - 93
rtl/watcom/system.pp

@@ -49,6 +49,9 @@ const
 
   FileNameCaseSensitive : boolean = false;
 
+  sLineBreak = LineEnding;
+  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
 { Default memory segments (Tp7 compatibility) }
   seg0040 = $0040;
   segA000 = $A000;
@@ -93,7 +96,6 @@ Const
   procedure sysrealintr(intnr : word;var regs : trealregs);
 
   var tb:longint;
-      transfer_buffer:longint absolute tb;
       tb_segment:word;
 
   const tb_offset=0;
@@ -115,11 +117,9 @@ type
     segment : word;
   end;
 
-{$ifndef EXCEPTIONS_IN_SYSTEM}
 var
   old_int00 : tseginfo;cvar;
   old_int75 : tseginfo;cvar;
-{$endif ndef EXCEPTIONS_IN_SYSTEM}
 
 {$asmmode ATT}
 
@@ -390,23 +390,23 @@ begin
          if h>=5 then
            do_close(h);
       end;
-  { halt is not always called !! }
+  { halt is not allways called !! }
   { not on normal exit !! PM }
-{$ifndef EXCEPTIONS_IN_SYSTEM}
   set_pm_interrupt($00,old_int00);
+{$ifndef EXCEPTIONS_IN_SYSTEM}
   set_pm_interrupt($75,old_int75);
 {$endif EXCEPTIONS_IN_SYSTEM}
   ___exit(exitcode);
 end;
 
 
-{$ifndef EXCEPTIONS_IN_SYSTEM}
 procedure new_int00;
 begin
   HandleError(200);
 end;
 
 
+{$ifndef EXCEPTIONS_IN_SYSTEM}
 procedure new_int75;
 begin
   asm
@@ -424,44 +424,6 @@ end;
 var
   __stkbottom : longint;//###########external name '__stkbottom';
 
-procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
-{
-  called when trying to get local stack if the compiler directive $S
-  is set this function must preserve esi !!!! because esi is set by
-  the calling proc for methods it must preserve all registers !!
-
-  With a 2048 byte safe area used to write to StdIo without crossing
-  the stack boundary
-}
-begin
-  asm
-        pushl   %eax
-        pushl   %ebx
-        movl    stack_size,%ebx
-        addl    $2048,%ebx
-        movl    %esp,%eax
-        subl    %ebx,%eax
-{$ifdef SYSTEMDEBUG}
-        movl    loweststack,%ebx
-        cmpl    %eax,%ebx
-        jb      .L_is_not_lowest
-        movl    %eax,loweststack
-.L_is_not_lowest:
-{$endif SYSTEMDEBUG}
-        movl    __stkbottom,%ebx
-        cmpl    %eax,%ebx
-        jae     .L__short_on_stack
-        popl    %ebx
-        popl    %eax
-        leave
-        ret     $4
-.L__short_on_stack:
-        { can be usefull for error recovery !! }
-        popl    %ebx
-        popl    %eax
-  end['EAX','EBX'];
-  HandleError(202);
-end;
 
 
 {*****************************************************************************
@@ -512,14 +474,14 @@ begin
   getheapsize:=int_heapsize;
 end;
 
-function ___sbrk(size:longint):longint;cdecl; external name '___sbrk';
+function ___sbrk(size:longint):pointer;cdecl; external name '___sbrk';
 
-function Sbrk(size : longint):longint;assembler;
+function Sbrk(size : longint):pointer;assembler;
 asm
 {$ifdef SYSTEMDEBUG}
         cmpb    $1,accept_sbrk
         je      .Lsbrk
-        movl    $-1,%eax
+        movl    $0,%eax
         jmp     .Lsbrk_fail
       .Lsbrk:
 {$endif}
@@ -581,11 +543,9 @@ begin
   syscopytodos(longint(p),strlen(p)+1);
   regs.realedx:=tb_offset;
   regs.realds:=tb_segment;
-{$ifndef RTLLITE}
   if LFNSupport then
    regs.realeax:=$7141
   else
-{$endif RTLLITE}
    regs.realeax:=$4100;
   regs.realesi:=0;
   regs.realecx:=0;
@@ -608,11 +568,9 @@ begin
   regs.realedx:=tb_offset + strlen(p2)+2;
   regs.realds:=tb_segment;
   regs.reales:=tb_segment;
-{$ifndef RTLLITE}
   if LFNSupport then
    regs.realeax:=$7156
   else
-{$endif RTLLITE}
    regs.realeax:=$5600;
   regs.realecx:=$ff;            { attribute problem here ! }
   sysrealintr($21,regs);
@@ -769,7 +727,6 @@ begin
    GetInOutRes(lo(regs.realeax));
 end;
 
-{$ifndef RTLLITE}
 const
   FileHandleCount : longint = 20;
 
@@ -789,7 +746,6 @@ begin
   else
     Increase_file_handle_count:=true;
 end;
-{$endif not RTLLITE}
 
 procedure do_open(var f;p:pchar;flags:longint);
 {
@@ -847,11 +803,9 @@ begin
    end;
 { real dos call }
   syscopytodos(longint(p),strlen(p)+1);
-{$ifndef RTLLITE}
   if LFNSupport then
    regs.realeax:=$716c
   else
-{$endif RTLLITE}
    regs.realeax:=$6c00;
   regs.realedx:=action;
   regs.realds:=tb_segment;
@@ -859,7 +813,6 @@ begin
   regs.realebx:=$2000+(flags and $ff);
   regs.realecx:=$20;
   sysrealintr($21,regs);
-{$ifndef RTLLITE}
   if (regs.realflags and carryflag) <> 0 then
     if lo(regs.realeax)=4 then
       if Increase_file_handle_count then
@@ -876,7 +829,6 @@ begin
           regs.realecx:=$20;
           sysrealintr($21,regs);
         end;
-{$endif RTLLITE}
   if (regs.realflags and carryflag) <> 0 then
     begin
       GetInOutRes(lo(regs.realeax));
@@ -885,11 +837,9 @@ begin
   else
     begin
       filerec(f).handle:=lo(regs.realeax);
-{$ifndef RTLLITE}
       { for systems that have more then 20 by default ! }
       if lo(regs.realeax)>FileHandleCount then
         FileHandleCount:=lo(regs.realeax);
-{$endif RTLLITE}
     end;
   if lo(regs.realeax)<max_files then
     begin
@@ -977,11 +927,9 @@ begin
   syscopytodos(longint(@buffer),length(s)+1);
   regs.realedx:=tb_offset;
   regs.realds:=tb_segment;
-{$ifndef RTLLITE}
   if LFNSupport then
    regs.realeax:=$7100+func
   else
-{$endif RTLLITE}
    regs.realeax:=func shl 8;
   sysrealintr($21,regs);
   if (regs.realflags and carryflag) <> 0 then
@@ -1045,11 +993,9 @@ begin
   regs.realedx:=drivenr;
   regs.realesi:=tb_offset;
   regs.realds:=tb_segment;
-{$ifndef RTLLITE}
   if LFNSupport then
    regs.realeax:=$7147
   else
-{$endif RTLLITE}
    regs.realeax:=$4700;
   sysrealintr($21,regs);
   if (regs.realflags and carryflag) <> 0 then
@@ -1092,7 +1038,6 @@ end;
                          SystemUnit Initialization
 *****************************************************************************}
 
-{$ifndef RTLLITE}
 function CheckLFN:boolean;
 var
   regs     : TRealRegs;
@@ -1109,77 +1054,76 @@ begin
   regs.realds:=tb_segment;
   regs.realedx:=tb_offset;
   regs.realflags:=carryflag;
-  sysrealintr($21,regs);
+//!!  sysrealintr($21,regs); //!!wik
 { If carryflag=0 and LFN API bit in ebx is set then use Long file names }
   CheckLFN:=(regs.realflags and carryflag=0) and (regs.realebx and $4000=$4000);
 end;
-{$endif RTLLITE}
 
-{$ifdef MT}
-{$I thread.inc}
-{$endif MT}
-
-{$ifndef RTLLITE}
 {$ifdef  EXCEPTIONS_IN_SYSTEM}
 {$define IN_SYSTEM}
 {$i dpmiexcp.pp}
 {$endif  EXCEPTIONS_IN_SYSTEM}
-{$endif RTLLITE}
+
+procedure SysInitStdIO;
+begin
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
 
 var
   temp_int : tseginfo;
 Begin
   alloc_tb;
-{$ifndef EXCEPTIONS_IN_SYSTEM}
+  StackLength := InitialStkLen;
+  StackBottom := __stkbottom;
+  { To be set if this is a GUI or console application }
+  IsConsole := TRUE;
+  { To be set if this is a library and not a program  }
+  IsLibrary := FALSE;
 { save old int 0 and 75 }
   get_pm_interrupt($00,old_int00);
   get_pm_interrupt($75,old_int75);
   temp_int.segment:=get_cs;
   temp_int.offset:=@new_int00;
   set_pm_interrupt($00,temp_int);
+{$ifndef EXCEPTIONS_IN_SYSTEM}
   temp_int.offset:=@new_int75;
   set_pm_interrupt($75,temp_int);
 {$endif EXCEPTIONS_IN_SYSTEM}
-{$IFDEF SYSTEMDEBUG}
-{ to test stack depth }
-  loweststack:=maxlongint;
-{$ENDIF}
 { Setup heap }
   InitHeap;
-{$ifdef MT}
-  { before this, you can't use thread vars !!!! }
-  { threadvarblocksize is calculate before the initialization }
-  { of the system unit                                        }
-  mainprogramthreadblock :=  sysgetmem(threadvarblocksize);
-{$endif MT}
-  InitExceptions;
+  SysInitExceptions;
 { Setup stdin, stdout and stderr }
-  OpenStdIO(Input,fmInput,StdInputHandle);
-  OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  SysInitStdIO;
 { Setup environment and arguments }
-  Setup_Environment;
-  Setup_Arguments;
+//  Setup_Environment;
+//  Setup_Arguments;
 { Use LFNSupport LFN }
   LFNSupport:=CheckLFN;
   if LFNSupport then
    FileNameCaseSensitive:=true;
 { Reset IO Error }
   InOutRes:=0;
-{$ifndef RTLLITE}
 {$ifdef  EXCEPTIONS_IN_SYSTEM}
   InitDPMIExcp;
   InstallDefaultHandlers;
 {$endif  EXCEPTIONS_IN_SYSTEM}
-{$endif RTLLITE}
+{$ifdef HASVARIANT}
+  initvariantmanager;
+{$endif HASVARIANT}
 End.
 
 END.
 
 {
   $Log$
-  Revision 1.2  2003-09-07 22:29:26  hajny
+  Revision 1.3  2003-09-27 11:52:36  peter
+    * sbrk returns pointer
+
+  Revision 1.2  2003/09/07 22:29:26  hajny
     * syswat renamed to system, CVS log added
 
 

+ 7 - 6
rtl/win32/system.pp

@@ -271,17 +271,15 @@ asm
 end ['EAX'];
 
 
-function Sbrk(size : longint):longint;
+function Sbrk(size : longint):pointer;
 var
-  l : longint;
+  l : longword;
 begin
   l := HeapAlloc(GetProcessHeap(), 0, size);
-  if (l = 0) then
-    l := -1;
 {$ifdef DUMPGROW}
   Writeln('new heap part at $',hexstr(l,8), ' size = ',WinAPIHeapSize(GetProcessHeap()));
 {$endif}
-  sbrk:=l;
+  sbrk:=pointer(l);
 end;
 
 { include standard heap management }
@@ -1532,7 +1530,10 @@ end.
 
 {
   $Log$
-  Revision 1.43  2003-09-26 07:30:34  michael
+  Revision 1.44  2003-09-27 11:52:36  peter
+    * sbrk returns pointer
+
+  Revision 1.43  2003/09/26 07:30:34  michael
   + Win32 Do_open crahs on append
 
   Revision 1.42  2003/09/17 15:06:36  peter