Просмотр исходного кода

* FPC_ names
* Heap manager is now system independent

peter 27 лет назад
Родитель
Сommit
4620a73a9b

+ 22 - 6
rtl/amiga/sysamiga.pas

@@ -885,6 +885,18 @@ const
          randseed:=time.ds_tick;
          randseed:=time.ds_tick;
       end;
       end;
 
 
+function getheapstart:pointer;assembler;
+asm
+        lea.l   HEAP,a0
+        move.l  a0,d0
+end;
+
+
+function getheapsize:longint;assembler;
+asm
+       move.l   HEAP_SIZE,d0
+end ['D0'];
+
   { This routine is used to grow the heap.  }
   { This routine is used to grow the heap.  }
   { But here we do a trick, we say that the }
   { But here we do a trick, we say that the }
   { heap cannot be regrown!                 }
   { heap cannot be regrown!                 }
@@ -1645,15 +1657,15 @@ end;
              path:=path+':';
              path:=path+':';
           end;
           end;
 
 
-	       len := len + elen;
+               len := len + elen;
 
 
-	       UnLock(lock);
-	       lock := newlock;
+               UnLock(lock);
+               lock := newlock;
     end;
     end;
     if (lock <> 0) then
     if (lock <> 0) then
     Begin
     Begin
-	    UnLock(lock);
-	    path := '';
+            UnLock(lock);
+            path := '';
     end;
     end;
     if assigned(fib) then dispose(fib);
     if assigned(fib) then dispose(fib);
  end;
  end;
@@ -1800,7 +1812,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.9  1998-08-17 12:34:22  carl
+  Revision 1.10  1998-09-14 10:48:00  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.9  1998/08/17 12:34:22  carl
     * chdir accepts .. characters
     * chdir accepts .. characters
     + added ctrl-c checking
     + added ctrl-c checking
     + implemented sbrk
     + implemented sbrk

+ 19 - 3
rtl/atari/sysatari.pas

@@ -36,7 +36,7 @@ unit sysatari;
     {$I heaph.inc}
     {$I heaph.inc}
 
 
 const
 const
-  UnusedHandle    = $ffff; 
+  UnusedHandle    = $ffff;
   StdInputHandle  = 0;
   StdInputHandle  = 0;
   StdOutputHandle = 1;
   StdOutputHandle = 1;
   StdErrorHandle  = $ffff;
   StdErrorHandle  = $ffff;
@@ -234,6 +234,18 @@ const
          randseed:=hl;
          randseed:=hl;
       end;
       end;
 
 
+function getheapstart:pointer;assembler;
+asm
+        lea.l   HEAP,a0
+        move.l  a0,d0
+end;
+
+
+function getheapsize:longint;assembler;
+asm
+       move.l   HEAP_SIZE,d0
+end ['D0'];
+
   { This routine is used to grow the heap.  }
   { This routine is used to grow the heap.  }
   { But here we do a trick, we say that the }
   { But here we do a trick, we say that the }
   { heap cannot be regrown!                 }
   { heap cannot be regrown!                 }
@@ -697,7 +709,7 @@ end;
 {*****************************************************************************
 {*****************************************************************************
                          SystemUnit Initialization
                          SystemUnit Initialization
 *****************************************************************************}
 *****************************************************************************}
-      
+
 
 
 begin
 begin
 { Initialize ExitProc }
 { Initialize ExitProc }
@@ -719,7 +731,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-07-15 12:11:59  carl
+  Revision 1.9  1998-09-14 10:48:02  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.8  1998/07/15 12:11:59  carl
     * hmmm... can't remember! :(...
     * hmmm... can't remember! :(...
 
 
   Revision 1.5  1998/07/13 12:34:13  carl
   Revision 1.5  1998/07/13 12:34:13  carl

+ 22 - 6
rtl/dos/go32v1/system.pp

@@ -98,7 +98,7 @@ implementation
 {$I system.inc}
 {$I system.inc}
 
 
 {$ASMMODE DIRECT}
 {$ASMMODE DIRECT}
-procedure int_stackcheck(stack_size:longint);[public,alias: 'STACKCHECK'];
+procedure int_stackcheck(stack_size:longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STACKCHECK'];
 begin
 begin
 { called when trying to get local stack
 { called when trying to get local stack
   if the compiler directive $S is set
   if the compiler directive $S is set
@@ -183,6 +183,18 @@ end;
                               Heap Management
                               Heap Management
 *****************************************************************************}
 *****************************************************************************}
 
 
+function getheapstart:pointer;assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+
+
+function getheapsize:longint;assembler;
+asm
+        movl    HEAPSIZE,%eax
+end ['EAX'];
+
+
 function Sbrk(size : longint) : longint;assembler;
 function Sbrk(size : longint) : longint;assembler;
 asm
 asm
         movl    size,%ebx
         movl    size,%ebx
@@ -458,11 +470,11 @@ asm
         popl    %ebp
         popl    %ebp
         jnc     .LDOSDEVICE
         jnc     .LDOSDEVICE
         movw    %ax,inoutres
         movw    %ax,inoutres
-	     xorl	%edx,%edx
+             xorl       %edx,%edx
   .LDOSDEVICE:
   .LDOSDEVICE:
-        movl	%edx,%eax
-	     shrl	$7,%eax
-        andl	$1,%eax
+        movl    %edx,%eax
+             shrl       $7,%eax
+        andl    $1,%eax
 end;
 end;
 
 
 
 
@@ -597,7 +609,11 @@ Begin
 End.
 End.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-07-30 13:28:33  michael
+  Revision 1.9  1998-09-14 10:48:03  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.8  1998/07/30 13:28:33  michael
   + Added support for errorproc. Changed runerror to HandleError
   + Added support for errorproc. Changed runerror to HandleError
 
 
   Revision 1.7  1998/07/07 12:30:20  carl
   Revision 1.7  1998/07/07 12:30:20  carl

+ 19 - 4
rtl/dos/go32v2/system.pp

@@ -29,7 +29,7 @@ interface
 
 
 const
 const
 { Default filehandles }
 { Default filehandles }
-  UnusedHandle    = $ffff;
+  UnusedHandle    = -1;
   StdInputHandle  = 0;
   StdInputHandle  = 0;
   StdOutputHandle = 1;
   StdOutputHandle = 1;
   StdErrorHandle  = 2;
   StdErrorHandle  = 2;
@@ -134,7 +134,6 @@ var
 procedure halt(errnum : byte);
 procedure halt(errnum : byte);
 begin
 begin
   do_exit;
   do_exit;
-  flush(stderr);
   asm
   asm
         movzbw  errnum,%ax
         movzbw  errnum,%ax
         pushw   %ax
         pushw   %ax
@@ -143,7 +142,7 @@ begin
 end;
 end;
 
 
 
 
-procedure int_stackcheck(stack_size:longint);[public,alias: 'STACKCHECK'];
+procedure int_stackcheck(stack_size:longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STACKCHECK'];
 {
 {
   called when trying to get local stack if the compiler directive $S
   called when trying to get local stack if the compiler directive $S
   is set this function must preserve esi !!!! because esi is set by
   is set this function must preserve esi !!!! because esi is set by
@@ -563,6 +562,18 @@ end;
 
 
 {$ASMMODE DIRECT}
 {$ASMMODE DIRECT}
 
 
+function getheapstart:pointer;assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+
+
+function getheapsize:longint;assembler;
+asm
+        movl    HEAPSIZE,%eax
+end ['EAX'];
+
+
 function Sbrk(size : longint):longint;assembler;
 function Sbrk(size : longint):longint;assembler;
 asm
 asm
         movl    size,%eax
         movl    size,%eax
@@ -1106,7 +1117,11 @@ Begin
 End.
 End.
 {
 {
   $Log$
   $Log$
-  Revision 1.18  1998-08-28 10:48:04  peter
+  Revision 1.19  1998-09-14 10:48:05  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.18  1998/08/28 10:48:04  peter
     * fixed chdir with drive changing
     * fixed chdir with drive changing
     * updated checklfn from mailinglist
     * updated checklfn from mailinglist
 
 

+ 8 - 8
rtl/i386/cpu.pp

@@ -5,7 +5,7 @@
 
 
     This unit contains some routines to get informations about the
     This unit contains some routines to get informations about the
     processor
     processor
-    
+
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
 
 
@@ -29,12 +29,8 @@ unit cpu;
 
 
   implementation
   implementation
 
 
-{$ifdef VER0_99_5}
-  {$I386_INTEL}
-{$endif}
-
 {$ASMMODE INTEL}
 {$ASMMODE INTEL}
-  
+
 
 
     function cpuid_support : boolean;assembler;
     function cpuid_support : boolean;assembler;
       {
       {
@@ -64,7 +60,7 @@ unit cpu;
          DB 0Fh,20h,0C0h
          DB 0Fh,20h,0C0h
          { mov eax,cr0
          { mov eax,cr0
            special registers are not allowed in the assembler
            special registers are not allowed in the assembler
-  	        parsers }
+                parsers }
       end;
       end;
 
 
 
 
@@ -79,7 +75,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-08-11 00:04:46  peter
+  Revision 1.5  1998-09-14 10:48:06  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.4  1998/08/11 00:04:46  peter
     * $ifdef ver0_99_5 updates
     * $ifdef ver0_99_5 updates
 
 
   Revision 1.3  1998/05/25 10:51:27  pierre
   Revision 1.3  1998/05/25 10:51:27  pierre

+ 74 - 134
rtl/i386/i386.inc

@@ -89,7 +89,7 @@ begin
 end;
 end;
 
 
 
 
-Procedure FillChar(var x;count:longint;value:byte);[alias: 'FILL_OBJECT'];
+Procedure FillChar(var x;count:longint;value:byte);[alias: 'FPC_FILL_OBJECT'];
 begin
 begin
         asm
         asm
         cld
         cld
@@ -151,7 +151,7 @@ end;
 
 
 {$ASMMODE DIRECT}
 {$ASMMODE DIRECT}
 
 
-procedure int_help_constructor;assembler; [public,alias:'HELP_CONSTRUCTOR'];
+procedure int_help_constructor;assembler; [public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'HELP_CONSTRUCTOR'];
 asm
 asm
 { Entry without preamble, since we need the ESP of the constructor
 { Entry without preamble, since we need the ESP of the constructor
   Stack (relative to %ebp):
   Stack (relative to %ebp):
@@ -173,7 +173,11 @@ asm
       { Memory size }
       { Memory size }
         pushl   (%eax)
         pushl   (%eax)
         pushl   %esi
         pushl   %esi
+{$ifdef FPCNAMES}
+        call    FPC_GETMEM
+{$else}
         call    GETMEM
         call    GETMEM
+{$endif}
         popal
         popal
       { Memory size to %esi }
       { Memory size to %esi }
         movl    (%esi),%esi
         movl    (%esi),%esi
@@ -197,7 +201,7 @@ asm
         pushw   $0
         pushw   $0
         pushl   (%eax)
         pushl   (%eax)
         pushl   %esi
         pushl   %esi
-        call    FILL_OBJECT
+        call    FPC_FILL_OBJECT
         popal
         popal
       { set the VMT address for the new created object }
       { set the VMT address for the new created object }
         movl    %eax,(%esi)
         movl    %eax,(%esi)
@@ -211,7 +215,7 @@ asm
 end;
 end;
 
 
 
 
-procedure int_new_class;assembler;[public,alias:'NEW_CLASS'];
+procedure int_new_class;assembler;[public,alias:'FPC_NEW_CLASS'];
 asm
 asm
      { create class ? }
      { create class ? }
      movl 8(%ebp),%edi
      movl 8(%ebp),%edi
@@ -232,7 +236,7 @@ asm
 end;
 end;
 
 
 
 
-procedure int_dispose_class;assembler;[public,alias:'DISPOSE_CLASS'];
+procedure int_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS'];
 asm
 asm
      { destroy class ? }
      { destroy class ? }
      movl 8(%ebp),%edi
      movl 8(%ebp),%edi
@@ -253,7 +257,7 @@ end;
 
 
 
 
 { checks for a correct vmt pointer }
 { checks for a correct vmt pointer }
-procedure int_check_object;assembler;[public,alias:'CHECK_OBJECT'];
+procedure int_check_object;assembler;[public,alias:'FPC_CHECK_OBJECT'];
 asm
 asm
      pushl %edi
      pushl %edi
      movl 8(%esp),%edi
      movl 8(%esp),%edi
@@ -273,11 +277,11 @@ asm
      ret $4
      ret $4
 .Lco_re:
 .Lco_re:
      pushl $210
      pushl $210
-     call handleerror
+     call FPC_HANDLEERROR
 end;
 end;
 
 
 
 
-procedure int_help_destructor;assembler;[public,alias:'HELP_DESTRUCTOR'];
+procedure int_help_destructor;assembler;[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'HELP_DESTRUCTOR'];
 asm
 asm
 { Stack (relative to %ebp):
 { Stack (relative to %ebp):
     12 Self
     12 Self
@@ -305,7 +309,11 @@ asm
         movl    $0,(%eax)
         movl    $0,(%eax)
         movl    %eax,(%edi)
         movl    %eax,(%edi)
         pushl   %edi
         pushl   %edi
+{$ifdef FPCNAMES}
+        call    FPC_FREEMEM
+{$else}
         call    FREEMEM
         call    FREEMEM
+{$endif}
 .LHD_3:
 .LHD_3:
         popal
         popal
         addl    $4,%esp
         addl    $4,%esp
@@ -318,7 +326,7 @@ end;
                                  String
                                  String
 ****************************************************************************}
 ****************************************************************************}
 
 
-procedure strcopy(dstr,sstr:pointer;len:longint);[public,alias:'STRCOPY'];
+procedure strcopy(dstr,sstr:pointer;len:longint);[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'STRCOPY'];
 {
 {
   this procedure must save all modified registers except EDI and ESI !!!
   this procedure must save all modified registers except EDI and ESI !!!
 }
 }
@@ -360,7 +368,7 @@ begin
 end;
 end;
 
 
 
 
-procedure strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
+procedure strconcat(s1,s2 : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STRCONCAT'];
 begin
 begin
   asm
   asm
         xorl    %ecx,%ecx
         xorl    %ecx,%ecx
@@ -399,7 +407,7 @@ begin
 end;
 end;
 
 
 
 
-procedure strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
+procedure strcmp(dstr,sstr : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STRCMP'];
 begin
 begin
   asm
   asm
         cld
         cld
@@ -499,13 +507,20 @@ asm
         subl    %ecx,%eax
         subl    %ecx,%eax
 end ['EDI','ECX','EAX'];
 end ['EDI','ECX','EAX'];
 
 
+
 {****************************************************************************
 {****************************************************************************
-                                 Other
+                       Caller/StackFrame Helpers
 ****************************************************************************}
 ****************************************************************************}
 
 
-function get_addr(addrbp:longint):longint;assembler;
+function get_frame:longint;assembler;
+asm
+        movl    %ebp,%eax
+end ['EAX'];
+
+
+function get_caller_addr(framebp:longint):longint;assembler;
 asm
 asm
-        movl    addrbp,%eax
+        movl    framebp,%eax
         orl     %eax,%eax
         orl     %eax,%eax
         jz      .Lg_a_null
         jz      .Lg_a_null
         movl    4(%eax),%eax
         movl    4(%eax),%eax
@@ -513,7 +528,7 @@ asm
 end ['EAX'];
 end ['EAX'];
 
 
 
 
-function get_next_frame(framebp:longint):longint;assembler;
+function get_caller_frame(framebp:longint):longint;assembler;
 asm
 asm
         movl    framebp,%eax
         movl    framebp,%eax
         orl     %eax,%eax
         orl     %eax,%eax
@@ -523,101 +538,9 @@ asm
 end ['EAX'];
 end ['EAX'];
 
 
 
 
-Procedure HandleError (Errno : longint);[alias : 'handleerror'];
-{
-  Procedure to handle internal errors, i.e. not user-invoked errors
-  Internal function should ALWAYS call HandleError instead of RunError.
-}
-function get_addr : Pointer;assembler;
-asm
-  movl (%ebp),%eax
-  movl 4(%eax),%eax
-end;
-
-function get_error_bp : Longint;assembler;
-asm
-   movl (%ebp),%eax
-end;
-
-begin
-  If ErrorProc<>Nil then
-    TErrorProc (ErrorProc)(Errno,get_addr);
-  errorcode:=Errno;
-  exitcode:=Errno;
-  erroraddr:=Get_addr;
-  DoError := TRUE;
-  errorbase:=get_error_bp;
-  halt(errorcode);
-end;
-
-procedure runerror(w : word);[alias: 'runerror'];
-
-  function get_addr : Pointer;assembler;
-  asm
-    movl (%ebp),%eax
-    movl 4(%eax),%eax
-  end;
-
-  function get_error_bp : Longint;assembler;
-  asm
-    movl (%ebp),%eax {%ebp of run_error}
-  end;
-
-begin
-  errorcode:=w;
-  exitcode:=w;
-  erroraddr:=pointer(get_addr);
-  DoError := TRUE;
-  errorbase:=get_error_bp;
-  halt(errorcode);
-end;
-
-procedure int_iocheck(addr : longint);[public,alias: 'IOCHECK'];
-var
-  l : longint;
-begin
-{ Since IOCHECK is called directly and only later the optimiser }
-{ Maybe also save global registers  }
-  asm
-        pushal
-  end;
-  l:=ioresult;
-  if l<>0 then
-   begin
-     If ErrorProc<>Nil then
-       TErrorProc(Errorproc)(l,pointer(addr));
-{$ifndef RTLLITE}
-     writeln('IO-Error ',l,' at 0x',HexStr(addr,8));
-{$else}
-     writeln('IO-Error ',l,' at ',addr);
-{$endif}
-     Halt(byte(l));
-   end;
-  asm
-        popal
-   end;
-end;
-
-
-procedure int_re_overflow;[public,alias: 'RE_OVERFLOW'];
-var
-  addr : longint;
-begin
-{ Overflow was shortly before the return address }
-   asm
-        movl    4(%ebp),%edi
-        movl    %edi,addr
-   end;
-   If ErrorProc<>Nil then
-     TErrorProc (ErrorProc)(215,Pointer(Addr));
-{$ifndef RTLLITE}
-   writeln('Overflow at 0x',HexStr(addr,8));
-{$else}
-   writeln('Overflow at ',addr);
-{$endif}
-   HandleError(215);
-end;
-
+{****************************************************************************
+                                 Math
+****************************************************************************}
 
 
 function abs(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_abs];{$endif}
 function abs(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_abs];{$endif}
 asm
 asm
@@ -644,6 +567,20 @@ asm
 end ['EAX'];
 end ['EAX'];
 
 
 
 
+Function Sptr : Longint;
+begin
+  asm
+    movl %esp,%eax
+    addl $8,%eax
+    movl %eax,-4(%ebp)
+  end ['EAX'];
+end;
+
+
+{****************************************************************************
+                                 Str()
+****************************************************************************}
+
     procedure int_str(l : longint;var s : string);
     procedure int_str(l : longint;var s : string);
 
 
       var
       var
@@ -719,40 +656,43 @@ end ['EAX'];
          end;
          end;
       end;
       end;
 
 
-{$ifdef VER0_99_5}
-    procedure f1;[public,alias: 'FLUSH_STDOUT'];
-
-      begin
-         asm
-            pushal
-         end;
-         FileFunc(textrec(output).flushfunc)(textrec(output));
-         asm
-            popal
-         end;
-      end;
-{$endif VER0_99_5}
 
 
+{****************************************************************************
+                                 IoCheck
+****************************************************************************}
 
 
-Function Sptr : Longint;
+procedure int_iocheck(addr : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'IOCHECK'];
+var
+  l : longint;
 begin
 begin
   asm
   asm
-    movl %esp,%eax
-    addl $8,%eax
-    movl %eax,-4(%ebp)
-  end ['EAX'];
+        pushal
+  end;
+  if InOutRes<>0 then
+   begin
+     l:=InOutRes;
+     InOutRes:=0;
+     If ErrorProc<>Nil then
+       TErrorProc(Errorproc)(l,pointer(addr));
+{$ifndef RTLLITE}
+     writeln('IO-Error ',l,' at 0x',HexStr(addr,8));
+{$endif}
+     Halt(byte(l));
+   end;
+  asm
+        popal
+  end;
 end;
 end;
 
 
 
 
-{$ifdef VER_0_99_5}
-  {$I386_DIRECT}
-{$endif}
-
-{$ASMMODE ATT}
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.20  1998-09-11 17:38:48  pierre
+  Revision 1.21  1998-09-14 10:48:08  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.20  1998/09/11 17:38:48  pierre
      merge for fixes branch
      merge for fixes branch
 
 
   Revision 1.19.2.1  1998/09/11 17:37:24  pierre
   Revision 1.19.2.1  1998/09/11 17:37:24  pierre

+ 1 - 1
rtl/i386/makefile.cpu

@@ -2,6 +2,6 @@
 # Here we set processor dependent include file names.
 # Here we set processor dependent include file names.
 #
 #
 
 
-CPUNAMES=i386 heap math set rttip setjump setjumph
+CPUNAMES=i386 math set rttip setjump setjumph
 CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
 CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
 
 

+ 216 - 212
rtl/i386/rttip.inc

@@ -16,352 +16,356 @@
 { Run-Time type information routines - processor dependent part }
 { Run-Time type information routines - processor dependent part }
 {$ASMMODE DIRECT}
 {$ASMMODE DIRECT}
 
 
-Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias : 'INITIALIZE'];assembler;
+Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];assembler;
 
 
 asm
 asm
 # Save registers
 # Save registers
         push    %eax
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # decide what type it is
 # decide what type it is
-	movl	12(%ebp),%ebx
-	movb	(%ebx),%al
-	subb	$10,%al
-	jz	.DoAnsiStringInit
-	decb	%al
-	jz	.DoAnsiStringInit
-	subb	$2,%al
-	jz	.DoArrayInit
-	decb	%al
-	jz	.DoRecordInit
-	decb	%al
-	decb	%al
+        movl    12(%ebp),%ebx
+        movb    (%ebx),%al
+        subb    $10,%al
+        jz      .DoAnsiStringInit
+        decb    %al
+        jz      .DoAnsiStringInit
+        subb    $2,%al
+        jz      .DoArrayInit
+        decb    %al
+        jz      .DoRecordInit
+        decb    %al
+        decb    %al
         jz      .DoObjectInit
         jz      .DoObjectInit
-	decb	%al
+        decb    %al
         jz      .DoClassInit
         jz      .DoClassInit
-	jmp	.ExitInitialize
+        jmp     .ExitInitialize
 .DoObjectInit:
 .DoObjectInit:
 .DoClassInit:
 .DoClassInit:
 .DoRecordInit:
 .DoRecordInit:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
 # Skip also recordsize.
-        addl    $5,%eax 
-	addl	%eax,%ebx
+        addl    $5,%eax
+        addl    %eax,%ebx
 # %ebx points to element count. Set in %edx
 # %ebx points to element count. Set in %edx
-	movl	(%ebx),%edx
-	addl    $4,%ebx
+        movl    (%ebx),%edx
+        addl    $4,%ebx
 # %ebx points to First element in record
 # %ebx points to First element in record
 .MyRecordInitLoop:
 .MyRecordInitLoop:
-	decl    %edx
-	jl	.ExitInitialize
+        decl    %edx
+        jl      .ExitInitialize
 # Calculate data
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
 # push data
-	pushl    %eax
-	call	INITIALIZE
-	jmp     .MyRecordInitLoop
+        pushl    %eax
+        call    FPC_INITIALIZE
+        jmp     .MyRecordInitLoop
 # Array handling
 # Array handling
 .DoArrayInit:
 .DoArrayInit:
 # %ebx points to size. Put size in ecx
 # %ebx points to size. Put size in ecx
-	movl	(%ebx),%ecx
-	addl    $4, %ebx
-# %ebx points to count. Put count in %edx 
-	movl	(%ebx),%edx
-	addl    $4, %ebx
+        movl    (%ebx),%ecx
+        addl    $4, %ebx
+# %ebx points to count. Put count in %edx
+        movl    (%ebx),%edx
+        addl    $4, %ebx
 # %ebx points to type. Put into ebx.
 # %ebx points to type. Put into ebx.
 # Start treating elements.
 # Start treating elements.
 .MyArrayInitLoop:
 .MyArrayInitLoop:
-	decl	%edx
-	jl	.ExitInitialize
+        decl    %edx
+        jl      .ExitInitialize
 # push type
 # push type
         pushl   (%ebx)
         pushl   (%ebx)
 # calculate data
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
 # push data
-	pushl   %eax 
-	call	INITIALIZE
-	jmp	.MyArrayInitLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_INITIALIZE
+        jmp     .MyArrayInitLoop
+# AnsiString handling :
 .DoAnsiStringInit:
 .DoAnsiStringInit:
-	movl	$0,8(%ebp)
+        movl    $0,8(%ebp)
 .ExitInitialize:
 .ExitInitialize:
         pop     %edx
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 end;
 
 
-Procedure Finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FINALIZE']; assembler;
+Procedure Finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE']; assembler;
 
 
 asm
 asm
         push    %eax
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # decide what type it is
 # decide what type it is
-	movl	12(%ebp),%ebx
-	movb	(%ebx),%al
-	subb	$10,%al
-	jz	.DoAnsiStringFinal
-	decb	%al
-	jz	.DoAnsiStringFinal
-	subb	$2,%al
-	jz	.DoArrayFinal
-	decb	%al
-	jz	.DoRecordFinal
-	decb	%al
-	decb	%al
+        movl    12(%ebp),%ebx
+        movb    (%ebx),%al
+        subb    $10,%al
+        jz      .DoAnsiStringFinal
+        decb    %al
+        jz      .DoAnsiStringFinal
+        subb    $2,%al
+        jz      .DoArrayFinal
+        decb    %al
+        jz      .DoRecordFinal
+        decb    %al
+        decb    %al
         jz      .DoObjectFinal
         jz      .DoObjectFinal
-	decb	%al
+        decb    %al
         jz      .DoClassFinal
         jz      .DoClassFinal
-	jmp	.ExitFinalize
+        jmp     .ExitFinalize
 .DoClassFinal:
 .DoClassFinal:
 .DoObjectFinal:
 .DoObjectFinal:
 .DoRecordFinal:
 .DoRecordFinal:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
 # Skip also recordsize.
         addl    $5,%eax
         addl    $5,%eax
-	addl	%eax,%ebx
+        addl    %eax,%ebx
 # %ebx points to element count. Set in %edx
 # %ebx points to element count. Set in %edx
-	movl	(%ebx),%edx
-	addl    $4,%ebx
+        movl    (%ebx),%edx
+        addl    $4,%ebx
 # %ebx points to First element in record
 # %ebx points to First element in record
 .MyRecordFinalLoop:
 .MyRecordFinalLoop:
-	decl    %edx
-	jl	.ExitFinalize
+        decl    %edx
+        jl      .ExitFinalize
 # Calculate data
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
 # push data
-	pushl    %eax
-	call	FINALIZE
-	jmp     .MyRecordFinalLoop
+        pushl    %eax
+        call    FPC_FINALIZE
+        jmp     .MyRecordFinalLoop
 # Array handling
 # Array handling
 .DoArrayFinal:
 .DoArrayFinal:
 # %ebx points to size. Put size in ecx
 # %ebx points to size. Put size in ecx
-	movl	(%ebx),%ecx
-	addl    $4, %ebx
-# %ebx points to count. Put count in %edx 
-	movl	(%ebx),%edx
-	addl    $4, %ebx
+        movl    (%ebx),%ecx
+        addl    $4, %ebx
+# %ebx points to count. Put count in %edx
+        movl    (%ebx),%edx
+        addl    $4, %ebx
 # %ebx points to type. Put into ebx.
 # %ebx points to type. Put into ebx.
 # Start treating elements.
 # Start treating elements.
 .MyArrayFinalLoop:
 .MyArrayFinalLoop:
-	decl	%edx
-	jl	.ExitFinalize
+        decl    %edx
+        jl      .ExitFinalize
 # push type
 # push type
         pushl   (%ebx)
         pushl   (%ebx)
 # calculate data
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
 # push data
-	pushl   %eax 
-	call	FINALIZE
-	jmp	.MyArrayFinalLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_FINALIZE
+        jmp     .MyArrayFinalLoop
+# AnsiString handling :
 .DoAnsiStringFinal:
 .DoAnsiStringFinal:
-	movl	8(%ebp),%eax
-	pushl   %eax
-	call    DECR_ANSI_REF
+        movl    8(%ebp),%eax
+        pushl   %eax
+        call    FPC_DECR_ANSI_REF
 .ExitFinalize:
 .ExitFinalize:
         pop     %edx
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 end;
 
 
-Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'ADDREF'];Assembler;
+Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler;
 
 
 asm
 asm
 # Save registers
 # Save registers
         push    %eax
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # decide what type it is
 # decide what type it is
-	movl	12(%ebp),%ebx
-	movb	(%ebx),%al
-	subb	$10,%al
-	jz	.DoAnsiStringAddRef
-	decb	%al
-	jz	.DoAnsiStringAddRef
-	subb	$2,%al
-	jz	.DoArrayAddRef
-	decb	%al
-	jz	.DoRecordAddRef
-	decb	%al
-	decb	%al
+        movl    12(%ebp),%ebx
+        movb    (%ebx),%al
+        subb    $10,%al
+        jz      .DoAnsiStringAddRef
+        decb    %al
+        jz      .DoAnsiStringAddRef
+        subb    $2,%al
+        jz      .DoArrayAddRef
+        decb    %al
+        jz      .DoRecordAddRef
+        decb    %al
+        decb    %al
         jz      .DoObjectAddRef
         jz      .DoObjectAddRef
-	decb	%al
+        decb    %al
         jz      .DoClassAddRef
         jz      .DoClassAddRef
-	jmp	.ExitAddRef
+        jmp     .ExitAddRef
 .DoClassAddRef:
 .DoClassAddRef:
 .DoObjectAddRef:
 .DoObjectAddRef:
 .DoRecordAddRef:
 .DoRecordAddRef:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
 # Skip also recordsize.
         addl    $5,%eax
         addl    $5,%eax
-	addl	%eax,%ebx
+        addl    %eax,%ebx
 # %ebx points to element count. Set in %edx
 # %ebx points to element count. Set in %edx
-	movl	(%ebx),%edx
-	addl    $4,%ebx
+        movl    (%ebx),%edx
+        addl    $4,%ebx
 # %ebx points to First element in record
 # %ebx points to First element in record
 .MyRecordAddRefLoop:
 .MyRecordAddRefLoop:
-	decl    %edx
-	jl	.ExitAddRef
+        decl    %edx
+        jl      .ExitAddRef
 # Calculate data
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
 # push data
-	pushl    %eax
-	call	ADDREF
-	jmp     .MyRecordAddRefLoop
+        pushl    %eax
+        call    FPC_ADDREF
+        jmp     .MyRecordAddRefLoop
 # Array handling
 # Array handling
 .DoArrayAddRef:
 .DoArrayAddRef:
 # %ebx points to size. Put size in ecx
 # %ebx points to size. Put size in ecx
-	movl	(%ebx),%ecx
-	addl    $4, %ebx
-# %ebx points to count. Put count in %edx 
-	movl	(%ebx),%edx
-	addl    $4, %ebx
+        movl    (%ebx),%ecx
+        addl    $4, %ebx
+# %ebx points to count. Put count in %edx
+        movl    (%ebx),%edx
+        addl    $4, %ebx
 # %ebx points to type. Put into ebx.
 # %ebx points to type. Put into ebx.
 # Start treating elements.
 # Start treating elements.
 .MyArrayAddRefLoop:
 .MyArrayAddRefLoop:
-	decl	%edx
-	jl	.ExitAddRef
+        decl    %edx
+        jl      .ExitAddRef
 # push type
 # push type
         pushl   (%ebx)
         pushl   (%ebx)
 # calculate data
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
 # push data
-	pushl   %eax 
-	call	ADDREF
-	jmp	.MyArrayAddRefLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_ADDREF
+        jmp     .MyArrayAddRefLoop
+# AnsiString handling :
 .DoAnsiStringAddRef:
 .DoAnsiStringAddRef:
-	movl	8(%ebp),%eax
-	pushl   %eax
-	call    INCR_ANSI_REF
+        movl    8(%ebp),%eax
+        pushl   %eax
+        call    FPC_INCR_ANSI_REF
 .ExitAddRef:
 .ExitAddRef:
         pop     %edx
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 end;
 
 
-Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'DECREF'];Assembler;
+Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler;
 
 
 asm
 asm
 # Save registers
 # Save registers
         push    %eax
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # decide what type it is
 # decide what type it is
-	movl	12(%ebp),%ebx
-	movb	(%ebx),%al
-	subb	$10,%al
-	jz	.DoAnsiStringDecRef
-	decb	%al
-	jz	.DoAnsiStringDecRef
-	subb	$2,%al
-	jz	.DoArrayDecRef
-	decb	%al
-	jz	.DoRecordDecRef
-	decb	%al
-	decb	%al
+        movl    12(%ebp),%ebx
+        movb    (%ebx),%al
+        subb    $10,%al
+        jz      .DoAnsiStringDecRef
+        decb    %al
+        jz      .DoAnsiStringDecRef
+        subb    $2,%al
+        jz      .DoArrayDecRef
+        decb    %al
+        jz      .DoRecordDecRef
+        decb    %al
+        decb    %al
         jz      .DoObjectDecRef
         jz      .DoObjectDecRef
-	decb	%al
+        decb    %al
         jz      .DoClassDecRef
         jz      .DoClassDecRef
-        jmp	.ExitDecRef
+        jmp     .ExitDecRef
 .DoClassDecRef:
 .DoClassDecRef:
 .DoObjectDecRef:
 .DoObjectDecRef:
 .DoRecordDecRef:
 .DoRecordDecRef:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
 # Skip also recordsize.
         addl    $5,%eax
         addl    $5,%eax
-	addl	%eax,%ebx
+        addl    %eax,%ebx
 # %ebx points to element count. Set in %edx
 # %ebx points to element count. Set in %edx
-	movl	(%ebx),%edx
-	addl    $4,%ebx
+        movl    (%ebx),%edx
+        addl    $4,%ebx
 # %ebx points to First element in record
 # %ebx points to First element in record
 .MyRecordDecRefLoop:
 .MyRecordDecRefLoop:
-	decl    %edx
-	jl	.ExitDecRef
+        decl    %edx
+        jl      .ExitDecRef
 # Calculate data
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
 # push data
-	pushl    %eax
-	call	DECREF
-	jmp     .MyRecordDecRefLoop
+        pushl    %eax
+        call    FPC_DECREF
+        jmp     .MyRecordDecRefLoop
 # Array handling
 # Array handling
 .DoArrayDecRef:
 .DoArrayDecRef:
 # %ebx points to size. Put size in ecx
 # %ebx points to size. Put size in ecx
-	movl	(%ebx),%ecx
-	addl    $4, %ebx
-# %ebx points to count. Put count in %edx 
-	movl	(%ebx),%edx
-	addl    $4, %ebx
+        movl    (%ebx),%ecx
+        addl    $4, %ebx
+# %ebx points to count. Put count in %edx
+        movl    (%ebx),%edx
+        addl    $4, %ebx
 # %ebx points to type. Put into ebx.
 # %ebx points to type. Put into ebx.
 # Start treating elements.
 # Start treating elements.
 .MyArrayDecRefLoop:
 .MyArrayDecRefLoop:
-	decl	%edx
-	jl	.ExitDecRef
+        decl    %edx
+        jl      .ExitDecRef
 # push type
 # push type
         pushl   (%ebx)
         pushl   (%ebx)
 # calculate data
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
 # push data
-	pushl   %eax 
-	call	DECREF
-	jmp	.MyArrayDecRefLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_DECREF
+        jmp     .MyArrayDecRefLoop
+# AnsiString handling :
 .DoAnsiStringDecRef:
 .DoAnsiStringDecRef:
-	movl	8(%ebp),%eax
-	pushl   %eax
-	call    DECR_ANSI_REF
+        movl    8(%ebp),%eax
+        pushl   %eax
+        call    FPC_DECR_ANSI_REF
 .ExitDecRef:
 .ExitDecRef:
         pop     %edx
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 end;
 
 
 {$ASMMODE DEFAULT}
 {$ASMMODE DEFAULT}
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.6  1998-08-23 20:58:50  florian
+  Revision 1.7  1998-09-14 10:48:11  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.6  1998/08/23 20:58:50  florian
     + rtti for objects and classes
     + rtti for objects and classes
     + TObject.GetClassName implemented
     + TObject.GetClassName implemented
 
 

+ 21 - 17
rtl/i386/set.inc

@@ -16,7 +16,7 @@
 
 
 {$ASMMODE ATT}
 {$ASMMODE ATT}
 
 
-procedure do_load_small(p : pointer;l:longint);[public,alias: 'SET_LOAD_SMALL'];
+procedure do_load_small(p : pointer;l:longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_LOAD_SMALL'];
 {
 {
   load a set from an
   load a set from an
 }
 }
@@ -34,7 +34,7 @@ begin
 end;
 end;
 
 
 
 
-procedure do_set_byte(p : pointer;b : byte); [public,alias: 'SET_SET_BYTE'];
+procedure do_set_byte(p : pointer;b : byte); [public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SET_BYTE'];
 {
 {
   add the element b to the set pointed by p
   add the element b to the set pointed by p
 }
 }
@@ -57,7 +57,7 @@ begin
 end;
 end;
 
 
 
 
-procedure do_set_range(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
+procedure do_set_range(p : pointer;l,h : byte);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SET_RANGE'];
 {
 {
   bad implementation, but it's very seldom used
   bad implementation, but it's very seldom used
 }
 }
@@ -86,7 +86,7 @@ begin
 end;
 end;
 
 
 
 
-procedure do_in_byte(p : pointer;b : byte);[public,alias: 'SET_IN_BYTE'];
+procedure do_in_byte(p : pointer;b : byte);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_IN_BYTE'];
 {
 {
   tests if the element b is in the set p the carryflag is set if it present
   tests if the element b is in the set p the carryflag is set if it present
 }
 }
@@ -110,7 +110,7 @@ end;
 
 
 
 
 
 
-procedure do_add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
+procedure do_add_sets(set1,set2,dest : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_ADD_SETS'];
 {
 {
   adds set1 and set2 into set dest
   adds set1 and set2 into set dest
 }
 }
@@ -134,7 +134,7 @@ end;
 { multiplies (i.E. takes common elements of) set1 and set2 }
 { multiplies (i.E. takes common elements of) set1 and set2 }
 { result put in dest                                       }
 { result put in dest                                       }
 
 
-procedure do_mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
+procedure do_mul_sets(set1,set2,dest : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_MUL_SETS'];
 begin
 begin
    asm
    asm
       movl 8(%ebp),%esi
       movl 8(%ebp),%esi
@@ -152,7 +152,7 @@ begin
 end;
 end;
 
 
 
 
-procedure do_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS'];
+procedure do_sub_sets(set1,set2,dest : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SUB_SETS'];
 {
 {
   computes the diff from set1 to set2 result in dest
   computes the diff from set1 to set2 result in dest
 }
 }
@@ -175,7 +175,7 @@ begin
 end;
 end;
 
 
 
 
-procedure do_symdif_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
+procedure do_symdif_sets(set1,set2,dest : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SYMDIF_SETS'];
 {
 {
    computes the symetric diff from set1 to set2 result in dest
    computes the symetric diff from set1 to set2 result in dest
 }
 }
@@ -196,7 +196,7 @@ begin
      end;
      end;
 end;
 end;
 
 
-procedure do_comp_sets(set1,set2 : pointer);[public,alias: 'SET_COMP_SETS'];
+procedure do_comp_sets(set1,set2 : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_COMP_SETS'];
 {
 {
   compares set1 and set2 zeroflag is set if they are equal
   compares set1 and set2 zeroflag is set if they are equal
 }
 }
@@ -223,7 +223,7 @@ end;
 
 
 {$ifdef LARGESETS}
 {$ifdef LARGESETS}
 
 
-procedure do_set(p : pointer;b : word);[public,alias: 'SET_SET_WORD'];
+procedure do_set(p : pointer;b : word);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SET_WORD'];
 {
 {
   sets the element b in set p works for sets larger than 256 elements
   sets the element b in set p works for sets larger than 256 elements
   not yet use by the compiler so
   not yet use by the compiler so
@@ -244,7 +244,7 @@ begin
 end;
 end;
 
 
 
 
-procedure do_in(p : pointer;b : word);[public,alias: 'SET_IN_WORD'];
+procedure do_in(p : pointer;b : word);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_IN_WORD'];
 {
 {
   tests if the element b is in the set p the carryflag is set if it present
   tests if the element b is in the set p the carryflag is set if it present
   works for sets larger than 256 elements
   works for sets larger than 256 elements
@@ -265,7 +265,7 @@ begin
 end;
 end;
 
 
 
 
-procedure add_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_ADD_SETS_SIZE'];
+procedure add_sets(set1,set2,dest : pointer;size : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_ADD_SETS_SIZE'];
 {
 {
   adds set1 and set2 into set dest size is the number of bytes in the set
   adds set1 and set2 into set dest size is the number of bytes in the set
 }
 }
@@ -287,7 +287,7 @@ begin
 end;
 end;
 
 
 
 
-procedure mul_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_MUL_SETS_SIZE'];
+procedure mul_sets(set1,set2,dest : pointer;size : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_MUL_SETS_SIZE'];
 {
 {
   multiplies (i.E. takes common elements of) set1 and set2 result put in
   multiplies (i.E. takes common elements of) set1 and set2 result put in
   dest size is the number of bytes in the set
   dest size is the number of bytes in the set
@@ -309,7 +309,7 @@ begin
 end;
 end;
 
 
 
 
-procedure sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SUB_SETS_SIZE'];
+procedure sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SUB_SETS_SIZE'];
 begin
 begin
       asm
       asm
          movl 8(%ebp),%esi
          movl 8(%ebp),%esi
@@ -329,7 +329,7 @@ begin
 end;
 end;
 
 
 
 
-procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SYMDIF_SETS_SIZE'];
+procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SYMDIF_SETS_SIZE'];
 {
 {
    computes the symetric diff from set1 to set2 result in dest
    computes the symetric diff from set1 to set2 result in dest
 }
 }
@@ -351,7 +351,7 @@ begin
 end;
 end;
 
 
 
 
-procedure comp_sets(set1,set2 : pointer;size : longint);[public,alias: 'SET_COMP_SETS_SIZE'];
+procedure comp_sets(set1,set2 : pointer;size : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_COMP_SETS_SIZE'];
 begin
 begin
    asm
    asm
       movl 8(%ebp),%esi
       movl 8(%ebp),%esi
@@ -376,7 +376,11 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-08-14 18:13:44  peter
+  Revision 1.4  1998-09-14 10:48:12  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.3  1998/08/14 18:13:44  peter
     + set_load_small
     + set_load_small
     * fixed set_set_range
     * fixed set_set_range
 
 

+ 7 - 7
rtl/i386/setjump.inc

@@ -4,7 +4,7 @@
     Copyright (c) 1998 by the Free Pascal development team
     Copyright (c) 1998 by the Free Pascal development team
 
 
     SetJmp and LongJmp implementation for exception handling
     SetJmp and LongJmp implementation for exception handling
-    
+
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
 
 
@@ -14,12 +14,8 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
-{$ifdef VER0_99_5}
-  {$I386_DIRECT}
-{$endif}
-
 {$ASMMODE DIRECT}
 {$ASMMODE DIRECT}
-  
+
 Function SetJmp (Var S : Jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];
 Function SetJmp (Var S : Jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];
 asm
 asm
   movl 8(%ebp),%eax
   movl 8(%ebp),%eax
@@ -56,7 +52,11 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-08-11 00:04:52  peter
+  Revision 1.4  1998-09-14 10:48:13  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.3  1998/08/11 00:04:52  peter
     * $ifdef ver0_99_5 updates
     * $ifdef ver0_99_5 updates
 
 
 }
 }

+ 39 - 35
rtl/inc/astrings.pp

@@ -18,11 +18,11 @@
 
 
 
 
 {
 {
-  This file contains the implementation of the LongString type, 
+  This file contains the implementation of the LongString type,
   and all things that are needed for it.
   and all things that are needed for it.
   AnsiSTring is defined as a 'silent' pchar :
   AnsiSTring is defined as a 'silent' pchar :
   a pchar that points to :
   a pchar that points to :
-      
+
   @-12 : Longint for maximum size;
   @-12 : Longint for maximum size;
   @-8  : Longint for size;
   @-8  : Longint for size;
   @-4  : Longint for reference count;
   @-4  : Longint for reference count;
@@ -61,7 +61,7 @@ Type TAnsiRec = Record
 
 
 Const AnsiRecLen = SizeOf(TAnsiRec);
 Const AnsiRecLen = SizeOf(TAnsiRec);
       FirstOff   = SizeOf(TAnsiRec)-1;
       FirstOff   = SizeOf(TAnsiRec)-1;
-      
+
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
   Internal functions, not in interface.
   Internal functions, not in interface.
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
@@ -79,7 +79,7 @@ begin
       Writeln ('Maxlen : ',maxlen);
       Writeln ('Maxlen : ',maxlen);
       Writeln ('Len    : ',len);
       Writeln ('Len    : ',len);
       Writeln ('Ref    : ',ref);
       Writeln ('Ref    : ',ref);
-      end;  
+      end;
     end;
     end;
 end;
 end;
 
 
@@ -118,45 +118,45 @@ begin
 end;
 end;
 
 
 
 
-Procedure Decr_Ansi_Ref (Var S : AnsiString);[Alias : 'DECR_ANSI_REF'];
+Procedure Decr_Ansi_Ref (Var S : AnsiString);[Alias : 'FPC_DECR_ANSI_REF'];
 {
 {
- Decreases the ReferenceCount of a non constant ansistring; 
+ Decreases the ReferenceCount of a non constant ansistring;
  If the reference count is zero, deallocate the string;
  If the reference count is zero, deallocate the string;
 }
 }
 Type plongint = ^longint;
 Type plongint = ^longint;
-     
-Var l : plongint;     
-     
+
+Var l : plongint;
+
 
 
 Begin
 Begin
 //  dumpansirec(s);
 //  dumpansirec(s);
   If Pointer(S)=Nil then exit; { Zero string }
   If Pointer(S)=Nil then exit; { Zero string }
-  
+
   { check for constant strings ...}
   { check for constant strings ...}
   l:=Pointer(S)-FirstOff+8;
   l:=Pointer(S)-FirstOff+8;
   If l^<0 then exit;
   If l^<0 then exit;
   l^:=l^-1;
   l^:=l^-1;
 //  dumpansirec(s);
 //  dumpansirec(s);
-  If l^=0 then 
+  If l^=0 then
     { Ref count dropped to zero }
     { Ref count dropped to zero }
     begin
     begin
-//    Writeln ('CAlling disposestring'); 
+//    Writeln ('CAlling disposestring');
     DisposeAnsiString (S);        { Remove...}
     DisposeAnsiString (S);        { Remove...}
     end
     end
 end;
 end;
 
 
-Procedure Incr_Ansi_Ref (Var S : AnsiString);[Alias : 'INCR_ANSI_REF'];
+Procedure Incr_Ansi_Ref (Var S : AnsiString);[Alias : 'FPC_INCR_ANSI_REF'];
 
 
 Begin
 Begin
   If Pointer(S)=Nil then exit;
   If Pointer(S)=Nil then exit;
   { Let's be paranoid : Constant string ??}
   { Let's be paranoid : Constant string ??}
-  If PansiRec(Pointer(S)-FirstOff)^.Ref<0 then exit; 
+  If PansiRec(Pointer(S)-FirstOff)^.Ref<0 then exit;
   inc(PAnsiRec(Pointer(S)-FirstOff)^.Ref);
   inc(PAnsiRec(Pointer(S)-FirstOff)^.Ref);
 end;
 end;
 
 
 Procedure UniqueAnsiString (Var S : AnsiString);
 Procedure UniqueAnsiString (Var S : AnsiString);
 {
 {
-  Make sure reference count of S is 1, 
+  Make sure reference count of S is 1,
   using copy-on-write semantics.
   using copy-on-write semantics.
 }
 }
 
 
@@ -176,7 +176,7 @@ end;
 
 
 
 
 
 
-Procedure AssignAnsiString (Var S1 : AnsiString; S2 : Pointer); [Public, Alias : 'ASSIGN_ANSI_STRING'];
+Procedure AssignAnsiString (Var S1 : AnsiString; S2 : Pointer); [Public, Alias : 'FPC_ASSIGN_ANSI_STRING'];
 {
 {
  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
  If S2 is a constant string, a new S1 is allocated on the heap.
  If S2 is a constant string, a new S1 is allocated on the heap.
@@ -188,7 +188,7 @@ begin
     begin
     begin
     If PAnsiRec(S2-FirstOff)^.Ref<0 then
     If PAnsiRec(S2-FirstOff)^.Ref<0 then
       begin
       begin
-      { S2 is a constant string, Create new string with copy. } 
+      { S2 is a constant string, Create new string with copy. }
       Temp:=Pointer(NewAnsiString(PansiRec(S2-FirstOff)^.Len));
       Temp:=Pointer(NewAnsiString(PansiRec(S2-FirstOff)^.Len));
       Move (S2^,Temp^,PAnsiRec(S2-FirstOff)^.len+1);
       Move (S2^,Temp^,PAnsiRec(S2-FirstOff)^.len+1);
       PAnsiRec(Temp-FirstOff)^.Len:=PAnsiRec(S2-FirstOff)^.len;
       PAnsiRec(Temp-FirstOff)^.Len:=PAnsiRec(S2-FirstOff)^.len;
@@ -207,7 +207,7 @@ end;
 
 
 Procedure Ansi_String_Concat (Var S1 : AnsiString; Var S2 : AnsiString);
 Procedure Ansi_String_Concat (Var S1 : AnsiString; Var S2 : AnsiString);
 {
 {
-  Concatenates 2 AnsiStrings : S1+S2. 
+  Concatenates 2 AnsiStrings : S1+S2.
   Result Goes to S1;
   Result Goes to S1;
 }
 }
 Var Size,Location : Longint;
 Var Size,Location : Longint;
@@ -221,9 +221,9 @@ begin
     Size:=PAnsiRec(Pointer(S2)-FirstOff)^.Len;
     Size:=PAnsiRec(Pointer(S2)-FirstOff)^.Len;
     Location:=Length(S1);
     Location:=Length(S1);
     { Setlength takes case of uniqueness
     { Setlength takes case of uniqueness
-      and allocated memory. We need to use length, 
+      and allocated memory. We need to use length,
       to take into account possibility of S1=Nil }
       to take into account possibility of S1=Nil }
-//!!    SetLength (S1,Size+Location); 
+//!!    SetLength (S1,Size+Location);
     Move (Pointer(S2)^,Pointer(Pointer(S1)+location)^,Size+1);
     Move (Pointer(S2)^,Pointer(Pointer(S1)+location)^,Size+1);
     end;
     end;
 end;
 end;
@@ -241,10 +241,10 @@ begin
   Size:=byte(S2[0]);
   Size:=byte(S2[0]);
   Location:=Length(S1);
   Location:=Length(S1);
   If Size=0 then exit;
   If Size=0 then exit;
-    { Setlength takes case of uniqueness 
-      and alllocated memory. We need to use length, 
+    { Setlength takes case of uniqueness
+      and alllocated memory. We need to use length,
       to take into account possibility of S1=Nil }
       to take into account possibility of S1=Nil }
-  SetLength (S1,Size+Length(S1)); 
+  SetLength (S1,Size+Length(S1));
   Move (S2[1],Pointer(Pointer(S1)+Location)^,Size);
   Move (S2[1],Pointer(Pointer(S1)+Location)^,Size);
   PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero }
   PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero }
 end;
 end;
@@ -282,11 +282,11 @@ end;
 
 
 
 
 Const EmptyChar : char = #0;
 Const EmptyChar : char = #0;
-    
-Function Ansi2pchar (S : Pointer) : Pchar; [Alias : 'ANSI2PCHAR'];
+
+Function Ansi2pchar (S : Pointer) : Pchar; [Alias : 'FPC_ANSI2PCHAR'];
 
 
 begin
 begin
-  If S<>Nil then 
+  If S<>Nil then
     Ansi2Pchar:=S
     Ansi2Pchar:=S
   else
   else
     Ansi2Pchar:=@emptychar;
     Ansi2Pchar:=@emptychar;
@@ -313,7 +313,7 @@ begin
    inc(i);
    inc(i);
    end;
    end;
  if temp=0 then temp:=Length(S1)-Length(S2);
  if temp=0 then temp:=Length(S1)-Length(S2);
- AnsiCompare:=Temp; 
+ AnsiCompare:=Temp;
 end;
 end;
 
 
 
 
@@ -338,7 +338,7 @@ begin
    Temp:= PByte(Pointer(S1)+I)^ - Byte(S2[i+1]);
    Temp:= PByte(Pointer(S1)+I)^ - Byte(S2[i+1]);
    inc(i);
    inc(i);
    end;
    end;
- AnsiCompare:=Temp; 
+ AnsiCompare:=Temp;
 end;
 end;
 
 
 
 
@@ -354,12 +354,12 @@ begin
 end;
 end;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-   Public functions, In interface.  
+   Public functions, In interface.
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 Function Length (Var S : AnsiString) : Longint;
 Function Length (Var S : AnsiString) : Longint;
 {
 {
- Returns the length of an AnsiString. 
+ Returns the length of an AnsiString.
  Takes in acount that zero strings are NIL;
  Takes in acount that zero strings are NIL;
 }
 }
 begin
 begin
@@ -418,7 +418,7 @@ begin
   dec(index);
   dec(index);
   { Check Size. Accounts for Zero-length S }
   { Check Size. Accounts for Zero-length S }
   if Length(S)<Index+Size then
   if Length(S)<Index+Size then
-    Size:=Length(S)-Index; 
+    Size:=Length(S)-Index;
   If Size>0 then
   If Size>0 then
     begin
     begin
     ResultAddress:=Pointer(NewAnsiString (Size));
     ResultAddress:=Pointer(NewAnsiString (Size));
@@ -439,7 +439,7 @@ Function Pos (Var Substr : AnsiString; Var Source : AnsiString) : Longint;
 var i,j : longint;
 var i,j : longint;
     e : boolean;
     e : boolean;
     s : Pointer;
     s : Pointer;
-    
+
 begin
 begin
  i := 0;
  i := 0;
  j := 0;
  j := 0;
@@ -464,7 +464,7 @@ end;
 Procedure Val (var S : AnsiString; var R : real; Var Code : Integer);
 Procedure Val (var S : AnsiString; var R : real; Var Code : Integer);
 
 
 Var SS : String;
 Var SS : String;
-    
+
 begin
 begin
  Ansi_To_ShortString (SS,S,255);
  Ansi_To_ShortString (SS,S,255);
  Val(SS,R,Code);
  Val(SS,R,Code);
@@ -668,7 +668,7 @@ begin
   If Length(Source)=0 then exit;
   If Length(Source)=0 then exit;
   if index <= 0 then index := 1;
   if index <= 0 then index := 1;
   s3 := Pointer(copy(s,index,length(s)));
   s3 := Pointer(copy(s,index,length(s)));
-  if index > Length(s) then 
+  if index > Length(s) then
     index := Length(S)+1;
     index := Length(S)+1;
   SetLength(s,index - 1);
   SetLength(s,index - 1);
   s4 := Pointer ( NewAnsiString(PansiRec(Pointer(Source)-Firstoff)^.len) );
   s4 := Pointer ( NewAnsiString(PansiRec(Pointer(Source)-Firstoff)^.len) );
@@ -683,7 +683,11 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.13  1998-08-23 20:58:51  florian
+  Revision 1.14  1998-09-14 10:48:14  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.13  1998/08/23 20:58:51  florian
     + rtti for objects and classes
     + rtti for objects and classes
     + TObject.GetClassName implemented
     + TObject.GetClassName implemented
 
 

+ 5 - 80
rtl/inc/filerec.inc

@@ -21,16 +21,6 @@
   unit without sacrificing TP compatibility.
   unit without sacrificing TP compatibility.
 }
 }
 
 
-{$ifndef VER0_99_5}
-  {$ifndef VER0_99_6}
-    {$define UNIFORM_FILEREC}
-  {$endif}
-{$endif}
-
-
-{$ifdef UNIFORM_FILEREC}
-
-
 const
 const
   filerecnamelength = 255;
   filerecnamelength = 255;
 type
 type
@@ -43,78 +33,13 @@ type
     name      : array[0..filerecnamelength] of char;
     name      : array[0..filerecnamelength] of char;
   End;
   End;
 
 
-
-{$else UNIFORM_FILEREC}
-
-
-{**********************************
-   Old style for 0.99.5/0.99.6
-**********************************}
-
-const
-  {$ifdef linux}
-    filerecnamelength = 255;
-  {$endif}
-  {$ifdef Win32}
-    filerecnamelength = 255;
-  {$endif}
-  {$ifdef MACOS}
-    filerecnamelength = 255;
-  {$endif}
-  {$ifdef AMIGA}
-    filerecnamelength = 255;
-  {$endif}
-  {$ifdef OS2}
-    filerecnamelength = 79;
-  {$endif}
-  {$ifdef GO32V2}
-    filerecnamelength = 79;
-  {$endif GO32V2}
-  {$ifdef GO32V1}
-    filerecnamelength = 79;
-  {$endif Go32v1}
-  {$ifdef ATARI}
-    filerecnamelength = 79;
-  {$endif}
-
-Type
-{$PACKRECORDS 2}
-  FileRec = Record
-  {$ifdef win32}
-     handle    : longint;
-  {$endif win32}
-  {$ifdef amiga}
-     handle    : longint;
-  {$endif amiga}
-  {$ifdef macos}
-     handle    : longint;
-  {$endif macos}
-  {$ifdef linux}
-     handle    : word;
-  {$endif}
-  {$ifdef go32v1}
-     handle    : word;
-  {$endif go32v1}
-  {$ifdef go32v2}
-     handle    : word;
-  {$endif go32v2}
-  {$ifdef atari}
-     handle    : word;
-  {$endif atari}
-  {$ifdef os2}
-     handle    : word;
-  {$endif os2}
-    Mode      : word;
-    RecSize   : word;
-    _private  : array[1..26] of byte;
-    UserData  : array[1..16] of byte;
-    name      : array[0..filerecnamelength] of char;
-  End;
-{$endif UNIFORM_FILEREC}
-
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-09-04 18:16:13  peter
+  Revision 1.5  1998-09-14 10:48:15  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.4  1998/09/04 18:16:13  peter
     * uniform filerec/textrec (with recsize:longint and name:0..255)
     * uniform filerec/textrec (with recsize:longint and name:0..255)
 
 
   Revision 1.3  1998/05/21 11:55:59  carl
   Revision 1.3  1998/05/21 11:55:59  carl

+ 24 - 68
rtl/i386/heap.inc → rtl/inc/heap.inc

@@ -5,7 +5,6 @@
 
 
     functions for heap management in the data segment
     functions for heap management in the data segment
 
 
-
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
 
 
@@ -25,8 +24,6 @@
 
 
 }
 }
 
 
-{$ASMMODE DIRECT}
-
 const
 const
   max_size = 256;
   max_size = 256;
   maxblock = max_size div 8;
   maxblock = max_size div 8;
@@ -113,28 +110,6 @@ const
 {$endif TEMPHEAP}
 {$endif TEMPHEAP}
 
 
 
 
-{$ifndef OS2}
-{ OS2 function getheapstart is in sysos2.pas }
-    function getheapstart : pointer;
-      begin
-         asm
-            leal HEAP,%eax
-            leave
-            ret
-         end ['EAX'];
-      end;
-{$endif}
-
-    function getheapsize : longint;
-      begin
-         asm
-            movl HEAPSIZE,%eax
-            leave
-            ret
-         end ['EAX'];
-      end;
-
-
 {*****************************************************************************
 {*****************************************************************************
                        Heapsize,Memavail,MaxAvail
                        Heapsize,Memavail,MaxAvail
 *****************************************************************************}
 *****************************************************************************}
@@ -244,12 +219,7 @@ end;
      begin
      begin
        Writeln('Marked memory at ',HexStr(longint(p),8),' released');
        Writeln('Marked memory at ',HexStr(longint(p),8),' released');
        call_stack(p+sizeof(heap_mem_info));
        call_stack(p+sizeof(heap_mem_info));
-       asm
-           movl (%ebp),%eax
-           movl (%eax),%eax
-           movl %eax,ebp
-       end;
-       dump_stack(ebp);
+       dump_stack(get_caller_frame(get_frame));
      end;
      end;
 
 
 
 
@@ -339,8 +309,8 @@ end;
          tempheap.heapsize:=tempheap.memavail;
          tempheap.heapsize:=tempheap.memavail;
          getmem(tempheap.block,sizeof(tblocks));
          getmem(tempheap.block,sizeof(tblocks));
          getmem(tempheap.nblock,sizeof(tnblocks));
          getmem(tempheap.nblock,sizeof(tnblocks));
-	 fillchar(tempheap.block^,sizeof(tblocks),0);
-	 fillchar(tempheap.nblock^,sizeof(tnblocks),0);
+         fillchar(tempheap.block^,sizeof(tblocks),0);
+         fillchar(tempheap.nblock^,sizeof(tnblocks),0);
          heapend:=baseheap.heapend;
          heapend:=baseheap.heapend;
          internal_memavail:=calc_memavail;
          internal_memavail:=calc_memavail;
          baseheap.memavail:=internal_memavail;
          baseheap.memavail:=internal_memavail;
@@ -445,7 +415,7 @@ end;
           begin
           begin
             while assigned(hp^.next) do
             while assigned(hp^.next) do
              hp:=hp^.next;
              hp:=hp^.next;
-          end;  
+          end;
          if tempheap.heapptr<>tempheap.heaporg then
          if tempheap.heapptr<>tempheap.heaporg then
           begin
           begin
             if hp<>nil then
             if hp<>nil then
@@ -518,21 +488,11 @@ end;
                                 GetMem
                                 GetMem
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure getmem(var p : pointer;size : longint);[public,alias: 'GETMEM'];
-
-   { changed to removed the OS conditionnals }
-   function call_heaperror(addr : pointer; size : longint) : integer;
-   begin
-     asm
-              pushl size
-              movl  addr,%eax
-              { movl HEAPERROR,%eax doesn't work !!}
-              call %eax
-              movw %ax,__RESULT
-      end;
-   end;
-
+procedure getmem(var p : pointer;size : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'GETMEM'];
+type
+  heaperrorproc=function(size:longint):integer;
 var
 var
+  proc     : heaperrorproc;
   last,hp  : pfreerecord;
   last,hp  : pfreerecord;
   again    : boolean;
   again    : boolean;
   s,hpsize : longint;
   s,hpsize : longint;
@@ -658,7 +618,8 @@ begin
      begin
      begin
        if assigned(heaperror) then
        if assigned(heaperror) then
         begin
         begin
-          case call_heaperror(heaperror,size) of
+          proc:=heaperrorproc(heaperror);
+          case proc(size) of
            0 : HandleError(203);
            0 : HandleError(203);
            1 : p:=nil;
            1 : p:=nil;
            2 : again:=true;
            2 : again:=true;
@@ -679,10 +640,6 @@ check_new:
   test_memavail;
   test_memavail;
   if trace then
   if trace then
    begin
    begin
-     asm
-         movl (%ebp),%eax
-         movl %eax,bp
-     end;
      pheap_mem_info(p)^.sig:=$DEADBEEF;
      pheap_mem_info(p)^.sig:=$DEADBEEF;
      pheap_mem_info(p)^.previous:=last_assigned;
      pheap_mem_info(p)^.previous:=last_assigned;
      if last_assigned<>nil then
      if last_assigned<>nil then
@@ -690,10 +647,11 @@ check_new:
      last_assigned:=p;
      last_assigned:=p;
      pheap_mem_info(p)^.next:=nil;
      pheap_mem_info(p)^.next:=nil;
      pheap_mem_info(p)^.size:=orsize;
      pheap_mem_info(p)^.size:=orsize;
+     bp:=get_caller_frame(get_frame);
      for i:=1 to tracesize do
      for i:=1 to tracesize do
       begin
       begin
-        pheap_mem_info(p)^.calls[i]:=get_addr(bp);
-        bp:=get_next_frame(bp);
+        pheap_mem_info(p)^.calls[i]:=get_caller_addr(bp);
+        bp:=get_caller_frame(bp);
       end;
       end;
      inc(p,sizeof(heap_mem_info));
      inc(p,sizeof(heap_mem_info));
    end;
    end;
@@ -705,7 +663,7 @@ end;
                                 FreeMem
                                 FreeMem
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure freemem(var p : pointer;size : longint);[public,alias: 'FREEMEM'];
+procedure freemem(var p : pointer;size : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'FREEMEM'];
 var
 var
   hp : pfreerecord;
   hp : pfreerecord;
 {$ifdef TEMPHEAP}
 {$ifdef TEMPHEAP}
@@ -960,7 +918,9 @@ end;
 
 
 function growheap(size :longint) : integer;
 function growheap(size :longint) : integer;
 var
 var
-  Newlimit,
+{$ifdef CHECKHEAP}
+  NewLimit,
+{$endif CHECKHEAP}
   NewPos,
   NewPos,
   wantedsize : longint;
   wantedsize : longint;
   hp         : pfreerecord;
   hp         : pfreerecord;
@@ -1044,12 +1004,6 @@ begin
     to get the memory PM }
     to get the memory PM }
    internal_memavail:=calc_memavail;
    internal_memavail:=calc_memavail;
  { set the total new heap size }
  { set the total new heap size }
-   asm
-           movl Size,%ebx
-           movl HEAPSIZE,%eax
-           addl %ebx,%eax
-           movl %eax,HEAPSIZE
-   end;
    inc(internal_heapsize,size);
    inc(internal_heapsize,size);
   { try again }
   { try again }
    GrowHeap:=2;
    GrowHeap:=2;
@@ -1076,20 +1030,22 @@ begin
   Curheap:=@baseheap;
   Curheap:=@baseheap;
   Otherheap:=@tempheap;
   Otherheap:=@tempheap;
 {$endif TEMPHEAP}
 {$endif TEMPHEAP}
-  internal_memavail:=GetHeapSize;
+  internal_heapsize:=GetHeapSize;
+  internal_memavail:=internal_heapsize;
   HeapOrg:=GetHeapStart;
   HeapOrg:=GetHeapStart;
   HeapPtr:=HeapOrg;
   HeapPtr:=HeapOrg;
   HeapEnd:=HeapOrg+internal_memavail;
   HeapEnd:=HeapOrg+internal_memavail;
   HeapError:=@GrowHeap;
   HeapError:=@GrowHeap;
-  internal_heapsize:=longint(heapend)-longint(heaporg);
   Freelist:=nil;
   Freelist:=nil;
 end;
 end;
 
 
-{$ASMMODE ATT}
-
 {
 {
   $Log$
   $Log$
-  Revision 1.18  1998-09-08 15:02:48  peter
+  Revision 1.1  1998-09-14 10:48:17  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.18  1998/09/08 15:02:48  peter
     * much more readable :)
     * much more readable :)
 
 
   Revision 1.17  1998/09/04 17:27:48  pierre
   Revision 1.17  1998/09/04 17:27:48  pierre

+ 5 - 9
rtl/inc/innr.inc

@@ -23,14 +23,6 @@ const
    in_ord_x             = 5;
    in_ord_x             = 5;
    in_length_string     = 6;
    in_length_string     = 6;
    in_chr_byte          = 7;
    in_chr_byte          = 7;
-{$ifdef VER0_99_5}
-   in_inc_byte          = 8;
-   in_inc_word          = 9;
-   in_inc_dword         = 10;
-   in_dec_byte          = 11;
-   in_dec_word          = 12;
-   in_dec_dword         = 13;
-{$endif}
    in_write_x           = 14;
    in_write_x           = 14;
    in_writeln_x         = 15;
    in_writeln_x         = 15;
    in_read_x            = 16;
    in_read_x            = 16;
@@ -74,7 +66,11 @@ const
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-09-01 17:36:19  peter
+  Revision 1.4  1998-09-14 10:48:17  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.3  1998/09/01 17:36:19  peter
     + internconst
     + internconst
 
 
 }
 }

+ 1 - 1
rtl/inc/makefile.inc

@@ -6,7 +6,7 @@
 # implementation files.
 # implementation files.
 
 
 SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
 SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
-         file typefile version text rtti
+         file typefile version text rtti heap
 SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
 SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
 
 
 # Other unit names which can be used for all systems
 # Other unit names which can be used for all systems

+ 12 - 8
rtl/inc/sstrings.inc

@@ -217,7 +217,7 @@ end;
                               Str() Helpers
                               Str() Helpers
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure int_str_real(d : real;len,fr : longint;var s : string);[public, alias : 'STR_REAL'];
+procedure int_str_real(d : real;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_REAL'{$else}'STR_REAL'{$endif}];
 begin
 begin
 {$ifdef i386}
 {$ifdef i386}
    str_real(len,fr,d,rt_s64real,s);
    str_real(len,fr,d,rt_s64real,s);
@@ -227,7 +227,7 @@ begin
 end;
 end;
 
 
 {$ifdef SUPPORT_SINGLE}
 {$ifdef SUPPORT_SINGLE}
-procedure int_str_single(d : single;len,fr : longint;var s : string);[public, alias : 'STR_SINGLE'];
+procedure int_str_single(d : single;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_SINGLE'{$else}'STR_SINGLE'{$endif}];
 begin
 begin
    str_real(len,fr,d,rt_s32real,s);
    str_real(len,fr,d,rt_s32real,s);
 end;
 end;
@@ -235,7 +235,7 @@ end;
 
 
 
 
 {$ifdef SUPPORT_EXTENDED}
 {$ifdef SUPPORT_EXTENDED}
-procedure int_str_extended(d : extended;len,fr : longint;var s : string);[public, alias : 'STR_EXTENDED'];
+procedure int_str_extended(d : extended;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_EXTENDED'{$else}'STR_EXTENDED'{$endif}];
 begin
 begin
    str_real(len,fr,d,rt_s80real,s);
    str_real(len,fr,d,rt_s80real,s);
 end;
 end;
@@ -243,7 +243,7 @@ end;
 
 
 
 
 {$ifdef SUPPORT_COMP}
 {$ifdef SUPPORT_COMP}
-procedure int_str_comp(d : comp;len,fr : longint;var s : string);[public, alias : 'STR_COMP'];
+procedure int_str_comp(d : comp;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_COMP'{$else}'STR_COMP'{$endif}];
 begin
 begin
    str_real(len,fr,d,rt_s64bit,s);
    str_real(len,fr,d,rt_s64bit,s);
 end;
 end;
@@ -251,14 +251,14 @@ end;
 
 
 
 
 {$ifdef SUPPORT_FIXED}
 {$ifdef SUPPORT_FIXED}
-procedure int_str_fixed(d : fixed;len,fr : longint;var s : string);[public, alias : 'STR_FIXED'];
+procedure int_str_fixed(d : fixed;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_FIXED'{$else}'STR_FIXED'{$endif}];
 begin
 begin
    str_real(len,fr,d,rt_f32bit,s);
    str_real(len,fr,d,rt_f32bit,s);
 end;
 end;
 {$endif SUPPORT_FIXED}
 {$endif SUPPORT_FIXED}
 
 
 
 
-procedure int_str_longint(v : longint;len : longint;var s : string);[public, alias : 'STR_LONGINT'];
+procedure int_str_longint(v : longint;len : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_LONGINT'{$else}'STR_LONGINT'{$endif}];
 begin
 begin
    int_str(v,s);
    int_str(v,s);
    if length(s)<len then
    if length(s)<len then
@@ -266,7 +266,7 @@ begin
 end;
 end;
 
 
 
 
-procedure int_str_cardinal(v : cardinal;len : longint;var s : string);[public, alias : 'STR_CARDINAL'];
+procedure int_str_cardinal(v : cardinal;len : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_CARDINAL'{$else}'STR_CARDINAL'{$endif}];
 begin
 begin
   int_str(v,s);
   int_str(v,s);
   if length(s)<len then
   if length(s)<len then
@@ -753,7 +753,11 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.11  1998-08-11 21:39:07  peter
+  Revision 1.12  1998-09-14 10:48:19  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.11  1998/08/11 21:39:07  peter
     * splitted default_extended from support_extended
     * splitted default_extended from support_extended
 
 
   Revision 1.10  1998/08/08 12:28:13  florian
   Revision 1.10  1998/08/08 12:28:13  florian

+ 61 - 128
rtl/inc/system.inc

@@ -54,24 +54,6 @@ Function  lo(l : Longint) : Word;  [INTERNPROC: In_lo_long];
 Function  hi(i : Integer) : byte;  [INTERNPROC: In_hi_Word];
 Function  hi(i : Integer) : byte;  [INTERNPROC: In_hi_Word];
 Function  hi(w : Word) : byte;     [INTERNPROC: In_hi_Word];
 Function  hi(w : Word) : byte;     [INTERNPROC: In_hi_Word];
 Function  hi(l : Longint) : Word;  [INTERNPROC: In_hi_long];
 Function  hi(l : Longint) : Word;  [INTERNPROC: In_hi_long];
-{$ifdef VER0_99_5}
-Procedure Inc(var i : Cardinal);   [INTERNPROC: In_Inc_DWord];
-Procedure Inc(var i : Longint);    [INTERNPROC: In_Inc_DWord];
-Procedure Inc(var i : Integer);    [INTERNPROC: In_Inc_Word];
-Procedure Inc(var i : Word);       [INTERNPROC: In_Inc_Word];
-Procedure Inc(var i : shortint);   [INTERNPROC: In_Inc_byte];
-Procedure Inc(var i : byte);       [INTERNPROC: In_Inc_byte];
-Procedure Inc(var c : Char);       [INTERNPROC: In_Inc_byte];
-Procedure Inc(var p : PChar);      [INTERNPROC: In_Inc_DWord];
-Procedure Dec(var i : Cardinal);   [INTERNPROC: In_Dec_DWord];
-Procedure Dec(var i : Longint);    [INTERNPROC: In_Dec_DWord];
-Procedure Dec(var i : Integer);    [INTERNPROC: In_Dec_Word];
-Procedure Dec(var i : Word);       [INTERNPROC: In_Dec_Word];
-Procedure Dec(var i : shortint);   [INTERNPROC: In_Dec_byte];
-Procedure Dec(var i : byte);       [INTERNPROC: In_Dec_byte];
-Procedure Dec(var c : Char);       [INTERNPROC: In_Dec_byte];
-Procedure Dec(var p : PChar);      [INTERNPROC: In_Dec_DWord];
-{$endif VER0_99_5}
 
 
 Function chr(b : byte) : Char;      [INTERNPROC: In_chr_byte];
 Function chr(b : byte) : Char;      [INTERNPROC: In_chr_byte];
 Function Length(s : string) : byte; [INTERNPROC: In_Length_string];
 Function Length(s : string) : byte; [INTERNPROC: In_Length_string];
@@ -122,11 +104,11 @@ Type
 {$else}
 {$else}
 
 
 { Provide dummy procedures needed for rtti}
 { Provide dummy procedures needed for rtti}
-Procedure decr_ansi_ref (P : pointer);[Alias : 'DECR_ANSI_REF'];
+Procedure decr_ansi_ref (P : pointer);[Alias : 'FPC_DECR_ANSI_REF'];
   begin
   begin
   end;
   end;
 
 
-Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
+Procedure incr_ansi_ref (P : pointer);[Alias : 'FPC_INCR_ANSI_REF'];
   begin
   begin
   end;
   end;
 
 
@@ -137,9 +119,8 @@ Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
                          Run-Time Type Information (RTTI)
                          Run-Time Type Information (RTTI)
 ****************************************************************************}
 ****************************************************************************}
 
 
-{$ifndef VER0_99_5}
-  {$i rtti.inc}
-{$endif  VER0_99_5}
+{$i rtti.inc}
+
 
 
 {****************************************************************************
 {****************************************************************************
                                Math Routines
                                Math Routines
@@ -157,90 +138,6 @@ begin
    Lo := b and $0f
    Lo := b and $0f
 end;
 end;
 
 
-{$ifdef VER0_99_5}
-
-Procedure Inc(var i : Cardinal;a: Longint);
-Begin
-  I:=I+A;
-End;
-
-Procedure Dec(var i : Cardinal;a: Longint);
-Begin
-  I:=I-A;
-End;
-
-Procedure Inc(var i : Longint;a : Longint);
-Begin
-  i:=i+a;
-End;
-
-Procedure Dec(var i : Longint;a : Longint);
-Begin
-  i:=i-a;
-End;
-
-Procedure Dec(var i : Word;a : Longint);
-Begin
-  i:=i-a;
-End;
-
-Procedure Inc(var i : Word;a : Longint);
-Begin
-  i:=i+a;
-End;
-
-Procedure Dec(var i : Integer;a : Longint);
-Begin
-  i:=i-a;
-End;
-
-Procedure Inc(var i : Integer;a : Longint);
-Begin
-  i:=i+a;
-End;
-
-Procedure Dec(var i : byte;a : Longint);
-Begin
-  i:=i-a;
-End;
-
-Procedure Inc(var i : byte;a : Longint);
-Begin
-  i:=i+a;
-End;
-
-Procedure Dec(var i : shortint;a : Longint);
-Begin
-  i:=i-a;
-End;
-
-Procedure Inc(var i : shortint;a : Longint);
-Begin
-  i:=i+a;
-End;
-
-Procedure Dec(var c : Char;a : Longint);
-Begin
-  byte(c):=byte(c)-a;
-End;
-
-Procedure Inc(var c : Char;a : Longint);
-Begin
-  Byte(c):=byte(c)+a;
-End;
-
-Procedure Dec(var p : PChar;a : Longint);
-Begin
-  longint(p):=longint(p)-a;
-End;
-
-Procedure Inc(var p : PChar;a : Longint);
-Begin
-  longint(p):=longint(p)+a;
-End;
-
-{$endif VER0_99_5}
-
 Function swap (X : Word) : Word;{$ifdef INTERNCONST}[internconst:in_const_swap_word];{$endif}
 Function swap (X : Word) : Word;{$ifdef INTERNCONST}[internconst:in_const_swap_word];{$endif}
 Begin
 Begin
   swap:=(X and $ff) shl 8 + (X shr 8)
   swap:=(X and $ff) shl 8 + (X shr 8)
@@ -265,7 +162,7 @@ End;
 
 
 {****************************************************************************
 {****************************************************************************
                           Random function routines
                           Random function routines
-                        
+
         This implements a very long cycle random number generator by combining
         This implements a very long cycle random number generator by combining
    three independant generators.  The technique was described in the March
    three independant generators.  The technique was described in the March
    1987 issue of Byte.
    1987 issue of Byte.
@@ -370,12 +267,26 @@ End;
 
 
 {$endif RTLLITE}
 {$endif RTLLITE}
 
 
+
 {*****************************************************************************
 {*****************************************************************************
                              Miscellaneous
                              Miscellaneous
 *****************************************************************************}
 *****************************************************************************}
 
 
+procedure int_overflow;[public,alias: {$ifdef FPCNAMES}'FPC_OVERFLOW'{$else}'RE_OVERFLOW'{$endif}];
+var
+  addr : longint;
+begin
+   addr:=get_caller_addr(get_frame);
+   If ErrorProc<>Nil then
+     TErrorProc (ErrorProc)(215,Pointer(Addr));
+{$ifndef RTLLITE}
+   Writeln('Overflow at 0x',HexStr(addr,8));
+{$endif}
+   HandleError(215);
+end;
+
 
 
-Function IOResult:Word;
+function IOResult:Word;
 Begin
 Begin
   IOResult:=InOutRes;
   IOResult:=InOutRes;
   InOutRes:=0;
   InOutRes:=0;
@@ -392,6 +303,37 @@ end;
                           Init / Exit / ExitProc
                           Init / Exit / ExitProc
 *****************************************************************************}
 *****************************************************************************}
 
 
+Procedure HandleError (Errno : longint);[alias : 'FPC_HANDLEERROR'];
+{
+  Procedure to handle internal errors, i.e. not user-invoked errors
+  Internal function should ALWAYS call HandleError instead of RunError.
+}
+var
+  addr : longint;
+begin
+  addr:=get_caller_addr(get_frame);
+  If ErrorProc<>Nil then
+    TErrorProc (ErrorProc)(Errno,pointer(addr));
+  errorcode:=Errno;
+  exitcode:=Errno;
+  erroraddr:=pointer(addr);
+  errorbase:=get_caller_frame(get_frame);
+  DoError:=true;
+  halt(errorcode);
+end;
+
+
+procedure runerror(w : word);[alias: 'FPC_RUNERROR'];
+begin
+  errorcode:=w;
+  exitcode:=w;
+  erroraddr:=pointer(get_caller_addr(get_frame));
+  errorbase:=get_caller_frame(get_frame);
+  DoError:=true;
+  halt(errorcode);
+end;
+
+
 Procedure RunError;
 Procedure RunError;
 Begin
 Begin
   RunError (0);
   RunError (0);
@@ -405,16 +347,6 @@ End;
 
 
 
 
 Procedure dump_stack(bp : Longint);
 Procedure dump_stack(bp : Longint);
-
-  Procedure dump_frame(addr : Longint);
-  Begin
-  {To be used by symify}
-    Writeln(stderr,'  0x',HexStr(addr,8));
-{$ifdef VER0_99_5}
-    Flush(stderr);
-{$endif VER0_99_5}
-  End;
-
 var
 var
   i, prevbp : Longint;
   i, prevbp : Longint;
 Begin
 Begin
@@ -422,17 +354,17 @@ Begin
   i:=0;
   i:=0;
   while bp > prevbp Do
   while bp > prevbp Do
    Begin
    Begin
-     dump_frame(get_addr(bp));
+     Writeln(stderr,'  0x',HexStr(get_caller_addr(bp),8));
      Inc(i);
      Inc(i);
      If i>max_frame_dump Then
      If i>max_frame_dump Then
       exit;
       exit;
      prevbp:=bp;
      prevbp:=bp;
-     bp:=get_next_frame(bp);
+     bp:=get_caller_frame(bp);
    End;
    End;
 End;
 End;
 
 
 
 
-Procedure Do_exit;[Public,Alias: '__EXIT'];
+Procedure do_exit;[Public,Alias: {$ifdef FPCNAMES}'FPC_DO_EXIT'{$else}'__EXIT'{$endif}];
 {
 {
   Don't call this direct, the call is generated by the compiler
   Don't call this direct, the call is generated by the compiler
   and by the halt procedure.
   and by the halt procedure.
@@ -458,9 +390,6 @@ Begin
      Writeln('Run time error  ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
      Writeln('Run time error  ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
      dump_stack(ErrorBase);
      dump_stack(ErrorBase);
    End;
    End;
-{$ifdef VER0_99_5}
-  Flush(stderr);
-{$endif VER0_99_5}
 End;
 End;
 
 
 
 
@@ -500,8 +429,9 @@ Begin
   ExitProc:=@DoExitProc;
   ExitProc:=@DoExitProc;
 End;
 End;
 
 
+
 {*****************************************************************************
 {*****************************************************************************
-      Assert() support.
+                           Assert() support.
 *****************************************************************************}
 *****************************************************************************}
 
 
 Procedure do_assert (Const Name,Msg : string; LineNo : Longint); [Public,Alias : 'FPC_DO_ASSERT'];
 Procedure do_assert (Const Name,Msg : string; LineNo : Longint); [Public,Alias : 'FPC_DO_ASSERT'];
@@ -511,7 +441,6 @@ begin
   else
   else
     write (stderr,msg);
     write (stderr,msg);
   writeln (stderr,'(File : ',name,', line ',LineNo,'.');
   writeln (stderr,'(File : ',name,', line ',LineNo,'.');
-  flush (stderr);
   HandleError (227);
   HandleError (227);
 end;
 end;
 
 
@@ -533,7 +462,11 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.29  1998-09-01 17:36:21  peter
+  Revision 1.30  1998-09-14 10:48:20  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.29  1998/09/01 17:36:21  peter
     + internconst
     + internconst
 
 
   Revision 1.28  1998/08/17 12:24:16  carl
   Revision 1.28  1998/08/17 12:24:16  carl

+ 6 - 46
rtl/inc/systemh.inc

@@ -26,12 +26,6 @@
 
 
 {$i version.inc}
 {$i version.inc}
 
 
-{$ifndef VER0_99_5}
-  {$ifndef VER0_99_6}
-    {$define INTERNCONST}
-  {$endif}
-{$endif}
-
 
 
 {****************************************************************************
 {****************************************************************************
                          Global Types and Constants
                          Global Types and Constants
@@ -47,11 +41,7 @@ Type
 { at least declare Turbo Pascal real types }
 { at least declare Turbo Pascal real types }
 {$ifdef i386}
 {$ifdef i386}
    StrLenInt = LongInt;
    StrLenInt = LongInt;
-  {$ifndef VER0_99_5}
-    {$ifndef VER0_99_6}
-      {$define DEFAULT_EXTENDED}
-    {$endif}
-  {$endif}
+  {$define DEFAULT_EXTENDED}
   {$define SUPPORT_EXTENDED}
   {$define SUPPORT_EXTENDED}
   {$define SUPPORT_COMP}
   {$define SUPPORT_COMP}
   {$define SUPPORT_SINGLE}
   {$define SUPPORT_SINGLE}
@@ -158,40 +148,6 @@ Function  Swap (X:Word):Word;
 Function  Swap (X:Integer):Integer;
 Function  Swap (X:Integer):Integer;
 Function  Swap (X:Cardinal):Cardinal;
 Function  Swap (X:Cardinal):Cardinal;
 Function  Swap (X:Longint):Longint;
 Function  Swap (X:Longint):Longint;
-{$ifdef VER0_99_5}
-Procedure Inc(Var i:cardinal);
-Procedure Inc(Var i:Longint);
-Procedure Inc(Var i:Integer);
-Procedure Inc(Var i:Word);
-Procedure Inc(Var i:shortint);
-Procedure Inc(Var i:byte);
-Procedure Inc(Var c:Char);
-Procedure Inc(Var p:PChar);
-Procedure Dec(Var i:cardinal);
-Procedure Dec(Var i:Longint);
-Procedure Dec(Var i:Integer);
-Procedure Dec(Var i:Word);
-Procedure Dec(Var i:shortint);
-Procedure Dec(Var i:byte);
-Procedure Dec(Var c:Char);
-Procedure Dec(Var p:PChar);
-Procedure Dec(Var i:cardinal;a:Longint);
-Procedure Inc(Var i:cardinal;a:Longint);
-Procedure Dec(Var i:Longint;a:Longint);
-Procedure Inc(Var i:Longint;a:Longint);
-Procedure Dec(Var i:Word;a:Longint);
-Procedure Inc(Var i:Word;a:Longint);
-Procedure Dec(Var i:Integer;a:Longint);
-Procedure Inc(Var i:Integer;a:Longint);
-Procedure Dec(Var i:byte;a:Longint);
-Procedure Inc(Var i:byte;a:Longint);
-Procedure Dec(Var i:shortint;a:Longint);
-Procedure Inc(Var i:shortint;a:Longint);
-Procedure Dec(Var c:Char;a:Longint);
-Procedure Inc(Var c:Char;a:Longint);
-Procedure Dec(Var p:PChar;a:Longint);
-Procedure Inc(Var p:PChar;a:Longint);
-{$endif VER0_99_5}
 {$endif RTLLITE}
 {$endif RTLLITE}
 
 
 Function Chr(b:byte):Char;
 Function Chr(b:byte):Char;
@@ -430,7 +386,11 @@ Procedure halt;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.27  1998-09-08 15:03:28  peter
+  Revision 1.28  1998-09-14 10:48:22  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.27  1998/09/08 15:03:28  peter
     * moved getmem/freemem/memavail/maxavail to heaph.inc
     * moved getmem/freemem/memavail/maxavail to heaph.inc
 
 
   Revision 1.26  1998/09/04 18:16:14  peter
   Revision 1.26  1998/09/04 18:16:14  peter

+ 37 - 113
rtl/inc/text.inc

@@ -102,7 +102,7 @@ begin
 end;
 end;
 
 
 
 
-Procedure Close(var t : Text);[Public,Alias: 'CLOSE_TEXT',IOCheck];
+Procedure Close(var t : Text);[IOCheck];
 Begin
 Begin
   if InOutRes <> 0 then Exit;
   if InOutRes <> 0 then Exit;
   If (TextRec(t).mode<>fmClosed) Then
   If (TextRec(t).mode<>fmClosed) Then
@@ -407,14 +407,14 @@ begin
 end;
 end;
 
 
 
 
-Procedure Write_End(var f:TextRec);[Public,Alias:'WRITE_END'];
+Procedure Write_End(var f:TextRec);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_END'];
 begin
 begin
   if f.FlushFunc<>nil then
   if f.FlushFunc<>nil then
    FileFunc(f.FlushFunc)(f);
    FileFunc(f.FlushFunc)(f);
 end;
 end;
 
 
 
 
-Procedure Writeln_End(var f:TextRec);[Public,Alias:'WRITELN_END'];
+Procedure Writeln_End(var f:TextRec);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'WRITELN_END'];
 const
 const
 {$IFDEF SHORT_LINEBREAK}
 {$IFDEF SHORT_LINEBREAK}
   eollen=1;
   eollen=1;
@@ -433,7 +433,7 @@ begin
 end;
 end;
 
 
 
 
-Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias: 'WRITE_TEXT_STRING'];
+Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_STRING'];
 Begin
 Begin
   If InOutRes <> 0 then exit;
   If InOutRes <> 0 then exit;
   If f.mode<>fmOutput Then
   If f.mode<>fmOutput Then
@@ -446,7 +446,7 @@ End;
 
 
 Type
 Type
    array00 = array[0..0] Of Char;
    array00 = array[0..0] Of Char;
-Procedure Write_Array(Len : Longint;var f : TextRec;const p : array00);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_ARRAY'];
+Procedure Write_Array(Len : Longint;var f : TextRec;const p : array00);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_PCHAR_AS_ARRAY'];
 var
 var
   ArrayLen : longint;
   ArrayLen : longint;
 Begin
 Begin
@@ -460,7 +460,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Write_PChar(Len : Longint;var f : TextRec;p : PChar);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_POINTER'];
+Procedure Write_PChar(Len : Longint;var f : TextRec;p : PChar);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_PCHAR_AS_POINTER'];
 var
 var
   PCharLen : longint;
   PCharLen : longint;
 Begin
 Begin
@@ -474,7 +474,7 @@ Begin
 End;
 End;
 
 
 {$ifdef UseAnsiStrings}
 {$ifdef UseAnsiStrings}
-Procedure Write_Text_AnsiString (Len : Longint; Var T : TextRec; Var S : AnsiString);[Public, alias: 'WRITE_TEXT_ANSISTRING'];
+Procedure Write_Text_AnsiString (Len : Longint; Var T : TextRec; Var S : AnsiString);[Public, alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_ANSISTRING'];
 {
 {
  Writes a AnsiString to the Text file T
  Writes a AnsiString to the Text file T
 }
 }
@@ -490,7 +490,7 @@ end;
 {$endif}
 {$endif}
 
 
 
 
-Procedure Write_LongInt(Len : Longint;var t : TextRec;l : Longint);[Public,Alias: 'WRITE_TEXT_LONGINT'];
+Procedure Write_LongInt(Len : Longint;var t : TextRec;l : Longint);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_LONGINT'];
 var
 var
   s : String;
   s : String;
 Begin
 Begin
@@ -500,7 +500,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Write_Real(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
+Procedure Write_Real(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_REAL'];
 var
 var
    s : String;
    s : String;
 Begin
 Begin
@@ -514,7 +514,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Write_Cardinal(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: 'WRITE_TEXT_CARDINAL'];
+Procedure Write_Cardinal(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_CARDINAL'];
 var
 var
   s : String;
   s : String;
 Begin
 Begin
@@ -524,7 +524,7 @@ Begin
 End;
 End;
 
 
 {$ifdef SUPPORT_SINGLE}
 {$ifdef SUPPORT_SINGLE}
-Procedure Write_Single(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
+Procedure Write_Single(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_SINGLE'];
 var
 var
   s : String;
   s : String;
 Begin
 Begin
@@ -536,7 +536,7 @@ End;
 
 
 
 
 {$ifdef SUPPORT_EXTENDED}
 {$ifdef SUPPORT_EXTENDED}
-Procedure Write_Extended(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias: 'WRITE_TEXT_EXTENDED'];
+Procedure Write_Extended(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_EXTENDED'];
 var
 var
   s : String;
   s : String;
 Begin
 Begin
@@ -548,7 +548,7 @@ End;
 
 
 
 
 {$ifdef SUPPORT_COMP}
 {$ifdef SUPPORT_COMP}
-Procedure Write_Comp(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
+Procedure Write_Comp(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_COMP'];
 var
 var
   s : String;
   s : String;
 Begin
 Begin
@@ -560,7 +560,7 @@ End;
 
 
 
 
 {$ifdef SUPPORT_FIXED}
 {$ifdef SUPPORT_FIXED}
-Procedure Write_Fixed(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: 'WRITE_TEXT_FIXED'];
+Procedure Write_Fixed(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_FIXED'];
 var
 var
   s : String;
   s : String;
 Begin
 Begin
@@ -571,7 +571,7 @@ End;
 {$endif SUPPORT_FIXED}
 {$endif SUPPORT_FIXED}
 
 
 
 
-Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
+Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_BOOLEAN'];
 Begin
 Begin
   If InOutRes <> 0 then exit;
   If InOutRes <> 0 then exit;
 { Can't use array[boolean] because b can be >0 ! }
 { Can't use array[boolean] because b can be >0 ! }
@@ -582,7 +582,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias: 'WRITE_TEXT_CHAR'];
+Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_CHAR'];
 Begin
 Begin
   If InOutRes <> 0 then exit;
   If InOutRes <> 0 then exit;
   If t.mode<>fmOutput Then
   If t.mode<>fmOutput Then
@@ -596,22 +596,6 @@ Begin
 End;
 End;
 
 
 
 
-{$ifdef VER0_99_5}
-Procedure w(var t : TextRec);[Public,Alias: 'WRITELN_TEXT'];
-var
-  hs : String;
-Begin
-  If InOutRes <> 0 then exit;
-  {$IFDEF SHORT_LINEBREAK}
-   hs:=#10;
-  {$ELSE}
-   hs:=#13#10;
-  {$ENDIF}
-  Write_Str(0,t,hs);
-End;
-{$endif VER0_99_5}
-
-
 {*****************************************************************************
 {*****************************************************************************
                                 Read(Ln)
                                 Read(Ln)
 *****************************************************************************}
 *****************************************************************************}
@@ -709,14 +693,14 @@ begin
 end;
 end;
 
 
 
 
-Procedure Read_End(var f:TextRec);[Public,Alias:'READ_END'];
+Procedure Read_End(var f:TextRec);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_END'];
 begin
 begin
   if f.FlushFunc<>nil then
   if f.FlushFunc<>nil then
    FileFunc(f.FlushFunc)(f);
    FileFunc(f.FlushFunc)(f);
 end;
 end;
 
 
 
 
-Procedure ReadLn_End(var f : TextRec);[Public,Alias: 'READLN_END'];
+Procedure ReadLn_End(var f : TextRec);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READLN_END'];
 Begin
 Begin
   If InOutRes <> 0 then exit;
   If InOutRes <> 0 then exit;
   if not OpenInput(f) then
   if not OpenInput(f) then
@@ -736,52 +720,7 @@ Begin
 End;
 End;
 
 
 
 
-{$ifdef VER0_99_5}
-Procedure Read_String(var f : TextRec;var s : String);[Public,Alias: 'READ_TEXT_STRING'];
-var
-  Temp,sPos : Word;
-Begin
-  { Delete the string }
-  s:='';
-  If InOutRes <> 0 then exit;
-  if not OpenInput(f) then
-   exit;
-  Temp:=f.BufPos;
-  sPos:=1;
-  while (f.BufPos<f.BufEnd) and (f.Bufptr^[Temp]<>#10) Do
-   Begin
-   { search linefeed }
-     while (f.Bufptr^[Temp]<>#10) and (Temp<f.BufEnd) Do
-      Inc(Temp);
-   { copy String. Take 255 char limit in account.}
-     If sPos+Temp-f.BufPos<=255 Then
-      Begin
-        Move (f.Bufptr^[f.BufPos],s[sPos],Temp-f.BufPos);
-        sPos:=sPos+Temp-f.BufPos;
-      { Remove #13 from a #13#10 break }
-        If s[sPos-1]=#13 Then
-         dec(sPos);
-      End
-     else
-      Begin
-        If (sPos<=255) Then
-         Move(f.Bufptr^[f.BufPos],s[sPos],256-sPos);
-        sPos:=256
-      End;
-   { update f.BufPos }
-     f.BufPos:=Temp;
-     If Temp>=f.BufEnd Then
-      Begin
-        FileFunc(f.InOutFunc)(f);
-        Temp:=f.BufPos;
-      End
-   End;
-  s[0]:=chr(sPos-1);
-End;
-
-{$else VER0_99_5}
-
-Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias:'READ_TEXT_STRING'];
+Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_STRING'];
 var
 var
   Temp,sPos,nrread : Word;
   Temp,sPos,nrread : Word;
 Begin
 Begin
@@ -826,10 +765,9 @@ Begin
    End;
    End;
   s[0]:=chr(sPos-1);
   s[0]:=chr(sPos-1);
 End;
 End;
-{$endif VER0_99_5}
 
 
 
 
-Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias: 'READ_TEXT_CHAR'];
+Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_CHAR'];
 Begin
 Begin
   c:=#0;
   c:=#0;
   If InOutRes <> 0 then exit;
   If InOutRes <> 0 then exit;
@@ -843,7 +781,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:'READ_TEXT_PCHAR_AS_POINTER'];
+Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_PCHAR_AS_POINTER'];
 var
 var
   p    : PChar;
   p    : PChar;
   Temp : byte;
   Temp : byte;
@@ -877,7 +815,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_Array(var f : TextRec;var s : array00);[Public,Alias:'READ_TEXT_PCHAR_AS_ARRAY'];
+Procedure Read_Array(var f : TextRec;var s : array00);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_PCHAR_AS_ARRAY'];
 var
 var
   p    : PChar;
   p    : PChar;
   Temp : byte;
   Temp : byte;
@@ -912,7 +850,7 @@ End;
 
 
 
 
 {$ifdef useansistrings}
 {$ifdef useansistrings}
-Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: 'READ_TEXT_ANSISTRING'];
+Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
 var
 var
   p    : PChar;
   p    : PChar;
   Temp : byte;
   Temp : byte;
@@ -952,7 +890,7 @@ End;
 {$endif}
 {$endif}
 
 
 
 
-Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias: 'READ_TEXT_LONGINT'];
+Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_LONGINT'];
 var
 var
   hs   : String;
   hs   : String;
   code : Word;
   code : Word;
@@ -971,7 +909,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_Integer(var f : TextRec;var l : Integer);[Public,Alias: 'READ_TEXT_INTEGER'];
+Procedure Read_Integer(var f : TextRec;var l : Integer);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_INTEGER'];
 var
 var
   ll : Longint;
   ll : Longint;
 Begin
 Begin
@@ -984,7 +922,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_Word(var f : TextRec;var l : Word);[Public,Alias: 'READ_TEXT_WORD'];
+Procedure Read_Word(var f : TextRec;var l : Word);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_WORD'];
 var
 var
   ll : Longint;
   ll : Longint;
 Begin
 Begin
@@ -997,7 +935,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_Byte(var f : TextRec;var l : byte);[Public,Alias: 'READ_TEXT_BYTE'];
+Procedure Read_Byte(var f : TextRec;var l : byte);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_BYTE'];
 var
 var
   ll : Longint;
   ll : Longint;
 Begin
 Begin
@@ -1010,7 +948,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_Shortint(var f : TextRec;var l : shortint);[Public,Alias: 'READ_TEXT_SHORTINT'];
+Procedure Read_Shortint(var f : TextRec;var l : shortint);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_SHORTINT'];
 var
 var
    ll : Longint;
    ll : Longint;
 Begin
 Begin
@@ -1023,7 +961,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_Cardinal(var f : TextRec;var l : cardinal);[Public,Alias: 'READ_TEXT_CARDINAL'];
+Procedure Read_Cardinal(var f : TextRec;var l : cardinal);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_CARDINAL'];
 var
 var
   hs   : String;
   hs   : String;
   code : Word;
   code : Word;
@@ -1042,7 +980,7 @@ Begin
 End;
 End;
 
 
 
 
-Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias: 'READ_TEXT_REAL'];
+Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_REAL'];
 var
 var
   hs   : String;
   hs   : String;
   code : Word;
   code : Word;
@@ -1081,7 +1019,7 @@ End;
 
 
 
 
 {$ifdef SUPPORT_EXTENDED}
 {$ifdef SUPPORT_EXTENDED}
-Procedure Read_Extended(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
+Procedure Read_Extended(var f : TextRec;var d : extended);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_EXTENDED'];
 var
 var
   hs   : String;
   hs   : String;
   code : Word;
   code : Word;
@@ -1121,7 +1059,7 @@ End;
 
 
 
 
 {$ifdef SUPPORT_COMP}
 {$ifdef SUPPORT_COMP}
-Procedure Read_Comp(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
+Procedure Read_Comp(var f : TextRec;var d : comp);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_COMP'];
 var
 var
   hs   : String;
   hs   : String;
   code : Word;
   code : Word;
@@ -1160,24 +1098,6 @@ End;
 {$endif SUPPORT_COMP}
 {$endif SUPPORT_COMP}
 
 
 
 
-{$ifdef VER0_99_5}
-Procedure r(var f : TextRec);[Public,Alias: 'READLN_TEXT'];
-Begin
-  If InOutRes <> 0 then exit;
-  if not OpenInput(f) then
-   exit;
-  while (f.BufPos<f.BufEnd) do
-   begin
-     inc(f.BufPos);
-     if (f.BufPtr^[f.BufPos-1]=#10) then
-      exit;
-     If f.BufPos>=f.BufEnd Then
-      FileFunc(f.InOutFunc)(f);
-   end;
-End;
-{$endif VER0_99_5}
-
-
 {*****************************************************************************
 {*****************************************************************************
                                Initializing
                                Initializing
 *****************************************************************************}
 *****************************************************************************}
@@ -1202,7 +1122,11 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.24  1998-09-08 10:14:06  peter
+  Revision 1.25  1998-09-14 10:48:23  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.24  1998/09/08 10:14:06  peter
     + textrecbufsize
     + textrecbufsize
 
 
   Revision 1.23  1998/08/26 15:33:28  peter
   Revision 1.23  1998/08/26 15:33:28  peter

+ 5 - 92
rtl/inc/textrec.inc

@@ -21,16 +21,6 @@
   unit without sacrificing TP compatibility.
   unit without sacrificing TP compatibility.
 }
 }
 
 
-{$ifndef VER0_99_5}
-  {$ifndef VER0_99_6}
-    {$define UNIFORM_TEXTREC}
-  {$endif}
-{$endif}
-
-
-{$ifdef UNIFORM_TEXTREC}
-
-
 const
 const
   TextRecNameLength = 256;
   TextRecNameLength = 256;
   TextRecBufSize    = 256;
   TextRecBufSize    = 256;
@@ -53,90 +43,13 @@ type
     buffer    : textbuf;
     buffer    : textbuf;
   End;
   End;
 
 
-
-{$else UNIFORM_TEXTREC}
-
-
-{**********************************
-   Old style for 0.99.5/0.99.6
-**********************************}
-
-Const
-{$ifdef linux}
-  textrecnamelength = 256;
-{$endif}
-{$ifdef Win32}
-    textrecnamelength = 256;
-{$endif}
-{$ifdef MACOS}
-    textrecnamelength = 256;
-{$endif}
-{$ifdef AMIGA}
-    textrecnamelength = 256;
-{$endif}
-{$ifdef OS2}
-    textrecnamelength = 80;
-{$endif}
-{$ifdef Go32v1}
-    textrecnamelength = 80;
-{$endif Go32v1}
-{$ifdef Go32v2}
-    textrecnamelength = 80;
-{$endif Go32v2}
-{$ifdef ATARI}
-    textrecnamelength = 80;
-{$endif}
-  TextRecBufSize    = 128;
-
-type
-  textbuf = array[0..TextRecBufSize-1] of char;
-
-{$PACKRECORDS 2}
-  textrec = record
-{$ifdef win32}
-     handle    : longint;
-{$endif win32}
-{$ifdef amiga}
-     handle    : longint;
-{$endif amiga}
-{$ifdef macos}
-     handle    : longint;
-{$endif macos}
-{$ifdef linux}
-     handle    : word;
-{$endif}
-{$ifdef Go32v1}
-     handle    : word;
-{$endif Go32v1}
-{$ifdef Go32v2}
-     handle    : word;
-{$endif Go32v2}
-{$ifdef atari}
-     handle    : word;
-{$endif atari}
-{$ifdef os2}
-     handle    : word;
-{$endif os2}
-     mode      : word;
-     bufsize,
-     _private,
-     bufpos,
-     bufend    : word;
-     bufptr    : ^textbuf;
-     openfunc,
-     inoutfunc,
-     flushfunc,
-     closefunc : pointer;
-     userdata  : array[1..16] of byte;
-     name      : array[0..textrecnamelength-1] of char;
-     buffer    : textbuf;
-  end;
-
-{$endif UNIFORM_TEXTREC}
-
 {
 {
   $Log$
   $Log$
-  Revision 1.5  1998-09-08 10:14:07  peter
+  Revision 1.6  1998-09-14 10:48:25  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.5  1998/09/08 10:14:07  peter
     + textrecbufsize
     + textrecbufsize
 
 
   Revision 1.4  1998/09/04 18:16:15  peter
   Revision 1.4  1998/09/04 18:16:15  peter

+ 17 - 9
rtl/inc/typefile.inc

@@ -46,32 +46,36 @@ begin
 end;
 end;
 
 
 
 
-Procedure Int_Typed_Reset(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'RESET_TYPED'];
+Procedure Int_Typed_Reset(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: {$ifdef FPCNAMES}'FPC_RESET_TYPED'{$else}'RESET_TYPED'{$endif}];
 Begin
 Begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Reset(UnTypedFile(f),Size);
   Reset(UnTypedFile(f),Size);
 End;
 End;
 
 
 
 
-Procedure Int_Typed_Rewrite(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'REWRITE_TYPED'];
+Procedure Int_Typed_Rewrite(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: {$ifdef FPCNAMES}'FPC_REWRITE_TYPED'{$else}'REWRITE_TYPED'{$endif}];
 Begin
 Begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Rewrite(UnTypedFile(f),Size);
   Rewrite(UnTypedFile(f),Size);
 End;
 End;
 
 
 
 
-Procedure Int_Typed_Write(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_WRITE'];
+Procedure Int_Typed_Write(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : {$ifdef FPCNAMES}'FPC_TYPED_WRITE'{$else}'TYPED_WRITE'{$endif}];
 Begin
 Begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Do_Write(FileRec(f).Handle,Longint(@Buf),TypeSize);
   Do_Write(FileRec(f).Handle,Longint(@Buf),TypeSize);
 End;
 End;
 
 
 
 
-Procedure Int_Typed_Read(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_READ'];
+Procedure Int_Typed_Read(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : {$ifdef FPCNAMES}'FPC_TYPED_READ'{$else}'TYPED_READ'{$endif}];
 var
 var
   Result : Longint;
   Result : Longint;
 Begin
 Begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Result:=Do_Read(FileRec(f).Handle,Longint(@Buf),TypeSize);
   Result:=Do_Read(FileRec(f).Handle,Longint(@Buf),TypeSize);
   If Result<TypeSize Then
   If Result<TypeSize Then
    InOutRes:=100;
    InOutRes:=100;
@@ -79,7 +83,11 @@ End;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-07-02 12:16:28  carl
+  Revision 1.5  1998-09-14 10:48:26  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.4  1998/07/02 12:16:28  carl
     * IoCheck routines now check for InOutRes before executing, just like TP
     * IoCheck routines now check for InOutRes before executing, just like TP
 
 
   Revision 1.3  1998/05/21 19:31:02  peter
   Revision 1.3  1998/05/21 19:31:02  peter

+ 47 - 7
rtl/linux/syslinux.pp

@@ -47,7 +47,7 @@ const
   {$endif}
   {$endif}
 {$else}
 {$else}
   UnusedHandle    = $ffff;
   UnusedHandle    = $ffff;
-{$endif}  
+{$endif}
   StdInputHandle  = 0;
   StdInputHandle  = 0;
   StdOutputHandle = 1;
   StdOutputHandle = 1;
   StdErrorHandle  = 2;
   StdErrorHandle  = 2;
@@ -96,7 +96,9 @@ Implementation
                        Misc. System Dependent Functions
                        Misc. System Dependent Functions
 *****************************************************************************}
 *****************************************************************************}
 
 
-{$ASMMODE DIRECT}
+{$ifdef i386}
+  {$ASMMODE DIRECT}
+{$endif}
 
 
 Procedure Halt(ErrNum: Byte);
 Procedure Halt(ErrNum: Byte);
 Begin
 Begin
@@ -108,6 +110,9 @@ Begin
         jmp     _haltproc
         jmp     _haltproc
   end;
   end;
 {$else}
 {$else}
+  asm
+        jmp     _haltproc
+  end;
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -150,7 +155,7 @@ Begin
   if pp^<>nil then
   if pp^<>nil then
     Paramstr:=StrPas(pp^)
     Paramstr:=StrPas(pp^)
   else
   else
-    ParamStr:='';  
+    ParamStr:='';
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -169,6 +174,31 @@ End;
                               Heap Management
                               Heap Management
 *****************************************************************************}
 *****************************************************************************}
 
 
+function getheapstart:pointer;assembler;
+{$ifdef i386}
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+{$else}
+asm
+        lea.l   HEAP,a0
+        move.l  a0,d0
+end;
+{$endif}
+
+
+function getheapsize:longint;assembler;
+{$ifdef i386}
+asm
+        movl    HEAPSIZE,%eax
+end ['EAX'];
+{$else}
+asm
+       move.l   HEAP_SIZE,d0
+end ['D0'];
+{$endif}
+
+
 { ___fpc_brk_addr is defined and allocated in prt1.as }
 { ___fpc_brk_addr is defined and allocated in prt1.as }
 
 
 Function Get_Brk_addr : longint;assembler;
 Function Get_Brk_addr : longint;assembler;
@@ -178,7 +208,8 @@ asm
 end ['EAX'];
 end ['EAX'];
 {$else}
 {$else}
 asm
 asm
-end;
+        move.l  ___fpc_brk_addr,d0
+end ['D0'];
 {$endif}
 {$endif}
 
 
 
 
@@ -190,10 +221,14 @@ asm
 end ['EAX'];
 end ['EAX'];
 {$else}
 {$else}
 asm
 asm
-end;
+        move.l  NewAddr,d0
+        move.l  d0,___fpc_brk_addr
+end ['D0'];
 {$endif}
 {$endif}
 
 
-{$ASMMODE ATT}
+{$ifdef i386}
+  {$ASMMODE ATT}
+{$endif}
 
 
 Function brk(Location : longint) : Longint;
 Function brk(Location : longint) : Longint;
 { set end of data segment to location }
 { set end of data segment to location }
@@ -235,6 +270,7 @@ begin
   exit(-1);
   exit(-1);
 end;
 end;
 
 
+
 { include standard heap management }
 { include standard heap management }
 {$I heap.inc}
 {$I heap.inc}
 
 
@@ -697,7 +733,11 @@ End.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.15  1998-09-06 19:41:40  peter
+  Revision 1.16  1998-09-14 10:48:27  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.15  1998/09/06 19:41:40  peter
     * fixed unusedhandle for 0.99.5
     * fixed unusedhandle for 0.99.5
 
 
   Revision 1.14  1998/09/04 18:16:16  peter
   Revision 1.14  1998/09/04 18:16:16  peter

+ 0 - 1122
rtl/m68k/heap.inc

@@ -1,1122 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{****************************************************************************
-               functions for heap management in the data segment
- ****************************************************************************}
-{**** 10/06/97 added checkings and corrected some bugs in getmem/freemem ****}
-{**** Pierre Muller *********************************************************}
-
-{ three conditionnals here }
-
-{ TEMPHEAP to  allow to split the heap in two parts for easier release}
-{ started for the compiler }
-{ USEBLOCKS if you want special allocation for small blocks }
-{ CHECKHEAP if you want to test the heap integrity }
-
-{$IfDef CHECKHEAP}
-    { 4 levels of tracing }
-    const tracesize = 4;
-    type   pheap_mem_info = ^heap_mem_info;
-           heap_mem_info = record
-           next,previous : pheap_mem_info;
-           size : longint;
-           sig : longint; {dummy number for test }
-           calls : array [1..tracesize] of longint;
-           end;
-           { size 8*4 = 32 }
-    { help variables for debugging with GDB }
-    const check : boolean = false;
-    const last_assigned : pheap_mem_info = nil;
-    const growheapstop : boolean = false;
-
-    const free_nothing : boolean = false;
-    const trace : boolean = true;
-    const getmem_nb : longint = 0;
-    const freemem_nb : longint = 0;
-{$EndIf CHECKHEAP}
-
-    const
-       heap_split : boolean = false;
-       max_size = 256;
-       maxblock = max_size div 8;
-       freerecord_list_length : longint = 0;
-
-    var
-       _memavail : longint;
-       _internal_heapsize : longint;
-
-    type
-{$ifdef UseBlocks}
-       tblocks   = array[1..maxblock] of pointer;
-       pblocks   = ^tblocks;
-       tnblocks  = array[1..maxblock] of longint;
-       pnblocks  = ^tnblocks;
-{$endif UseBlocks}
-       pheapinfo = ^theapinfo;
-       theapinfo = record
-         heaporg,heapptr,heapend,freelist : pointer;
-         memavail,heapsize : longint;
-{$ifdef UseBlocks}
-         block : pblocks;
-         nblock : pnblocks;
-{$endif UseBlocks}
-{$IfDef CHECKHEAP}
-        last_mem : pheap_mem_info;
-        nb_get,nb_free : longint;
-{$EndIf CHECKHEAP}
-         end;
-    type
-       pfreerecord = ^tfreerecord;
-
-       tfreerecord = record
-          next : pfreerecord;
-          size : longint;
-       end;
-
-    var
-       baseheap : theapinfo;
-       curheap : pheapinfo;
-{$ifdef TEMPHEAP}
-       tempheap : theapinfo;
-       otherheap : pheapinfo;
-{$endif TEMPHEAP}
-
-{$ifdef UseBlocks}
-       baseblocks : tblocks;
-       basenblocks : tnblocks;
-{$endif UseBlocks}
-
-{ this is not supported by FPK <v093
-    const
-       blocks : pblocks = @baseblocks;
-       nblocks : pnblocks = @basenblocks; }
-      type
-         ppointer = ^pointer;
-
-{$ifdef UseBlocks}
-    var blocks : pblocks;
-        nblocks : pnblocks;
-{$endif UseBlocks}
-
-
-
-    { Get start address of HEAP, this works well }
-    { with AMIGA, ATARI, but for the MAC, the    }
-    { HEAP is a pointer!!!                       }
-{$IFNDEF MACOS}
-    function getheapstart : pointer; assembler;
-    asm
-       lea.l HEAP,a0
-       move.l a0,d0
-    end;
-{$ELSE}
-    function getheapstart : pointer; assembler;
-    asm
-       move.l HEAP,d0
-    end;
-
-{$ENDIF MACOS}
-
-    function getheapsize : longint; assembler;
-    asm
-       move.l HEAP_SIZE,d0
-    end ['d0'];
-
-
-    function heapsize : longint;
-
-	  begin
-		 heapsize:=_internal_heapsize;
-      end;
-
-{$IfDef CHECKHEAP}
-    procedure call_stack(p : pointer);
-      var i : longint;
-          pp : pheap_mem_info;
-      begin
-
-        if trace then
-          begin
-             pp:=pheap_mem_info(p-sizeof(heap_mem_info));
-             writeln('Call trace of 0x',hexstr(longint(p),8));
-             writeln('of size ',pp^.size);
-             for i:=1 to tracesize do
-               begin
-                 writeln(i,' 0x',hexstr(pp^.calls[i],8));
-               end;
-          end
-        else
-          writeln('tracing not enabled, sorry !!');
-      end;
-
-    procedure dump_heap(mark : boolean);
-      var pp : pheap_mem_info;
-      begin
-         pp:=last_assigned;
-         while pp<>nil do
-           begin
-              call_stack(pp+sizeof(heap_mem_info));
-              if mark then
-                pp^.sig:=$AAAAAAAA;
-              pp:=pp^.previous;
-           end;
-      end;
-
-    procedure dump_free(p : pheap_mem_info);
-      var bp : longint;
-      begin
-         Writeln('Marked memory at ',HexStr(longint(p),8),' released');
-         call_stack(p+sizeof(heap_mem_info));
-         asm
-            move.l (a6),a0
-            move.l (a0),d0
-            move.l d0,bp
-         end;
-         dump_stack(bp);
-      end;
-
-    function is_in_getmem_list (p : pointer) : boolean;
-        var pp : pheap_mem_info;
-            i : longint;
-      begin
-        is_in_getmem_list:=false;
-        pp:=last_assigned;
-        i:=0;
-        while pp<>nil do
-          begin
-             if (pp^.sig<>$DEADBEEF) and (pp^.sig <> $AAAAAAAA) then
-               begin
-                  writeln('error in linked list of heap_mem_info');
-                  runerror(204);
-               end;
-
-             if pp=p then
-               begin
-                  is_in_getmem_list:=true;
-               end;
-             pp:=pp^.previous;
-             inc(i);
-             if i > getmem_nb - freemem_nb then
-               writeln('error in linked list of heap_mem_info');
-          end;
-      end;
-
-    function is_in_free(p : pointer) : boolean;
-
-      var
-         hp : pfreerecord;
-
-      begin
-         if p>heapptr then
-           begin
-              is_in_free:=true;
-              exit;
-           end
-         else
-           begin
-              hp:=freelist;
-              while assigned(hp) do
-                begin
-                   if (p>=hp) and (p<hp+hp^.size) then
-                     begin
-                        is_in_free:=true;
-                        exit;
-                     end;
-                   hp:=hp^.next;
-                end;
-              is_in_free:=false;
-           end;
-      end;
-{$EndIf CHECKHEAP}
-
-    function cal_memavail : longint;
-
-      var
-         hp : pfreerecord;
-         i,ma : longint;
-
-      begin
-         ma:=heapend-heapptr;
-{$ifdef UseBlocks}
-         for i:=1 to maxblock do
-           ma:=ma+i*8*nblocks^[i];
-{$endif UseBlocks}
-         hp:=freelist;
-         while assigned(hp) do
-           begin
-              ma:=ma+hp^.size;
-{$IfDef CHECKHEAP}
-              if (longint(hp^.next)=0) then
-                begin
-                   if ((longint(hp)+hp^.size)>longint(heapptr)) then
-                     writeln('freerecordlist bad at end ')
-                end
-              else
-		          if ((longint(hp^.next)<=(longint(hp)+hp^.size)) or
-		             ((hp^.size mod 8) <> 0)) then
-                  writeln('error in freerecord list ');
-{$EndIf CHECKHEAP}
-              hp:=hp^.next;
-           end;
-         cal_memavail:=ma;
-      end;
-
-{$ifdef TEMPHEAP}
-    procedure split_heap;
-      var i :longint;
-    begin
-    if not heap_split then
-      begin
-      baseheap.heaporg:=heaporg;
-      baseheap.heapptr:=heapptr;
-      baseheap.freelist:=freelist;
-      baseheap.block:=blocks;
-      baseheap.nblock:=nblocks;
-      longint(baseheap.heapend):=((longint(heapend)+longint(heapptr)) div 16)*8;
-      tempheap.heaporg:=baseheap.heapend;
-      tempheap.freelist:=nil;
-      tempheap.heapptr:=tempheap.heaporg;
-{$IfDef CHECKHEAP}
-      tempheap.last_mem:=nil;
-      tempheap.nb_get:=0;
-      tempheap.nb_free:=0;
-{$EndIf CHECKHEAP}
-      tempheap.heapend:=heapend;
-      tempheap.memavail:=longint(tempheap.heapend) - longint(tempheap.heaporg);
-      tempheap.heapsize:=tempheap.memavail;
-      getmem(tempheap.block,sizeof(tblocks));
-      getmem(tempheap.nblock,sizeof(tnblocks));
-      for i:=1 to maxblock do
-        begin
-        tempheap.block^[i]:=nil;
-        tempheap.nblock^[i]:=0;
-        end;
-      heapend:=baseheap.heapend;
-      _memavail:=cal_memavail;
-      baseheap.memavail:=_memavail;
-      baseheap.heapsize:=longint(baseheap.heapend)-longint(baseheap.heaporg);
-      curheap:=@baseheap;
-      otherheap:=@tempheap;
-      heap_split:=true;
-      end;
-    end;
-
-    procedure switch_to_temp_heap;
-    begin
-    if curheap = @baseheap then
-      begin
-      baseheap.heaporg:=heaporg;
-      baseheap.heapend:=heapend;
-      baseheap.heapptr:=heapptr;
-      baseheap.freelist:=freelist;
-      baseheap.memavail:=_memavail;
-      baseheap.block:=blocks;
-      baseheap.nblock:=nblocks;
-{$IfDef CHECKHEAP}
-      baseheap.last_mem:=last_assigned;
-      last_assigned:=tempheap.last_mem;
-      baseheap.nb_get:=getmem_nb;
-      baseheap.nb_free:=freemem_nb;
-      getmem_nb:=tempheap.nb_get;
-      freemem_nb:=tempheap.nb_free;
-{$EndIf CHECKHEAP}
-      heaporg:=tempheap.heaporg;
-      heapptr:=tempheap.heapptr;
-      freelist:=tempheap.freelist;
-      heapend:=tempheap.heapend;
-      blocks:=tempheap.block;
-      nblocks:=tempheap.nblock;
-      _memavail:=cal_memavail;
-      curheap:=@tempheap;
-      otherheap:=@baseheap;
-      end;
-    end;
-
-    procedure switch_to_base_heap;
-    begin
-    if curheap = @tempheap then
-      begin
-      tempheap.heaporg:=heaporg;
-      tempheap.heapend:=heapend;
-      tempheap.heapptr:=heapptr;
-      tempheap.freelist:=freelist;
-      tempheap.memavail:=_memavail;
-{$IfDef CHECKHEAP}
-      tempheap.last_mem:=last_assigned;
-      last_assigned:=baseheap.last_mem;
-      tempheap.nb_get:=getmem_nb;
-      tempheap.nb_free:=freemem_nb;
-      getmem_nb:=baseheap.nb_get;
-      freemem_nb:=baseheap.nb_free;
-{$EndIf CHECKHEAP}
-      heaporg:=baseheap.heaporg;
-      heapptr:=baseheap.heapptr;
-      freelist:=baseheap.freelist;
-      heapend:=baseheap.heapend;
-      blocks:=baseheap.block;
-      nblocks:=baseheap.nblock;
-      _memavail:=cal_memavail;
-      curheap:=@baseheap;
-      otherheap:=@tempheap;
-      end;
-    end;
-
-    procedure switch_heap;
-    begin
-    if not heap_split then split_heap;
-    if curheap = @tempheap then
-      switch_to_base_heap
-      else
-      switch_to_temp_heap;
-    end;
-
-    procedure gettempmem(var p : pointer;size : longint);
-
-    begin
-       split_heap;
-       switch_to_temp_heap;
-       allow_special:=true;
-       getmem(p,size);
-       allow_special:=false;
-    end;
-{$endif TEMPHEAP}
-
-    function memavail : longint;
-
-      begin
-         memavail:=_memavail;
-      end;
-
-{$ifdef TEMPHEAP}
-    procedure unsplit_heap;
-    var hp,hp2,thp : pfreerecord;
-    begin
-    {heapend can be modified by HeapError }
-    if not heap_split then exit;
-    if baseheap.heapend = tempheap.heaporg then
-      begin
-      switch_to_base_heap;
-      hp:=pfreerecord(freelist);
-      if assigned(hp) then
-        while assigned(hp^.next) do hp:=hp^.next;
-      if tempheap.heapptr<>tempheap.heaporg then
-        begin
-           if hp<>nil then
-             hp^.next:=heapptr;
-           hp:=pfreerecord(heapptr);
-           hp^.size:=heapend-heapptr;
-           hp^.next:=tempheap.freelist;
-           heapptr:=tempheap.heapptr;
-        end;
-      heapend:=tempheap.heapend;
-      _memavail:=cal_memavail;
-      heap_split:=false;
-      end else
-      begin
-      hp:=pfreerecord(baseheap.freelist);
-      hp2:=pfreerecord(tempheap.freelist);
-      while assigned(hp) and assigned(hp2) do
-        begin
-        if hp=hp2 then break;
-        if hp>hp2 then
-          begin
-          thp:=hp2;
-          hp2:=hp;
-          hp:=thp;
-          end;
-        while assigned(hp^.next) and (hp^.next<hp2) do
-            hp:=hp^.next;
-        if assigned(hp^.next) then
-            begin
-            thp:=hp^.next;
-            hp^.next:=hp2;
-            hp:=thp;
-            end else
-            begin
-            hp^.next:=hp2;
-            hp:=nil;
-            end;
-          end ;
-      if heapend < tempheap.heapend then
-        heapend:=tempheap.heapend;
-      if heapptr < tempheap.heapptr then
-        heapptr:=tempheap.heapptr;
-      freemem(tempheap.block,sizeof(tblocks));
-      freemem(tempheap.nblock,sizeof(tnblocks));
-      _memavail:=cal_memavail;
-      heap_split:=false;
-      end;
-    end;
-
-    procedure releasetempheap;
-    begin
-    switch_to_temp_heap;
-{$ifdef CHECKHEAP}
-    if heapptr<>heaporg then
-      writeln('Warning in releasetempheap : ',longint(tempheap.heapsize)-longint(tempheap.memavail),' bytes used !');
-    dump_heap(true);
-{    release(heaporg);
-    fillchar(heaporg^,longint(heapend)-longint(heaporg),#0);}
-{$endif CHECKHEAP }
-    unsplit_heap;
-    split_heap;
-    end;
-{$endif TEMPHEAP}
-
-    function maxavail : longint;
-
-      var
-         hp : pfreerecord;
-
-      begin
-         maxavail:=heapend-heapptr;
-         hp:=freelist;
-         while assigned(hp) do
-           begin
-              if hp^.size>maxavail then
-                maxavail:=hp^.size;
-              hp:=hp^.next;
-           end;
-      end;
-
-{$ifdef CHECKHEAP}
-     procedure test_memavail;
-
-       begin
-          if check and (_memavail<>cal_memavail) then
-            begin
-               writeln('Memavail error in getmem/freemem');
-            end;
-       end;
-{$endif CHECKHEAP}
-
-    procedure getmem(var p : pointer;size : longint);[public,alias: 'GETMEM'];
-
-{$IfDef CHECKHEAP}
-      var i,bp,orsize : longint;
-      label check_new;
-{$endif CHECKHEAP}
-
-      { changed to removed the OS conditionnals }
-      function call_heaperror(addr : pointer; size : longint) : integer;
-        begin
-           asm
-              move.l  size,-(sp)
-              move.l  addr,a0
-              jsr     (a0)
-              move.w  d0,@Result
-           end;
-        end;
-
-      var
-         last,hp : pfreerecord;
-         nochmal : boolean;
-         s : longint;
-
-      begin
-{$ifdef CHECKHEAP}
-         if trace then
-           begin
-              orsize:=size;
-              size:=size+sizeof(heap_mem_info);
-           end;
-{$endif CHECKHEAP}
-         if size=0 then
-           begin
-              p:=heapend;
-{$ifdef CHECKHEAP}
-              goto check_new;
-{$else CHECKHEAP}
-              exit;
-{$endif CHECKHEAP}
-           end;
-{$ifdef TEMPHEAP}
-         if heap_split and not allow_special then
-           begin
-           if (@p < otherheap^.heapend) and
-              (@p > otherheap^.heaporg) then
-              { useful line for the debugger }
-             writeln('warning : p and @p are in different heaps !');
-           end;
-{$endif TEMPHEAP}
-         { calc to multiply of 8 }
-         if (size mod 8)<>0 then
-           size:=size+(8-(size mod 8));
-         dec(_memavail,size);
-{$ifdef UseBlocks}
-         { search cache }
-         if size<=max_size then
-           begin
-              s:=size div 8;
-              if assigned(blocks^[s]) then
-                begin
-                   p:=blocks^[s];
-                   blocks^[s]:=pointer(blocks^[s]^);
-                   dec(nblocks^[s]);
-{$ifdef CHECKHEAP}
-                   goto check_new;
-{$else CHECKHEAP}
-                   exit;
-{$endif CHECKHEAP}
-                end;
-           end;
-{$endif UseBlocks}
-         repeat
-           nochmal:=false;
-           { search the freelist }
-           if assigned(freelist) then
-             begin
-                last:=nil;
-                hp:=freelist;
-                while assigned(hp) do
-                  begin
-                     { take the first fitting block }
-                     if hp^.size>=size then
-                       begin
-                          p:=hp;
-                          { need we the whole block ? }
-                          if hp^.size>size then
-                            begin
-{$ifdef UseBlocks}
-                               { we must check if we are still below the limit !! }
-                               if hp^.size-size<=max_size then
-                                 begin
-                                    { adjust the list }
-                                    if assigned(last) then
-                                      last^.next:=hp^.next
-                                    else
-                                      freelist:=hp^.next;
-                                    { insert in chain }
-                                    s:=(hp^.size-size) div 8;
-                                    ppointer(hp+size)^:=blocks^[s];
-                                    blocks^[s]:=hp+size;
-                                    inc(nblocks^[s]);
-                                 end
-                               else
-{$endif UseBlocks}
-                               begin
-                                  (hp+size)^.size:=hp^.size-size;
-                                  (hp+size)^.next:=hp^.next;
-                                  if assigned(last) then
-                                    last^.next:=hp+size
-                                  else
-                                    freelist:=hp+size;
-                               end;
-                            end
-                          else
-                            begin
-{$IfDef CHECKHEAP}
-                               dec(freerecord_list_length);
-{$endif CHECKHEAP}
-                               if assigned(last) then
-                                 last^.next:=hp^.next
-                               else
-                                 {this was wrong !!}
-                                 {freelist:=nil;}
-                                 freelist:=hp^.next;
-                            end;
-{$ifdef CHECKHEAP}
-                            goto check_new;
-{$else CHECKHEAP}
-                            exit;
-{$endif CHECKHEAP}
-                       end;
-                     last:=hp;
-                     hp:=hp^.next;
-                  end;
-             end;
-           { Latly, the top of the heap is checked, to see if there is }
-           { still memory available.                                   }
-           if heapend-heapptr<size then
-             begin
-                if assigned(heaperror) then
-                  begin
-                     case call_heaperror(heaperror,size) of
-                        0 : runerror(203);
-                        1 : p:=nil;
-                        2 : nochmal:=true;
-                     end;
-                  end
-                else
-                  runerror(203);
-             end
-           else
-             begin
-                p:=heapptr;
-                heapptr:=heapptr+size;
-             end;
-         until not nochmal;
-{$ifdef CHECKHEAP}
-check_new:
-     inc(getmem_nb);
-     test_memavail;
-     if trace then
-       begin
-           asm
-              move.l (a6),d0
-              move.l d0,bp
-           end;
-          pheap_mem_info(p)^.sig:=$DEADBEEF;
-          pheap_mem_info(p)^.previous:=last_assigned;
-          if last_assigned<>nil then
-            last_assigned^.next:=pheap_mem_info(p);
-          last_assigned:=p;
-          pheap_mem_info(p)^.next:=nil;
-          pheap_mem_info(p)^.size:=orsize;
-          for i:=1 to tracesize do
-            begin
-               pheap_mem_info(p)^.calls[i]:=get_addr(bp);
-               bp:=get_next_frame(bp);
-            end;
-          p:=p+sizeof(heap_mem_info);
-       end;
-{$endif CHECKHEAP}
-      end;
-
-    procedure freemem(var p : pointer;size : longint);[public,alias: 'FREEMEM'];
-
-      var
-         hp : pfreerecord;
-{$ifdef TEMPHEAP}
-         heap_switched : boolean;
-{$endif TEMPHEAP}
-         s : longint;
-
-      label freemem_exit;
-
-      begin
-{$ifdef CHECKHEAP}
-         if free_nothing then
-           begin
-              p:=nil;
-              exit;
-           end;
-     if trace then
-       begin
-          size:=size+sizeof(heap_mem_info);
-          p:=p-sizeof(heap_mem_info);
-          { made after heap_switch
-          if not (is_in_getmem_list(p)) then
-            runerror(204); }
-       end;
-{$endif CHECKHEAP}
-         if size=0 then
-           begin
-              p:=nil;
-              exit;
-           end;
-         if p=nil then RunError (204);
-{$ifdef TEMPHEAP}
-         heap_switched:=false;
-         if heap_split and not allow_special then
-           begin
-              if (p <= heapptr) and
-                 ( p >= heaporg) and
-                 (@p <= otherheap^.heapend) and
-                 (@p >= otherheap^.heaporg) then
-                begin
-                   writeln('warning : p and @p are in different heaps !');
-                end;
-           end;
-         if (p<heaporg) or (p>heapptr) then
-           begin
-              if heap_split and (p<otherheap^.heapend) and
-                 (p>otherheap^.heaporg) then
-                begin
-                   if (@p >= heaporg) and
-                      (@p <= heapptr) and
-                      not allow_special then
-                      writeln('warning : p and @p are in different heaps !');
-                   switch_heap;
-                   heap_switched:=true;
-                end
-              else
-                begin
-                   writeln('pointer ',hexstr(longint(@p),8),' at ',
-                     hexstr(longint(p),8),' doesn''t points to the heap');
-                   runerror(204);
-                end;
-           end;
-{$endif TEMPHEAP}
-{$ifdef CHECKHEAP}
-     if trace then
-       begin
-          if not (is_in_getmem_list(p)) then
-            runerror(204);
-          if pheap_mem_info(p)^.sig=$AAAAAAAA then
-            dump_free(p);
-          if pheap_mem_info(p)^.next<>nil then
-            pheap_mem_info(p)^.next^.previous:=pheap_mem_info(p)^.previous;
-          if pheap_mem_info(p)^.previous<>nil then
-            pheap_mem_info(p)^.previous^.next:=pheap_mem_info(p)^.next;
-          if pheap_mem_info(p)=last_assigned then
-            last_assigned:=last_assigned^.previous;
-       end;
-{$endif CHECKHEAP}
-         { calc to multiple of 8 }
-       	size:=(size+7) and not 7;
-         _memavail:=_memavail+size;
-         if p+size>=heapptr then
-           heapptr:=p
-{$ifdef UseBlocks}
-         { insert into cache }
-         else if size<=max_size then
-           begin
-              s:=size div 8;
-              ppointer(p)^:=blocks^[s];
-              blocks^[s]:=p;
-              inc(nblocks^[s]);
-           end
-{$endif UseBlocks}
-         else
-           begin
-              { size can be allways set }
-              pfreerecord(p)^.size:=size;
-
-              { if there is no free list }
-              if not assigned(freelist) then
-                begin
-                   { then generate one }
-                   freelist:=p;
-                   pfreerecord(p)^.next:=nil;
-{$ifdef CHECKHEAP}
-                   inc(freerecord_list_length);
-{$endif CHECKHEAP}
-                   goto freemem_exit;
-                end;
-              if p+size<freelist then
-                begin
-                pfreerecord(p)^.next:=freelist;
-                freelist:=p;
-{$ifdef CHECKHEAP}
-                inc(freerecord_list_length);
-{$endif CHECKHEAP}
-                goto freemem_exit;
-                end
-              else
-              if p+size=freelist then
-                begin
-                inc(pfreerecord(p)^.size,pfreerecord(freelist)^.size);
-                pfreerecord(p)^.next:=pfreerecord(freelist)^.next;
-                freelist:=p;
-                { but now it can also connect the next block !!}
-                if p+pfreerecord(p)^.size=pfreerecord(p)^.next then
-                  begin
-                     inc(pfreerecord(p)^.size,pfreerecord(p)^.next^.size);
-{$ifdef CHECKHEAP}
-                     dec(freerecord_list_length);
-{$endif CHECKHEAP}
-                     pfreerecord(p)^.next:=pfreerecord(freelist)^.next^.next;
-                  end;
-                goto freemem_exit;
-                end;
-              { search the insert position }
-              hp:=freelist;
-              while assigned(hp) do
-                begin
-                   if p<hp+hp^.size then
-                      begin
-                      writeln('pointer to dispose at ',hexstr(longint(p),8),
-                        ' has already been disposed');
-                      runerror(204);
-                      end;
-                   { connecting two blocks ? }
-                   if hp+hp^.size=p then
-                      begin
-                         inc(hp^.size,size);
-                         { connecting also to next block ? }
-                         if hp+hp^.size=hp^.next then
-                           begin
-                              inc(hp^.size,hp^.next^.size);
-{$ifdef CHECKHEAP}
-                              dec(freerecord_list_length);
-{$endif CHECKHEAP}
-                              hp^.next:=hp^.next^.next;
-                           end
-                         else
-                         if (hp^.next<>nil) and (hp+hp^.size>hp^.next) then
-                           begin
-                              writeln('pointer to dispose at ',hexstr(longint(p),8),
-                                ' is too big !!');
-                              runerror(204);
-                            end;
-                         break;
-                      end
-                   { if the end is reached, then concat }
-                   else if hp^.next=nil then
-                     begin
-                        hp^.next:=p;
-{$ifdef CHECKHEAP}
-                        inc(freerecord_list_length);
-{$endif CHECKHEAP}
-                        pfreerecord(p)^.next:=nil;
-                        break;
-                     end
-                   { falls der n„chste Zeiger gr”áer ist, dann }
-                   { Einh„ngen                                 }
-                   else if hp^.next>p then
-                     begin
-                        { connect to blocks }
-                        if p+size=hp^.next then
-                          begin
-                             pfreerecord(p)^.next:=hp^.next^.next;
-                             inc(pfreerecord(p)^.size,hp^.next^.size);
-                             { we have to reset the right position }
-                             hp^.next:=pfreerecord(p);
-                          end
-                        else
-                          begin
-                             pfreerecord(p)^.next:=hp^.next;
-                             hp^.next:=p;
-{$ifdef CHECKHEAP}
-                             inc(freerecord_list_length);
-{$endif CHECKHEAP}
-                          end;
-                        break;
-                     end;
-                   hp:=hp^.next;
-                end;
-           end;
-         freemem_exit:
-{$ifdef CHECKHEAP}
-         inc(freemem_nb);
-         test_memavail;
-{$endif CHECKHEAP}
-         p:=nil;
-{$ifdef TEMPHEAP}
-         if heap_switched then switch_heap;
-{$endif TEMPHEAP}
-      end;
-
-    procedure release(var p : pointer);
-
-      begin
-         heapptr:=p;
-         freelist:=nil;
-         _memavail:=cal_memavail;
-      end;
-
-    procedure mark(var p : pointer);
-
-      begin
-         p:=heapptr;
-      end;
-
-    procedure markheap(var oldfreelist,oldheapptr : pointer);
-
-      begin
-         oldheapptr:=heapptr;
-         oldfreelist:=freelist;
-         freelist:=nil;
-         _memavail:=cal_memavail;
-      end;
-
-    procedure releaseheap(oldfreelist,oldheapptr : pointer);
-
-      begin
-         heapptr:=oldheapptr;
-         if longint(freelist) < longint(heapptr) then
-           begin
-           {here we should reget the freed blocks}
-           end;
-         freelist:=oldfreelist;
-         _memavail:=cal_memavail;
-      end;
-
-{ the sbrk  function is moved to the system.pp }
-{ as it is system dependent !!                 }
-function growheap(size :longint) : integer;
-
-  var NewPos,wantedsize : longint;
-         hp : pfreerecord;
-    Newlimit : longint;
-
-begin
-   wantedsize:=size;
-   size:=size+$ffff;
-   size:=size and $ffff0000;
-   { Allocate by 64K size }
-   { first try 1Meg }
-   if Size<$100000 then
-     begin
-        NewPos:=Sbrk($100000);
-        if NewPos > 0 then
-          Size:=$100000;
-     end
-   else
-     NewPos:=Sbrk(size);
-   if NewPos=-1 then
-     NewPos:=Sbrk(size);
-   if (NewPos = -1) then
-     begin
-        GrowHeap:=0;
-        {$IfDef CHECKHEAP}
-        writeln('Call to GrowHeap failed');
-        readln;
-        {$EndIf CHECKHEAP}
-        Exit;
-     end
-   else
-     begin
-     { make the room clean }
-{$ifdef CHECKHEAP}
-        Fillword(pointer(NewPos)^,size div 2,$ABCD);
-        Newlimit:= (newpos+size) or $3fff;
-{$else }
-        Fillchar(pointer(NewPos)^,size,#0);
-{$endif }
-        hp:=pfreerecord(freelist);
-        if not assigned(hp) then
-          begin
-          if pointer(newpos) = heapend then
-            heapend:=pointer(newpos+size)
-          else
-            begin
-               if heapend - heapptr > 0 then
-                 begin
-                    freelist:=heapptr;
-                    hp:=pfreerecord(freelist);
-                    hp^.size:=heapend-heapptr;
-                    hp^.next:=nil;
-                 end;
-               heapptr:=pointer(newpos);
-               heapend:=pointer(newpos+size);
-            end;
-          end
-        else
-          begin
-             if pointer(newpos) = heapend then
-               heapend:=pointer(newpos+size)
-             else
-               begin
-                  while assigned(hp^.next) and (longint(hp^.next) < longint(NewPos)) do
-                    hp:=hp^.next;
-                  if hp^.next = nil then
-                    begin
-                       hp^.next:=pfreerecord(heapptr);
-                       hp:=pfreerecord(heapptr);
-                       hp^.size:=heapend-heapptr;
-                       hp^.next:=nil;
-                       heapptr:=pointer(NewPos);
-                       heapend:=pointer(NewPos+Size);
-                    end
-                  else
-	            begin
-                       pfreerecord(NewPos)^.Size:=Size;
-                       pfreerecord(NewPos)^.Next:=hp^.next;
-                       hp^.next:=pfreerecord(NewPos);
-                    end;
-               end;
-          end;
-        { the wanted size has to be substracted
-          why it will be substracted in the second try
-          to get the memory PM }
-		  _memavail:=cal_memavail;
-        { set the total new heap size }
-        asm
-          move.l Size,d0
-          move.l HEAP_SIZE,d1
-          add.l  d0,d1
-          move.l d1,HEAP_SIZE
-        end;
-        GrowHeap:=2;{ try again }
-        _internal_heapsize:=size+_internal_heapsize;
-{$IfDef CHECKHEAP}
-        writeln('Call to GrowHeap succedeed : HeapSize = ',_internal_heapsize,' MemAvail = ',memavail);
-        writeln('New heap part begins at ',Newpos,' with size ',size);
-        if growheapstop then
-          readln;
-{$EndIf CHECKHEAP}
-        exit;
-     end;
-end;
-
-
-{ This function will initialize the Heap manager and need to be called from
-  the initialization of the system unit }
-procedure InitHeap;
-{$ifdef UseBlocks}
-var
-  i : longint;
-{$endif UseBlocks}  
-begin
-{$ifdef UseBlocks}
-  Blocks:=@baseblocks;
-  Nblocks:=@basenblocks;
-  for i:=1 to maxblock do
-   begin
-     Blocks^[i]:=nil;
-     Nblocks^[i]:=0;
-   end;
-{$endif UseBlocks}
-  Curheap := @baseheap;
-{$ifdef TEMPHEAP}
-  Otherheap := @tempheap;
-{$endif TEMPHEAP}
-  HeapOrg := GetHeapStart;
-  HeapPtr := HeapOrg;
-  _memavail := GetHeapSize;
-  HeapEnd := HeapOrg + _memavail;
-  HeapError := @GrowHeap;
-  _internal_heapsize:=longint(heapend)-longint(heaporg);
-  Freelist := nil;
-end;
-
-{
-  $Log$
-  Revision 1.8  1998-09-04 17:27:09  pierre
-    * small modifications
-
-  Revision 1.7  1998/08/25 14:15:53  pierre
-    * corrected a bug introduced by my last change
-      (allocating 1Mb but only using a small part !!)
-
-  Revision 1.6  1998/08/24 14:44:05  pierre
-    * bug allocation of more than 1 MB failed corrected
-
-  Revision 1.5  1998/08/17 12:27:17  carl
-    * bugfix of heaperror, was pushing wrong parameter
-
-  Revision 1.4  1998/07/08 11:54:40  carl
-    + reinstated hepasize function
-    * renamed HEAPSIZE global var to HEAP_SIZE to remove conflicts
-
-  Revision 1.3  1998/07/02 14:24:08  michael
-  Undid carls changes, but renamed _heapsize to _internal_heapsize. Make cycle now works
-
-  Revision 1.2  1998/07/02 12:22:38  carl
-    - removed heapsize function, would cause conflicts with HEAPSIZE var
-    * GetHeapstart was misplaced
-
-  Revision 1.1.1.1  1998/03/25 11:18:44  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 12:01:52  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/m68k/heap.inc
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1998/01/05 16:51:24;  author: michael;  state: Exp;  lines: +31 -1
-  + Moved init of heap to heap.inc: INITheap() (From Peter Vreman)
-  ----------------------------
-  revision 1.1
-  date: 1998/01/05 00:32:44;  author: carl;  state: Exp;
-  + First Version of m68k heap handler (handles amiga/macos/atari)
-  =============================================================================
-}

+ 48 - 210
rtl/m68k/m68k.inc

@@ -31,7 +31,7 @@
 
 
 
 
     { Don't call the following routines directly. }
     { Don't call the following routines directly. }
- Procedure Hlt;[public,alias: 'HALT_ERROR'];
+ Procedure Hlt;[public,alias: 'FPC_HALT_ERROR'];
  { called by code generator on run-time errors. }
  { called by code generator on run-time errors. }
  { on entry contains d0 = error code.           }
  { on entry contains d0 = error code.           }
  var
  var
@@ -98,11 +98,10 @@
      end ['d0','d1','a0'];
      end ['d0','d1','a0'];
    end;
    end;
 
 
-    procedure int_help_constructor;
+    procedure int_help_constructor;[public,alias:'FPC_HELP_CONSTRUCTOR'];
 
 
       begin
       begin
          asm
          asm
-          XDEF HELP_CONSTRUCTOR
             { Entry without preamble, since we need the ESP of the
             { Entry without preamble, since we need the ESP of the
               constructor }
               constructor }
             { Stack (relative to %ebp):
             { Stack (relative to %ebp):
@@ -178,7 +177,7 @@
          end;
          end;
       end;
       end;
 
 
-    procedure int_help_destructor;
+    procedure int_help_destructor;[public,alias:'FPC_HELP_DESTRUCTOR'];
 
 
       begin
       begin
          asm
          asm
@@ -189,7 +188,6 @@
                 0 %ebp
                 0 %ebp
             }
             }
             { temporary Variable }
             { temporary Variable }
-          XDEF HELP_DESTRUCTOR
             subq.l #4,sp
             subq.l #4,sp
             move.l sp,d6
             move.l sp,d6
             { Save Registers }
             { Save Registers }
@@ -222,10 +220,9 @@
          end;
          end;
       end;
       end;
 
 
-  procedure new_class;assembler;
+  procedure new_class;assembler;[public,alias:'FPC_NEW_CLASS'];
 
 
   asm
   asm
-     XDEF NEW_CLASS
      { create class ? }
      { create class ? }
      move.l 8(a6), d0
      move.l 8(a6), d0
      tst.l  d0
      tst.l  d0
@@ -249,10 +246,9 @@
 
 
 
 
 
 
-  procedure dispose_class;assembler;
+  procedure dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS'];
 
 
   asm
   asm
-    XDEF DISPOSE_CLASS
      { destroy class ? }
      { destroy class ? }
      move.l 8(a6),d0
      move.l 8(a6),d0
      { save self }
      { save self }
@@ -272,12 +268,11 @@
   end;
   end;
 
 
   { checks for a correct vmt pointer }
   { checks for a correct vmt pointer }
-  procedure co;assembler;
+  procedure int_check_object;assembler;[public,alias:'FPC_CHECK_OBJECT'];
   { ON ENTRY: a0 -> Pointer to the VMT                  }
   { ON ENTRY: a0 -> Pointer to the VMT                  }
   {   Nota: All registers must be preserved including   }
   {   Nota: All registers must be preserved including   }
   {   A0 itself!                                        }
   {   A0 itself!                                        }
   asm
   asm
-   XDEF CHECK_OBJECT
      move.l   d0,-(sp)
      move.l   d0,-(sp)
      tst.l    a0
      tst.l    a0
      { z flag set if zero }
      { z flag set if zero }
@@ -296,8 +291,13 @@
   end;
   end;
 
 
 
 
+    function get_frame : longint; assembler;
+      asm
+              move.l a6,d0
+      end;
+
 
 
-    function get_addr(BP : longint) : longint;
+    function get_caller_addr(BP : longint) : longint;
       begin
       begin
          asm
          asm
             move.l BP,a0
             move.l BP,a0
@@ -309,7 +309,7 @@
          end ['a0'];
          end ['a0'];
       end;
       end;
 
 
-    function get_next_frame(bp : longint) : longint;
+    function get_caller_frame(bp : longint) : longint;
 
 
       begin
       begin
          asm
          asm
@@ -322,113 +322,8 @@
          end ['a0'];
          end ['a0'];
       end;
       end;
 
 
-Procedure HandleError (Errno : longint);[alias : 'handleerror'];
-{
-  Procedure to handle internal errors, i.e. not user-invoked errors
-  Internal function should ALWAYS call HandleError instead of RunError.
-}
-      function get_addr : pointer;
-
-        begin
-           asm
-              move.l (a6),a0
-              move.l 4(a0),a0
-              move.l a0,@RESULT
-           end ['a0'];
-        end;
-      function get_error_bp : longint;
-
-        begin
-           asm
-              { get base pointer of error }
-              move.l (a6),d0
-              move.l d0,@RESULT
-           end ['d0'];
-        end;
-
-begin
-  If ErrorProc<>Nil then
-    TErrorProc (ErrorProc)(Errno,get_addr);
-  errorcode:=Errno;
-  exitcode:=Errno;
-  erroraddr:=Get_addr;
-  DoError := TRUE;
-  errorbase:=get_error_bp;
-  halt(errorcode);
-end;
-
-
-    procedure runerror(w : word);
-
-      function get_addr : longint;
-
-        begin
-           asm
-              move.l (a6),a0
-              move.l 4(a0),a0
-              move.l a0,@RESULT
-           end ['a0'];
-        end;
-
-      function get_error_bp : longint;
-
-        begin
-           asm
-              { get base pointer of error }
-              move.l (a6),d0
-              move.l d0,@RESULT
-           end ['d0'];
-        end;
-
-      begin
-         errorcode:=w;
-         exitcode:=w;
-         erroraddr:=pointer(get_addr);
-         DoError:=True;
-         ErrorBase:=get_error_bp;
-         halt(byte(errorcode));
-      end;
-
-    procedure io1(addr : longint);[public,alias: 'IOCHECK'];
-
-      var
-         l : longint;
-
-      begin
-         { Since IOCHECK is called directly and only later the optimiser }
-         { Maybe also save global registers  }
-         asm
-            movem.l d0-a7,-(sp)
-         end;
-         l:=ioresult;
-         if l<>0 then
-           begin
-              writeln('IO-Error ',l,' at 0x',HexStr(addr,8));
-              halt(byte(l));
-           end;
-         asm
-            { the register are put back in the correct order }
-            movem.l (sp)+,d0-a7
-         end;
-      end;
-
-    procedure re_overflow;[public,alias: 'RE_OVERFLOW'];
-
-      var
-         addr : longint;
-
-      begin
-         { Overflow was shortly before the return address }
-         asm
-            move.l 4(a6),d0
-            move.l d0,addr
-         end;
-         writeln('Overflow at 0x',HexStr(addr,8));
-         HandleError(215);
-      end;
-
 {    procedure strcopy(dstr,sstr : pointer;len : longint);[public,alias: 'STRCOPY'];}
 {    procedure strcopy(dstr,sstr : pointer;len : longint);[public,alias: 'STRCOPY'];}
-     procedure strcopy; assembler;
+     procedure strcopy; assembler;[public,alias: 'FPC_STRCOPY'];
     {---------------------------------------------------}
     {---------------------------------------------------}
     { Low-level routine to copy a string to another     }
     { Low-level routine to copy a string to another     }
     { string with maximum length. Never call directly!  }
     { string with maximum length. Never call directly!  }
@@ -439,7 +334,6 @@ end;
     { registers destroyed: a0,a1,d0,d1                  }
     { registers destroyed: a0,a1,d0,d1                  }
     {---------------------------------------------------}
     {---------------------------------------------------}
          asm
          asm
-           XDEF STRCOPY
 {            move.l 12(a6),a0
 {            move.l 12(a6),a0
             move.l 16(a6),a1
             move.l 16(a6),a1
             move.l 8(a6),d1 }
             move.l 8(a6),d1 }
@@ -512,10 +406,8 @@ end;
     {   ALL FLAGS are set appropriately.                    }
     {   ALL FLAGS are set appropriately.                    }
     {    ZF = strings are equal                             }
     {    ZF = strings are equal                             }
     { REGISTERS DESTROYED: a0, a1, d0, d1, d6               }
     { REGISTERS DESTROYED: a0, a1, d0, d1, d6               }
-    procedure strcmp; assembler;
+    procedure strcmp; assembler;[public,alias:'FPC_STRCMP'];
      asm
      asm
-     XDEF STRCMP
-
             move.b (a0)+,d0     { Get length of first string  }
             move.b (a0)+,d0     { Get length of first string  }
             move.b (a1)+,d6     { Get length of 2nd string    }
             move.b (a1)+,d6     { Get length of 2nd string    }
 
 
@@ -722,22 +614,6 @@ end;
       end;
       end;
 
 
 
 
-{$IFNDEF NEW_READWRITE}
-    procedure f1;[public,alias: 'FLUSH_STDOUT'];
-
-      begin
-         asm
-            { Save Registers }
-            movem.l d0-a7,-(sp)
-         end;
-         FileFunc(textrec(output).flushfunc)(textrec(output));
-         asm
-            { Restore all registers in the correct order }
-            movem.l (sp)+,d0-a7
-         end;
-      end;
-{$ENDIF NEW_READWRITE}
-
 Function Sptr : Longint;
 Function Sptr : Longint;
 begin
 begin
   asm
   asm
@@ -750,7 +626,7 @@ end;
 
 
 
 
 
 
- Procedure BoundsCheck;assembler;
+ Procedure BoundsCheck;assembler;[public,alias:'FPC_RE_BOUNDS_CHECK'];
  { called by code generator with R+ state to    }
  { called by code generator with R+ state to    }
  { determine if a range check occured.          }
  { determine if a range check occured.          }
  { Only in 68000 mode, in 68020 mode this is    }
  { Only in 68000 mode, in 68020 mode this is    }
@@ -759,7 +635,6 @@ end;
  {   A1 = address contaning min and max indexes }
  {   A1 = address contaning min and max indexes }
  {   D0 = value of current index to check.      }
  {   D0 = value of current index to check.      }
  asm
  asm
-XDEF RE_BOUNDS_CHECK
   cmp.l   (A1),D0        { lower bound ...    }
   cmp.l   (A1),D0        { lower bound ...    }
   bmi     @rebounderr    { is index lower ... }
   bmi     @rebounderr    { is index lower ... }
   add.l   #4,A1
   add.l   #4,A1
@@ -772,9 +647,40 @@ XDEF RE_BOUNDS_CHECK
 @reboundend:
 @reboundend:
  end;
  end;
 
 
+{****************************************************************************
+                                 IoCheck
+****************************************************************************}
+
+procedure int_iocheck(addr : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'IOCHECK'];
+var
+  l : longint;
+begin
+  asm
+        movem.l d0-a7,-(sp)
+  end;
+  if InOutRes<>0 then
+   begin
+     l:=InOutRes;
+     InOutRes:=0;
+     If ErrorProc<>Nil then
+       TErrorProc(Errorproc)(l,pointer(addr));
+{$ifndef RTLLITE}
+     writeln('IO-Error ',l,' at 0x',HexStr(addr,8));
+{$endif}
+     Halt(byte(l));
+   end;
+  asm
+        movem.l (sp)+,d0-a7
+  end;
+end;
+
 {
 {
   $Log$
   $Log$
-  Revision 1.10  1998-08-17 12:26:04  carl
+  Revision 1.11  1998-09-14 10:48:29  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.10  1998/08/17 12:26:04  carl
     + simple cleanup of comments
     + simple cleanup of comments
 
 
   Revision 1.9  1998/07/30 13:26:14  michael
   Revision 1.9  1998/07/30 13:26:14  michael
@@ -793,72 +699,4 @@ XDEF RE_BOUNDS_CHECK
     * strcopy bugfix was using signed comparison
     * strcopy bugfix was using signed comparison
     + STRCOPY uses register calling conventions
     + STRCOPY uses register calling conventions
     * FillChar bugfix was loading a word instead of a byte
     * FillChar bugfix was loading a word instead of a byte
-
-  Revision 1.2  1998/03/27 23:48:06  carl
-    * bugfix of STRCONCAT alignment problem
-
-  Revision 1.18  1998/03/02 04:17:24  carl
-    * problem with CHECK_OBJECT fixed, will probably only work with
-      GNU tools, as the VMT pointer is an .lcomm and might not be
-      zeroed automatically by other loaders.
-    * CHECK_OBJECT was not jumping on right condition
-
-  Revision 1.17  1998/02/23 02:26:06  carl
-    * bugfix to make it link without problems
-
-  Revision 1.13  1998/02/06 16:35:35  carl
-    * oops commited wrong file
-
-  Revision 1.11  1998/01/26 12:01:32  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/m68k/m68k.inc
-  description:
-  ----------------------------
-  revision 1.10
-  date: 1998/01/19 10:21:36;  author: michael;  state: Exp;  lines: +1 -12
-  * moved Fillchar t(..,char) to system.inc
-  ----------------------------
-  revision 1.9
-  date: 1998/01/13 03:47:39;  author: carl;  state: Exp;  lines: +3 -3
-    * bugfix of BoundsCheck invalid opcodes
-  ----------------------------
-  revision 1.8
-  date: 1998/01/13 03:24:58;  author: carl;  state: Exp;  lines: +2 -2
-    * moveq.l #201 bugfix (This is of course an impossible opcode)
-  ----------------------------
-  revision 1.7
-  date: 1998/01/12 15:24:47;  author: carl;  state: Exp;  lines: +1 -20
-    * bugfix, a function was being duplicated.
-  ----------------------------
-  revision 1.6
-  date: 1998/01/12 03:40:11;  author: carl;  state: Exp;  lines: +2 -2
-    * bugfix of RE_OVERFLOW, now gives out a runerror(215)
-  ----------------------------
-  revision 1.5
-  date: 1998/01/05 00:31:43;  author: carl;  state: Exp;  lines: +206 -119
-  * Bugfix of syntax errors
-  ----------------------------
-  revision 1.4
-  date: 1998/01/01 16:50:16;  author: michael;  state: Exp;  lines: +1 -21
-  - Moved Do_exit to system.inc. Now processor independent.
-  ----------------------------
-  revision 1.3
-  date: 1997/12/10 12:15:05;  author: michael;  state: Exp;  lines: +2 -2
-  * changed dateifunc to FileFunc.
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:37:21;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:48;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:48;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }
 }

+ 1 - 1
rtl/m68k/makefile.cpu

@@ -2,6 +2,6 @@
 # Here we set processor dependent include file names.
 # Here we set processor dependent include file names.
 #
 #
 
 
-CPUNAMES=m68k heap lowmath math set 
+CPUNAMES=m68k lowmath math set 
 CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
 CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
 
 

+ 6 - 1
rtl/os2/sysos2.pas

@@ -243,7 +243,12 @@ function getheapstart:pointer;assembler;
 asm
 asm
     movl __heap_base,%eax
     movl __heap_base,%eax
 end ['EAX'];
 end ['EAX'];
-{$ASMMODE att}
+
+function getheapsize:longint;assembler;
+asm
+    movl    HEAPSIZE,%eax
+end ['EAX'];
+{$ASMMODE ATT}
 
 
 {$i heap.inc}
 {$i heap.inc}
 
 

+ 29 - 41
rtl/win32/syswin32.pp

@@ -19,19 +19,15 @@ unit syswin32;
 
 
 {$I os.inc}
 {$I os.inc}
 
 
-{.$DEFINE WINHEAP}   { Use windows heap manager, if not set use FPC heap }
-
-
 interface
 interface
 
 
 { include system-independent routine headers }
 { include system-independent routine headers }
 
 
 {$I systemh.inc}
 {$I systemh.inc}
 
 
-{$ifndef WinHeap}
-  { include heap support headers }
-  {$I heaph.inc}
-{$endif}
+{ include heap support headers }
+{$I heaph.inc}
+
 
 
 const
 const
 { Default filehandles }
 { Default filehandles }
@@ -72,15 +68,9 @@ var
   hinstance,
   hinstance,
   cmdshow     : longint;
   cmdshow     : longint;
 
 
-{$ifdef WinHeap}
-var
-  heaperror  : pointer;
-
-function HeapSize:longint;
-{$endif}
-
 implementation
 implementation
 
 
+
 { include system independent routines }
 { include system independent routines }
 {$I system.inc}
 {$I system.inc}
 
 
@@ -234,33 +224,29 @@ end;
                               Heap Management
                               Heap Management
 *****************************************************************************}
 *****************************************************************************}
 
 
-{$ifdef WinHeap}
-
-  {$i winheap.inc}
-
-{$else}
-
    { memory functions }
    { memory functions }
    function GlobalAlloc(mode,size:longint):longint;
    function GlobalAlloc(mode,size:longint):longint;
      external 'kernel32' name 'GlobalAlloc';
      external 'kernel32' name 'GlobalAlloc';
-   function GlobalReAlloc(mode,size:longint):longint;
-     external 'kernel32' name 'GlobalReAlloc';
-   function GlobalHandle(p:pointer):longint;
-     external 'kernel32' name 'GlobalHandle';
    function GlobalLock(handle:longint):pointer;
    function GlobalLock(handle:longint):pointer;
      external 'kernel32' name 'GlobalLock';
      external 'kernel32' name 'GlobalLock';
-   function GlobalUnlock(h:longint):longint;
-     external 'kernel32' name 'GlobalUnlock';
-   function GlobalFree(h:longint):longint;
-     external 'kernel32' name 'GlobalFree';
+{$ifdef SYSTEMDEBUG}
    function GlobalSize(h:longint):longint;
    function GlobalSize(h:longint):longint;
      external 'kernel32' name 'GlobalSize';
      external 'kernel32' name 'GlobalSize';
-   procedure GlobalMemoryStatus(p:pointer);
-     external 'kernel32' name 'GlobalMemoryStatus';
-   function LocalAlloc(uFlags : UINT;uBytes :UINT) : HLOCAL;
-     external 'kernel32' name 'LocalAlloc';
-   function LocalFree(hMem:HLOCAL):HLOCAL;
-     external 'kernel32' name 'LocalFree';
+{$endif}
+
+{$ASMMODE DIRECT}
+function getheapstart:pointer;assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+
+
+function getheapsize:longint;assembler;
+asm
+        movl    HEAPSIZE,%eax
+end ['EAX'];
+{$ASMMODE ATT}
+
 
 
 function Sbrk(size : longint):longint;
 function Sbrk(size : longint):longint;
 var
 var
@@ -268,17 +254,17 @@ var
 begin
 begin
   h:=GlobalAlloc(258,size);
   h:=GlobalAlloc(258,size);
   l:=longint(GlobalLock(h));
   l:=longint(GlobalLock(h));
-  if l=0 then l:=-1;
+  if l=0 then
+    l:=-1;
+{$ifdef SYSTEMDEBUG}
   Writeln('new heap part at $',hexstr(l,8), ' size = ',GlobalSize(h));
   Writeln('new heap part at $',hexstr(l,8), ' size = ',GlobalSize(h));
+{$endif}
   sbrk:=l;
   sbrk:=l;
 end;
 end;
 
 
 { include standard heap management }
 { include standard heap management }
 {$I heap.inc}
 {$I heap.inc}
 
 
-{$endif WinHeap}
-
-
 {*****************************************************************************
 {*****************************************************************************
                           Low Level File Routines
                           Low Level File Routines
 *****************************************************************************}
 *****************************************************************************}
@@ -742,9 +728,7 @@ begin
 { real test stack depth        }
 { real test stack depth        }
 {   stacklimit := setupstack;  }
 {   stacklimit := setupstack;  }
 { Setup heap }
 { Setup heap }
-{$ifndef WinHeap}
   InitHeap;
   InitHeap;
-{$endif WinHeap}
 { Setup stdin, stdout and stderr }
 { Setup stdin, stdout and stderr }
   StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));
   StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));
   StdOutputHandle:=longint(GetStdHandle(STD_OUTPUT_HANDLE));
   StdOutputHandle:=longint(GetStdHandle(STD_OUTPUT_HANDLE));
@@ -762,7 +746,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.19  1998-09-02 09:03:46  pierre
+  Revision 1.20  1998-09-14 10:48:33  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.19  1998/09/02 09:03:46  pierre
     * do_open sometimes returns -1 as handle on fail
     * do_open sometimes returns -1 as handle on fail
       was not checked correctly
       was not checked correctly