* FPC_ names

  * Heap manager is now system independent

rtl/amiga/sysamiga.pas

@@ -885,6 +885,18 @@ const
          randseed:=time.ds_tick;
       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.  }
   { But here we do a trick, we say that the }
   { heap cannot be regrown!                 }
@@ -1645,15 +1657,15 @@ end;
              path:=path+':';
           end;
 
-	       len := len + elen;
+               len := len + elen;
 
-	       UnLock(lock);
-	       lock := newlock;
+               UnLock(lock);
+               lock := newlock;
     end;
     if (lock <> 0) then
     Begin
-	    UnLock(lock);
-	    path := '';
+            UnLock(lock);
+            path := '';
     end;
     if assigned(fib) then dispose(fib);
  end;
@@ -1800,7 +1812,11 @@ end.
 
 {
   $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
     + added ctrl-c checking
     + implemented sbrk

rtl/atari/sysatari.pas

@@ -36,7 +36,7 @@ unit sysatari;
     {$I heaph.inc}
 
 const
-  UnusedHandle    = $ffff; 
+  UnusedHandle    = $ffff;
   StdInputHandle  = 0;
   StdOutputHandle = 1;
   StdErrorHandle  = $ffff;
@@ -234,6 +234,18 @@ const
          randseed:=hl;
       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.  }
   { But here we do a trick, we say that the }
   { heap cannot be regrown!                 }
@@ -697,7 +709,7 @@ end;
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
-      
+
 
 begin
 { Initialize ExitProc }
@@ -719,7 +731,11 @@ end.
 
 {
   $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! :(...
 
   Revision 1.5  1998/07/13 12:34:13  carl

rtl/dos/go32v1/system.pp

@@ -98,7 +98,7 @@ implementation
 {$I system.inc}
 
 {$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
 { called when trying to get local stack
   if the compiler directive $S is set
@@ -183,6 +183,18 @@ end;
                               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;
 asm
         movl    size,%ebx
@@ -458,11 +470,11 @@ asm
         popl    %ebp
         jnc     .LDOSDEVICE
         movw    %ax,inoutres
-	     xorl	%edx,%edx
+             xorl       %edx,%edx
   .LDOSDEVICE:
-        movl	%edx,%eax
-	     shrl	$7,%eax
-        andl	$1,%eax
+        movl    %edx,%eax
+             shrl       $7,%eax
+        andl    $1,%eax
 end;
 
 
@@ -597,7 +609,11 @@ Begin
 End.
 {
   $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
 
   Revision 1.7  1998/07/07 12:30:20  carl

rtl/dos/go32v2/system.pp

@@ -29,7 +29,7 @@ interface
 
 const
 { Default filehandles }
-  UnusedHandle    = $ffff;
+  UnusedHandle    = -1;
   StdInputHandle  = 0;
   StdOutputHandle = 1;
   StdErrorHandle  = 2;
@@ -134,7 +134,6 @@ var
 procedure halt(errnum : byte);
 begin
   do_exit;
-  flush(stderr);
   asm
         movzbw  errnum,%ax
         pushw   %ax
@@ -143,7 +142,7 @@ begin
 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
   is set this function must preserve esi !!!! because esi is set by
@@ -563,6 +562,18 @@ end;
 
 {$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;
 asm
         movl    size,%eax
@@ -1106,7 +1117,11 @@ Begin
 End.
 {
   $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
     * updated checklfn from mailinglist
 

rtl/i386/cpu.pp

@@ -5,7 +5,7 @@
 
     This unit contains some routines to get informations about the
     processor
-    
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -29,12 +29,8 @@ unit cpu;
 
   implementation
 
-{$ifdef VER0_99_5}
-  {$I386_INTEL}
-{$endif}
-
 {$ASMMODE INTEL}
-  
+
 
     function cpuid_support : boolean;assembler;
       {
@@ -64,7 +60,7 @@ unit cpu;
          DB 0Fh,20h,0C0h
          { mov eax,cr0
            special registers are not allowed in the assembler
-  	        parsers }
+                parsers }
       end;
 
 
@@ -79,7 +75,11 @@ end.
 
 {
   $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
 
   Revision 1.3  1998/05/25 10:51:27  pierre

rtl/i386/i386.inc

@@ -89,7 +89,7 @@ begin
 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
         asm
         cld
@@ -151,7 +151,7 @@ end;
 
 {$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
 { Entry without preamble, since we need the ESP of the constructor
   Stack (relative to %ebp):
@@ -173,7 +173,11 @@ asm
       { Memory size }
         pushl   (%eax)
         pushl   %esi
+{$ifdef FPCNAMES}
+        call    FPC_GETMEM
+{$else}
         call    GETMEM
+{$endif}
         popal
       { Memory size to %esi }
         movl    (%esi),%esi
@@ -197,7 +201,7 @@ asm
         pushw   $0
         pushl   (%eax)
         pushl   %esi
-        call    FILL_OBJECT
+        call    FPC_FILL_OBJECT
         popal
       { set the VMT address for the new created object }
         movl    %eax,(%esi)
@@ -211,7 +215,7 @@ asm
 end;
 
 
-procedure int_new_class;assembler;[public,alias:'NEW_CLASS'];
+procedure int_new_class;assembler;[public,alias:'FPC_NEW_CLASS'];
 asm
      { create class ? }
      movl 8(%ebp),%edi
@@ -232,7 +236,7 @@ asm
 end;
 
 
-procedure int_dispose_class;assembler;[public,alias:'DISPOSE_CLASS'];
+procedure int_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS'];
 asm
      { destroy class ? }
      movl 8(%ebp),%edi
@@ -253,7 +257,7 @@ end;
 
 
 { 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
      pushl %edi
      movl 8(%esp),%edi
@@ -273,11 +277,11 @@ asm
      ret $4
 .Lco_re:
      pushl $210
-     call handleerror
+     call FPC_HANDLEERROR
 end;
 
 
-procedure int_help_destructor;assembler;[public,alias:'HELP_DESTRUCTOR'];
+procedure int_help_destructor;assembler;[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'HELP_DESTRUCTOR'];
 asm
 { Stack (relative to %ebp):
     12 Self
@@ -305,7 +309,11 @@ asm
         movl    $0,(%eax)
         movl    %eax,(%edi)
         pushl   %edi
+{$ifdef FPCNAMES}
+        call    FPC_FREEMEM
+{$else}
         call    FREEMEM
+{$endif}
 .LHD_3:
         popal
         addl    $4,%esp
@@ -318,7 +326,7 @@ end;
                                  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 !!!
 }
@@ -360,7 +368,7 @@ begin
 end;
 
 
-procedure strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
+procedure strconcat(s1,s2 : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STRCONCAT'];
 begin
   asm
         xorl    %ecx,%ecx
@@ -399,7 +407,7 @@ begin
 end;
 
 
-procedure strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
+procedure strcmp(dstr,sstr : pointer);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STRCMP'];
 begin
   asm
         cld
@@ -499,13 +507,20 @@ asm
         subl    %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
-        movl    addrbp,%eax
+        movl    framebp,%eax
         orl     %eax,%eax
         jz      .Lg_a_null
         movl    4(%eax),%eax
@@ -513,7 +528,7 @@ asm
 end ['EAX'];
 
 
-function get_next_frame(framebp:longint):longint;assembler;
+function get_caller_frame(framebp:longint):longint;assembler;
 asm
         movl    framebp,%eax
         orl     %eax,%eax
@@ -523,101 +538,9 @@ asm
 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}
 asm
@@ -644,6 +567,20 @@ asm
 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);
 
       var
@@ -719,40 +656,43 @@ end ['EAX'];
          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
   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;
 
 
-{$ifdef VER_0_99_5}
-  {$I386_DIRECT}
-{$endif}
-
-{$ASMMODE ATT}
 
 {
   $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
 
   Revision 1.19.2.1  1998/09/11 17:37:24  pierre

rtl/i386/makefile.cpu

@@ -2,6 +2,6 @@
 # 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))
 

rtl/i386/rttip.inc

@@ -16,352 +16,356 @@
 { Run-Time type information routines - processor dependent part }
 {$ASMMODE DIRECT}
 
-Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias : 'INITIALIZE'];assembler;
+Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];assembler;
 
 asm
 # Save registers
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # 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
-	decb	%al
+        decb    %al
         jz      .DoClassInit
-	jmp	.ExitInitialize
+        jmp     .ExitInitialize
 .DoObjectInit:
 .DoClassInit:
 .DoRecordInit:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
-        addl    $5,%eax 
-	addl	%eax,%ebx
+        addl    $5,%eax
+        addl    %eax,%ebx
 # %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
 .MyRecordInitLoop:
-	decl    %edx
-	jl	.ExitInitialize
+        decl    %edx
+        jl      .ExitInitialize
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
-	pushl    %eax
-	call	INITIALIZE
-	jmp     .MyRecordInitLoop
+        pushl    %eax
+        call    FPC_INITIALIZE
+        jmp     .MyRecordInitLoop
 # Array handling
 .DoArrayInit:
 # %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.
 # Start treating elements.
 .MyArrayInitLoop:
-	decl	%edx
-	jl	.ExitInitialize
+        decl    %edx
+        jl      .ExitInitialize
 # push type
         pushl   (%ebx)
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
-	pushl   %eax 
-	call	INITIALIZE
-	jmp	.MyArrayInitLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_INITIALIZE
+        jmp     .MyArrayInitLoop
+# AnsiString handling :
 .DoAnsiStringInit:
-	movl	$0,8(%ebp)
+        movl    $0,8(%ebp)
 .ExitInitialize:
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 
-Procedure Finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FINALIZE']; assembler;
+Procedure Finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE']; assembler;
 
 asm
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # 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
-	decb	%al
+        decb    %al
         jz      .DoClassFinal
-	jmp	.ExitFinalize
+        jmp     .ExitFinalize
 .DoClassFinal:
 .DoObjectFinal:
 .DoRecordFinal:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
         addl    $5,%eax
-	addl	%eax,%ebx
+        addl    %eax,%ebx
 # %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
 .MyRecordFinalLoop:
-	decl    %edx
-	jl	.ExitFinalize
+        decl    %edx
+        jl      .ExitFinalize
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
-	pushl    %eax
-	call	FINALIZE
-	jmp     .MyRecordFinalLoop
+        pushl    %eax
+        call    FPC_FINALIZE
+        jmp     .MyRecordFinalLoop
 # Array handling
 .DoArrayFinal:
 # %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.
 # Start treating elements.
 .MyArrayFinalLoop:
-	decl	%edx
-	jl	.ExitFinalize
+        decl    %edx
+        jl      .ExitFinalize
 # push type
         pushl   (%ebx)
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
-	pushl   %eax 
-	call	FINALIZE
-	jmp	.MyArrayFinalLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_FINALIZE
+        jmp     .MyArrayFinalLoop
+# AnsiString handling :
 .DoAnsiStringFinal:
-	movl	8(%ebp),%eax
-	pushl   %eax
-	call    DECR_ANSI_REF
+        movl    8(%ebp),%eax
+        pushl   %eax
+        call    FPC_DECR_ANSI_REF
 .ExitFinalize:
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 
-Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'ADDREF'];Assembler;
+Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler;
 
 asm
 # Save registers
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # 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
-	decb	%al
+        decb    %al
         jz      .DoClassAddRef
-	jmp	.ExitAddRef
+        jmp     .ExitAddRef
 .DoClassAddRef:
 .DoObjectAddRef:
 .DoRecordAddRef:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
         addl    $5,%eax
-	addl	%eax,%ebx
+        addl    %eax,%ebx
 # %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
 .MyRecordAddRefLoop:
-	decl    %edx
-	jl	.ExitAddRef
+        decl    %edx
+        jl      .ExitAddRef
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
-	pushl    %eax
-	call	ADDREF
-	jmp     .MyRecordAddRefLoop
+        pushl    %eax
+        call    FPC_ADDREF
+        jmp     .MyRecordAddRefLoop
 # Array handling
 .DoArrayAddRef:
 # %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.
 # Start treating elements.
 .MyArrayAddRefLoop:
-	decl	%edx
-	jl	.ExitAddRef
+        decl    %edx
+        jl      .ExitAddRef
 # push type
         pushl   (%ebx)
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
-	pushl   %eax 
-	call	ADDREF
-	jmp	.MyArrayAddRefLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_ADDREF
+        jmp     .MyArrayAddRefLoop
+# AnsiString handling :
 .DoAnsiStringAddRef:
-	movl	8(%ebp),%eax
-	pushl   %eax
-	call    INCR_ANSI_REF
+        movl    8(%ebp),%eax
+        pushl   %eax
+        call    FPC_INCR_ANSI_REF
 .ExitAddRef:
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 
-Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'DECREF'];Assembler;
+Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler;
 
 asm
 # Save registers
         push    %eax
-	push    %ebx
-	push    %ecx
-	push    %edx
+        push    %ebx
+        push    %ecx
+        push    %edx
 # 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
-	decb	%al
+        decb    %al
         jz      .DoClassDecRef
-        jmp	.ExitDecRef
+        jmp     .ExitDecRef
 .DoClassDecRef:
 .DoObjectDecRef:
 .DoRecordDecRef:
-	incl	%ebx
-	movzbl	(%ebx),%eax
+        incl    %ebx
+        movzbl  (%ebx),%eax
 # Skip also recordsize.
         addl    $5,%eax
-	addl	%eax,%ebx
+        addl    %eax,%ebx
 # %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
 .MyRecordDecRefLoop:
-	decl    %edx
-	jl	.ExitDecRef
+        decl    %edx
+        jl      .ExitDecRef
 # Calculate data
-	movl    8(%ebp),%eax	
-	addl    (%ebx),%eax
-	addl     $4,%ebx
+        movl    8(%ebp),%eax
+        addl    (%ebx),%eax
+        addl     $4,%ebx
 # Push type
-	pushl    (%ebx)
-	addl     $4,%ebx
+        pushl    (%ebx)
+        addl     $4,%ebx
 # push data
-	pushl    %eax
-	call	DECREF
-	jmp     .MyRecordDecRefLoop
+        pushl    %eax
+        call    FPC_DECREF
+        jmp     .MyRecordDecRefLoop
 # Array handling
 .DoArrayDecRef:
 # %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.
 # Start treating elements.
 .MyArrayDecRefLoop:
-	decl	%edx
-	jl	.ExitDecRef
+        decl    %edx
+        jl      .ExitDecRef
 # push type
         pushl   (%ebx)
 # calculate data
-	movl    %ecx,%eax
-	imull    %edx,%eax
-	addl    8(%ebp),%eax
+        movl    %ecx,%eax
+        imull    %edx,%eax
+        addl    8(%ebp),%eax
 # push data
-	pushl   %eax 
-	call	DECREF
-	jmp	.MyArrayDecRefLoop
-# AnsiString handling : 
+        pushl   %eax
+        call    FPC_DECREF
+        jmp     .MyArrayDecRefLoop
+# AnsiString handling :
 .DoAnsiStringDecRef:
-	movl	8(%ebp),%eax
-	pushl   %eax
-	call    DECR_ANSI_REF
+        movl    8(%ebp),%eax
+        pushl   %eax
+        call    FPC_DECR_ANSI_REF
 .ExitDecRef:
         pop     %edx
-	pop	%ecx
-	pop	%ebx
-	pop	%eax
+        pop     %ecx
+        pop     %ebx
+        pop     %eax
 end;
 
 {$ASMMODE DEFAULT}
 
 {
   $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
     + TObject.GetClassName implemented
 

rtl/i386/set.inc

@@ -16,7 +16,7 @@
 
 {$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
 }
@@ -34,7 +34,7 @@ begin
 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
 }
@@ -57,7 +57,7 @@ begin
 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
 }
@@ -86,7 +86,7 @@ begin
 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
 }
@@ -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
 }
@@ -134,7 +134,7 @@ end;
 { multiplies (i.E. takes common elements of) set1 and set2 }
 { 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
    asm
       movl 8(%ebp),%esi
@@ -152,7 +152,7 @@ begin
 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
 }
@@ -175,7 +175,7 @@ begin
 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
 }
@@ -196,7 +196,7 @@ begin
      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
 }
@@ -223,7 +223,7 @@ end;
 
 {$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
   not yet use by the compiler so
@@ -244,7 +244,7 @@ begin
 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
   works for sets larger than 256 elements
@@ -265,7 +265,7 @@ begin
 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
 }
@@ -287,7 +287,7 @@ begin
 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
   dest size is the number of bytes in the set
@@ -309,7 +309,7 @@ begin
 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
       asm
          movl 8(%ebp),%esi
@@ -329,7 +329,7 @@ begin
 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
 }
@@ -351,7 +351,7 @@ begin
 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
    asm
       movl 8(%ebp),%esi
@@ -376,7 +376,11 @@ end;
 
 {
   $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
     * fixed set_set_range
 

rtl/i386/setjump.inc

@@ -4,7 +4,7 @@
     Copyright (c) 1998 by the Free Pascal development team
 
     SetJmp and LongJmp implementation for exception handling
-    
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -14,12 +14,8 @@
 
  **********************************************************************}
 
-{$ifdef VER0_99_5}
-  {$I386_DIRECT}
-{$endif}
-
 {$ASMMODE DIRECT}
-  
+
 Function SetJmp (Var S : Jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];
 asm
   movl 8(%ebp),%eax
@@ -56,7 +52,11 @@ end;
 
 {
   $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
 
 }

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.
   AnsiSTring is defined as a 'silent' pchar :
   a pchar that points to :
-      
+
   @-12 : Longint for maximum size;
   @-8  : Longint for size;
   @-4  : Longint for reference count;
@@ -61,7 +61,7 @@ Type TAnsiRec = Record
 
 Const AnsiRecLen = SizeOf(TAnsiRec);
       FirstOff   = SizeOf(TAnsiRec)-1;
-      
+
 { ---------------------------------------------------------------------
   Internal functions, not in interface.
   ---------------------------------------------------------------------}
@@ -79,7 +79,7 @@ begin
       Writeln ('Maxlen : ',maxlen);
       Writeln ('Len    : ',len);
       Writeln ('Ref    : ',ref);
-      end;  
+      end;
     end;
 end;
 
@@ -118,45 +118,45 @@ begin
 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;
 }
 Type plongint = ^longint;
-     
-Var l : plongint;     
-     
+
+Var l : plongint;
+
 
 Begin
 //  dumpansirec(s);
   If Pointer(S)=Nil then exit; { Zero string }
-  
+
   { check for constant strings ...}
   l:=Pointer(S)-FirstOff+8;
   If l^<0 then exit;
   l^:=l^-1;
 //  dumpansirec(s);
-  If l^=0 then 
+  If l^=0 then
     { Ref count dropped to zero }
     begin
-//    Writeln ('CAlling disposestring'); 
+//    Writeln ('CAlling disposestring');
     DisposeAnsiString (S);        { Remove...}
     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
   If Pointer(S)=Nil then exit;
   { 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);
 end;
 
 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.
 }
 
@@ -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.
  If S2 is a constant string, a new S1 is allocated on the heap.
@@ -188,7 +188,7 @@ begin
     begin
     If PAnsiRec(S2-FirstOff)^.Ref<0 then
       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));
       Move (S2^,Temp^,PAnsiRec(S2-FirstOff)^.len+1);
       PAnsiRec(Temp-FirstOff)^.Len:=PAnsiRec(S2-FirstOff)^.len;
@@ -207,7 +207,7 @@ end;
 
 Procedure Ansi_String_Concat (Var S1 : AnsiString; Var S2 : AnsiString);
 {
-  Concatenates 2 AnsiStrings : S1+S2. 
+  Concatenates 2 AnsiStrings : S1+S2.
   Result Goes to S1;
 }
 Var Size,Location : Longint;
@@ -221,9 +221,9 @@ begin
     Size:=PAnsiRec(Pointer(S2)-FirstOff)^.Len;
     Location:=Length(S1);
     { 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 }
-//!!    SetLength (S1,Size+Location); 
+//!!    SetLength (S1,Size+Location);
     Move (Pointer(S2)^,Pointer(Pointer(S1)+location)^,Size+1);
     end;
 end;
@@ -241,10 +241,10 @@ begin
   Size:=byte(S2[0]);
   Location:=Length(S1);
   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 }
-  SetLength (S1,Size+Length(S1)); 
+  SetLength (S1,Size+Length(S1));
   Move (S2[1],Pointer(Pointer(S1)+Location)^,Size);
   PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero }
 end;
@@ -282,11 +282,11 @@ end;
 
 
 Const EmptyChar : char = #0;
-    
-Function Ansi2pchar (S : Pointer) : Pchar; [Alias : 'ANSI2PCHAR'];
+
+Function Ansi2pchar (S : Pointer) : Pchar; [Alias : 'FPC_ANSI2PCHAR'];
 
 begin
-  If S<>Nil then 
+  If S<>Nil then
     Ansi2Pchar:=S
   else
     Ansi2Pchar:=@emptychar;
@@ -313,7 +313,7 @@ begin
    inc(i);
    end;
  if temp=0 then temp:=Length(S1)-Length(S2);
- AnsiCompare:=Temp; 
+ AnsiCompare:=Temp;
 end;
 
 
@@ -338,7 +338,7 @@ begin
    Temp:= PByte(Pointer(S1)+I)^ - Byte(S2[i+1]);
    inc(i);
    end;
- AnsiCompare:=Temp; 
+ AnsiCompare:=Temp;
 end;
 
 
@@ -354,12 +354,12 @@ begin
 end;
 
 { ---------------------------------------------------------------------
-   Public functions, In interface.  
+   Public functions, In interface.
   ---------------------------------------------------------------------}
 
 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;
 }
 begin
@@ -418,7 +418,7 @@ begin
   dec(index);
   { Check Size. Accounts for Zero-length S }
   if Length(S)<Index+Size then
-    Size:=Length(S)-Index; 
+    Size:=Length(S)-Index;
   If Size>0 then
     begin
     ResultAddress:=Pointer(NewAnsiString (Size));
@@ -439,7 +439,7 @@ Function Pos (Var Substr : AnsiString; Var Source : AnsiString) : Longint;
 var i,j : longint;
     e : boolean;
     s : Pointer;
-    
+
 begin
  i := 0;
  j := 0;
@@ -464,7 +464,7 @@ end;
 Procedure Val (var S : AnsiString; var R : real; Var Code : Integer);
 
 Var SS : String;
-    
+
 begin
  Ansi_To_ShortString (SS,S,255);
  Val(SS,R,Code);
@@ -668,7 +668,7 @@ begin
   If Length(Source)=0 then exit;
   if index <= 0 then index := 1;
   s3 := Pointer(copy(s,index,length(s)));
-  if index > Length(s) then 
+  if index > Length(s) then
     index := Length(S)+1;
   SetLength(s,index - 1);
   s4 := Pointer ( NewAnsiString(PansiRec(Pointer(Source)-Firstoff)^.len) );
@@ -683,7 +683,11 @@ end;
 
 {
   $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
     + TObject.GetClassName implemented
 

rtl/inc/filerec.inc

@@ -21,16 +21,6 @@
   unit without sacrificing TP compatibility.
 }
 
-{$ifndef VER0_99_5}
-  {$ifndef VER0_99_6}
-    {$define UNIFORM_FILEREC}
-  {$endif}
-{$endif}
-
-
-{$ifdef UNIFORM_FILEREC}
-
-
 const
   filerecnamelength = 255;
 type
@@ -43,78 +33,13 @@ type
     name      : array[0..filerecnamelength] of char;
   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$
-  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)
 
   Revision 1.3  1998/05/21 11:55:59  carl

rtl/i386/heap.inc → rtl/inc/heap.inc

@@ -5,7 +5,6 @@
 
     functions for heap management in the data segment
 
-
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -25,8 +24,6 @@
 
 }
 
-{$ASMMODE DIRECT}
-
 const
   max_size = 256;
   maxblock = max_size div 8;
@@ -113,28 +110,6 @@ const
 {$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
 *****************************************************************************}
@@ -244,12 +219,7 @@ end;
      begin
        Writeln('Marked memory at ',HexStr(longint(p),8),' released');
        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;
 
 
@@ -339,8 +309,8 @@ end;
          tempheap.heapsize:=tempheap.memavail;
          getmem(tempheap.block,sizeof(tblocks));
          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;
          internal_memavail:=calc_memavail;
          baseheap.memavail:=internal_memavail;
@@ -445,7 +415,7 @@ end;
           begin
             while assigned(hp^.next) do
              hp:=hp^.next;
-          end;  
+          end;
          if tempheap.heapptr<>tempheap.heaporg then
           begin
             if hp<>nil then
@@ -518,21 +488,11 @@ end;
                                 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
+  proc     : heaperrorproc;
   last,hp  : pfreerecord;
   again    : boolean;
   s,hpsize : longint;
@@ -658,7 +618,8 @@ begin
      begin
        if assigned(heaperror) then
         begin
-          case call_heaperror(heaperror,size) of
+          proc:=heaperrorproc(heaperror);
+          case proc(size) of
            0 : HandleError(203);
            1 : p:=nil;
            2 : again:=true;
@@ -679,10 +640,6 @@ check_new:
   test_memavail;
   if trace then
    begin
-     asm
-         movl (%ebp),%eax
-         movl %eax,bp
-     end;
      pheap_mem_info(p)^.sig:=$DEADBEEF;
      pheap_mem_info(p)^.previous:=last_assigned;
      if last_assigned<>nil then
@@ -690,10 +647,11 @@ check_new:
      last_assigned:=p;
      pheap_mem_info(p)^.next:=nil;
      pheap_mem_info(p)^.size:=orsize;
+     bp:=get_caller_frame(get_frame);
      for i:=1 to tracesize do
       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;
      inc(p,sizeof(heap_mem_info));
    end;
@@ -705,7 +663,7 @@ end;
                                 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
   hp : pfreerecord;
 {$ifdef TEMPHEAP}
@@ -960,7 +918,9 @@ end;
 
 function growheap(size :longint) : integer;
 var
-  Newlimit,
+{$ifdef CHECKHEAP}
+  NewLimit,
+{$endif CHECKHEAP}
   NewPos,
   wantedsize : longint;
   hp         : pfreerecord;
@@ -1044,12 +1004,6 @@ begin
     to get the memory PM }
    internal_memavail:=calc_memavail;
  { set the total new heap size }
-   asm
-           movl Size,%ebx
-           movl HEAPSIZE,%eax
-           addl %ebx,%eax
-           movl %eax,HEAPSIZE
-   end;
    inc(internal_heapsize,size);
   { try again }
    GrowHeap:=2;
@@ -1076,20 +1030,22 @@ begin
   Curheap:=@baseheap;
   Otherheap:=@tempheap;
 {$endif TEMPHEAP}
-  internal_memavail:=GetHeapSize;
+  internal_heapsize:=GetHeapSize;
+  internal_memavail:=internal_heapsize;
   HeapOrg:=GetHeapStart;
   HeapPtr:=HeapOrg;
   HeapEnd:=HeapOrg+internal_memavail;
   HeapError:=@GrowHeap;
-  internal_heapsize:=longint(heapend)-longint(heaporg);
   Freelist:=nil;
 end;
 
-{$ASMMODE ATT}
-
 {
   $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 :)
 
   Revision 1.17  1998/09/04 17:27:48  pierre

rtl/inc/innr.inc

@@ -23,14 +23,6 @@ const
    in_ord_x             = 5;
    in_length_string     = 6;
    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_writeln_x         = 15;
    in_read_x            = 16;
@@ -74,7 +66,11 @@ const
 
 {
   $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
 
 }

rtl/inc/makefile.inc

@@ -6,7 +6,7 @@
 # implementation files.
 
 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))
 
 # Other unit names which can be used for all systems

rtl/inc/sstrings.inc

@@ -217,7 +217,7 @@ end;
                               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
 {$ifdef i386}
    str_real(len,fr,d,rt_s64real,s);
@@ -227,7 +227,7 @@ begin
 end;
 
 {$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
    str_real(len,fr,d,rt_s32real,s);
 end;
@@ -235,7 +235,7 @@ end;
 
 
 {$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
    str_real(len,fr,d,rt_s80real,s);
 end;
@@ -243,7 +243,7 @@ end;
 
 
 {$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
    str_real(len,fr,d,rt_s64bit,s);
 end;
@@ -251,14 +251,14 @@ end;
 
 
 {$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
    str_real(len,fr,d,rt_f32bit,s);
 end;
 {$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
    int_str(v,s);
    if length(s)<len then
@@ -266,7 +266,7 @@ begin
 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
   int_str(v,s);
   if length(s)<len then
@@ -753,7 +753,11 @@ end;
 
 {
   $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
 
   Revision 1.10  1998/08/08 12:28:13  florian

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(w : Word) : byte;     [INTERNPROC: In_hi_Word];
 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 Length(s : string) : byte; [INTERNPROC: In_Length_string];
@@ -122,11 +104,11 @@ Type
 {$else}
 
 { 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
   end;
 
-Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
+Procedure incr_ansi_ref (P : pointer);[Alias : 'FPC_INCR_ANSI_REF'];
   begin
   end;
 
@@ -137,9 +119,8 @@ Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
                          Run-Time Type Information (RTTI)
 ****************************************************************************}
 
-{$ifndef VER0_99_5}
-  {$i rtti.inc}
-{$endif  VER0_99_5}
+{$i rtti.inc}
+
 
 {****************************************************************************
                                Math Routines
@@ -157,90 +138,6 @@ begin
    Lo := b and $0f
 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}
 Begin
   swap:=(X and $ff) shl 8 + (X shr 8)
@@ -265,7 +162,7 @@ End;
 
 {****************************************************************************
                           Random function routines
-                        
+
         This implements a very long cycle random number generator by combining
    three independant generators.  The technique was described in the March
    1987 issue of Byte.
@@ -370,12 +267,26 @@ End;
 
 {$endif RTLLITE}
 
+
 {*****************************************************************************
                              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
   IOResult:=InOutRes;
   InOutRes:=0;
@@ -392,6 +303,37 @@ end;
                           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;
 Begin
   RunError (0);
@@ -405,16 +347,6 @@ End;
 
 
 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
   i, prevbp : Longint;
 Begin
@@ -422,17 +354,17 @@ Begin
   i:=0;
   while bp > prevbp Do
    Begin
-     dump_frame(get_addr(bp));
+     Writeln(stderr,'  0x',HexStr(get_caller_addr(bp),8));
      Inc(i);
      If i>max_frame_dump Then
       exit;
      prevbp:=bp;
-     bp:=get_next_frame(bp);
+     bp:=get_caller_frame(bp);
    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
   and by the halt procedure.
@@ -458,9 +390,6 @@ Begin
      Writeln('Run time error  ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
      dump_stack(ErrorBase);
    End;
-{$ifdef VER0_99_5}
-  Flush(stderr);
-{$endif VER0_99_5}
 End;
 
 
@@ -500,8 +429,9 @@ Begin
   ExitProc:=@DoExitProc;
 End;
 
+
 {*****************************************************************************
-      Assert() support.
+                           Assert() support.
 *****************************************************************************}
 
 Procedure do_assert (Const Name,Msg : string; LineNo : Longint); [Public,Alias : 'FPC_DO_ASSERT'];
@@ -511,7 +441,6 @@ begin
   else
     write (stderr,msg);
   writeln (stderr,'(File : ',name,', line ',LineNo,'.');
-  flush (stderr);
   HandleError (227);
 end;
 
@@ -533,7 +462,11 @@ end;
 
 {
   $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
 
   Revision 1.28  1998/08/17 12:24:16  carl

rtl/inc/systemh.inc

@@ -26,12 +26,6 @@
 
 {$i version.inc}
 
-{$ifndef VER0_99_5}
-  {$ifndef VER0_99_6}
-    {$define INTERNCONST}
-  {$endif}
-{$endif}
-
 
 {****************************************************************************
                          Global Types and Constants
@@ -47,11 +41,7 @@ Type
 { at least declare Turbo Pascal real types }
 {$ifdef i386}
    StrLenInt = LongInt;
-  {$ifndef VER0_99_5}
-    {$ifndef VER0_99_6}
-      {$define DEFAULT_EXTENDED}
-    {$endif}
-  {$endif}
+  {$define DEFAULT_EXTENDED}
   {$define SUPPORT_EXTENDED}
   {$define SUPPORT_COMP}
   {$define SUPPORT_SINGLE}
@@ -158,40 +148,6 @@ Function  Swap (X:Word):Word;
 Function  Swap (X:Integer):Integer;
 Function  Swap (X:Cardinal):Cardinal;
 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}
 
 Function Chr(b:byte):Char;
@@ -430,7 +386,11 @@ Procedure halt;
 
 {
   $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
 
   Revision 1.26  1998/09/04 18:16:14  peter

rtl/inc/text.inc

@@ -102,7 +102,7 @@ begin
 end;
 
 
-Procedure Close(var t : Text);[Public,Alias: 'CLOSE_TEXT',IOCheck];
+Procedure Close(var t : Text);[IOCheck];
 Begin
   if InOutRes <> 0 then Exit;
   If (TextRec(t).mode<>fmClosed) Then
@@ -407,14 +407,14 @@ begin
 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
   if f.FlushFunc<>nil then
    FileFunc(f.FlushFunc)(f);
 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
 {$IFDEF SHORT_LINEBREAK}
   eollen=1;
@@ -433,7 +433,7 @@ begin
 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
   If InOutRes <> 0 then exit;
   If f.mode<>fmOutput Then
@@ -446,7 +446,7 @@ End;
 
 Type
    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
   ArrayLen : longint;
 Begin
@@ -460,7 +460,7 @@ Begin
 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
   PCharLen : longint;
 Begin
@@ -474,7 +474,7 @@ Begin
 End;
 
 {$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
 }
@@ -490,7 +490,7 @@ end;
 {$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
   s : String;
 Begin
@@ -500,7 +500,7 @@ Begin
 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
    s : String;
 Begin
@@ -514,7 +514,7 @@ Begin
 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
   s : String;
 Begin
@@ -524,7 +524,7 @@ Begin
 End;
 
 {$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
   s : String;
 Begin
@@ -536,7 +536,7 @@ End;
 
 
 {$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
   s : String;
 Begin
@@ -548,7 +548,7 @@ End;
 
 
 {$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
   s : String;
 Begin
@@ -560,7 +560,7 @@ End;
 
 
 {$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
   s : String;
 Begin
@@ -571,7 +571,7 @@ End;
 {$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
   If InOutRes <> 0 then exit;
 { Can't use array[boolean] because b can be >0 ! }
@@ -582,7 +582,7 @@ Begin
 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
   If InOutRes <> 0 then exit;
   If t.mode<>fmOutput Then
@@ -596,22 +596,6 @@ Begin
 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)
 *****************************************************************************}
@@ -709,14 +693,14 @@ begin
 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
   if f.FlushFunc<>nil then
    FileFunc(f.FlushFunc)(f);
 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
   If InOutRes <> 0 then exit;
   if not OpenInput(f) then
@@ -736,52 +720,7 @@ Begin
 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
   Temp,sPos,nrread : Word;
 Begin
@@ -826,10 +765,9 @@ Begin
    End;
   s[0]:=chr(sPos-1);
 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
   c:=#0;
   If InOutRes <> 0 then exit;
@@ -843,7 +781,7 @@ Begin
 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
   p    : PChar;
   Temp : byte;
@@ -877,7 +815,7 @@ Begin
 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
   p    : PChar;
   Temp : byte;
@@ -912,7 +850,7 @@ End;
 
 
 {$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
   p    : PChar;
   Temp : byte;
@@ -952,7 +890,7 @@ End;
 {$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
   hs   : String;
   code : Word;
@@ -971,7 +909,7 @@ Begin
 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
   ll : Longint;
 Begin
@@ -984,7 +922,7 @@ Begin
 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
   ll : Longint;
 Begin
@@ -997,7 +935,7 @@ Begin
 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
   ll : Longint;
 Begin
@@ -1010,7 +948,7 @@ Begin
 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
    ll : Longint;
 Begin
@@ -1023,7 +961,7 @@ Begin
 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
   hs   : String;
   code : Word;
@@ -1042,7 +980,7 @@ Begin
 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
   hs   : String;
   code : Word;
@@ -1081,7 +1019,7 @@ End;
 
 
 {$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
   hs   : String;
   code : Word;
@@ -1121,7 +1059,7 @@ End;
 
 
 {$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
   hs   : String;
   code : Word;
@@ -1160,24 +1098,6 @@ End;
 {$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
 *****************************************************************************}
@@ -1202,7 +1122,11 @@ end;
 
 {
   $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
 
   Revision 1.23  1998/08/26 15:33:28  peter

rtl/inc/textrec.inc

@@ -21,16 +21,6 @@
   unit without sacrificing TP compatibility.
 }
 
-{$ifndef VER0_99_5}
-  {$ifndef VER0_99_6}
-    {$define UNIFORM_TEXTREC}
-  {$endif}
-{$endif}
-
-
-{$ifdef UNIFORM_TEXTREC}
-
-
 const
   TextRecNameLength = 256;
   TextRecBufSize    = 256;
@@ -53,90 +43,13 @@ type
     buffer    : textbuf;
   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$
-  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
 
   Revision 1.4  1998/09/04 18:16:15  peter

rtl/inc/typefile.inc

@@ -46,32 +46,36 @@ begin
 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
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Reset(UnTypedFile(f),Size);
 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
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Rewrite(UnTypedFile(f),Size);
 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
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Do_Write(FileRec(f).Handle,Longint(@Buf),TypeSize);
 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
   Result : Longint;
 Begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   Result:=Do_Read(FileRec(f).Handle,Longint(@Buf),TypeSize);
   If Result<TypeSize Then
    InOutRes:=100;
@@ -79,7 +83,11 @@ End;
 
 {
   $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
 
   Revision 1.3  1998/05/21 19:31:02  peter

rtl/linux/syslinux.pp

@@ -47,7 +47,7 @@ const
   {$endif}
 {$else}
   UnusedHandle    = $ffff;
-{$endif}  
+{$endif}
   StdInputHandle  = 0;
   StdOutputHandle = 1;
   StdErrorHandle  = 2;
@@ -96,7 +96,9 @@ Implementation
                        Misc. System Dependent Functions
 *****************************************************************************}
 
-{$ASMMODE DIRECT}
+{$ifdef i386}
+  {$ASMMODE DIRECT}
+{$endif}
 
 Procedure Halt(ErrNum: Byte);
 Begin
@@ -108,6 +110,9 @@ Begin
         jmp     _haltproc
   end;
 {$else}
+  asm
+        jmp     _haltproc
+  end;
 {$endif}
 End;
 
@@ -150,7 +155,7 @@ Begin
   if pp^<>nil then
     Paramstr:=StrPas(pp^)
   else
-    ParamStr:='';  
+    ParamStr:='';
 {$endif}
 End;
 
@@ -169,6 +174,31 @@ End;
                               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 }
 
 Function Get_Brk_addr : longint;assembler;
@@ -178,7 +208,8 @@ asm
 end ['EAX'];
 {$else}
 asm
-end;
+        move.l  ___fpc_brk_addr,d0
+end ['D0'];
 {$endif}
 
 
@@ -190,10 +221,14 @@ asm
 end ['EAX'];
 {$else}
 asm
-end;
+        move.l  NewAddr,d0
+        move.l  d0,___fpc_brk_addr
+end ['D0'];
 {$endif}
 
-{$ASMMODE ATT}
+{$ifdef i386}
+  {$ASMMODE ATT}
+{$endif}
 
 Function brk(Location : longint) : Longint;
 { set end of data segment to location }
@@ -235,6 +270,7 @@ begin
   exit(-1);
 end;
 
+
 { include standard heap management }
 {$I heap.inc}
 
@@ -697,7 +733,11 @@ End.
 
 {
   $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
 
   Revision 1.14  1998/09/04 18:16:16  peter

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)
-  =============================================================================
-}

rtl/m68k/m68k.inc

@@ -31,7 +31,7 @@
 
 
     { 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. }
  { on entry contains d0 = error code.           }
  var
@@ -98,11 +98,10 @@
      end ['d0','d1','a0'];
    end;
 
-    procedure int_help_constructor;
+    procedure int_help_constructor;[public,alias:'FPC_HELP_CONSTRUCTOR'];
 
       begin
          asm
-          XDEF HELP_CONSTRUCTOR
             { Entry without preamble, since we need the ESP of the
               constructor }
             { Stack (relative to %ebp):
@@ -178,7 +177,7 @@
          end;
       end;
 
-    procedure int_help_destructor;
+    procedure int_help_destructor;[public,alias:'FPC_HELP_DESTRUCTOR'];
 
       begin
          asm
@@ -189,7 +188,6 @@
                 0 %ebp
             }
             { temporary Variable }
-          XDEF HELP_DESTRUCTOR
             subq.l #4,sp
             move.l sp,d6
             { Save Registers }
@@ -222,10 +220,9 @@
          end;
       end;
 
-  procedure new_class;assembler;
+  procedure new_class;assembler;[public,alias:'FPC_NEW_CLASS'];
 
   asm
-     XDEF NEW_CLASS
      { create class ? }
      move.l 8(a6), d0
      tst.l  d0
@@ -249,10 +246,9 @@
 
 
 
-  procedure dispose_class;assembler;
+  procedure dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS'];
 
   asm
-    XDEF DISPOSE_CLASS
      { destroy class ? }
      move.l 8(a6),d0
      { save self }
@@ -272,12 +268,11 @@
   end;
 
   { 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                  }
   {   Nota: All registers must be preserved including   }
   {   A0 itself!                                        }
   asm
-   XDEF CHECK_OBJECT
      move.l   d0,-(sp)
      tst.l    a0
      { z flag set if zero }
@@ -296,8 +291,13 @@
   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
          asm
             move.l BP,a0
@@ -309,7 +309,7 @@
          end ['a0'];
       end;
 
-    function get_next_frame(bp : longint) : longint;
+    function get_caller_frame(bp : longint) : longint;
 
       begin
          asm
@@ -322,113 +322,8 @@
          end ['a0'];
       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; assembler;
+     procedure strcopy; assembler;[public,alias: 'FPC_STRCOPY'];
     {---------------------------------------------------}
     { Low-level routine to copy a string to another     }
     { string with maximum length. Never call directly!  }
@@ -439,7 +334,6 @@ end;
     { registers destroyed: a0,a1,d0,d1                  }
     {---------------------------------------------------}
          asm
-           XDEF STRCOPY
 {            move.l 12(a6),a0
             move.l 16(a6),a1
             move.l 8(a6),d1 }
@@ -512,10 +406,8 @@ end;
     {   ALL FLAGS are set appropriately.                    }
     {    ZF = strings are equal                             }
     { REGISTERS DESTROYED: a0, a1, d0, d1, d6               }
-    procedure strcmp; assembler;
+    procedure strcmp; assembler;[public,alias:'FPC_STRCMP'];
      asm
-     XDEF STRCMP
-
             move.b (a0)+,d0     { Get length of first string  }
             move.b (a1)+,d6     { Get length of 2nd string    }
 
@@ -722,22 +614,6 @@ 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;
 begin
   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    }
  { determine if a range check occured.          }
  { Only in 68000 mode, in 68020 mode this is    }
@@ -759,7 +635,6 @@ end;
  {   A1 = address contaning min and max indexes }
  {   D0 = value of current index to check.      }
  asm
-XDEF RE_BOUNDS_CHECK
   cmp.l   (A1),D0        { lower bound ...    }
   bmi     @rebounderr    { is index lower ... }
   add.l   #4,A1
@@ -772,9 +647,40 @@ XDEF RE_BOUNDS_CHECK
 @reboundend:
  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$
-  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
 
   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 uses register calling conventions
     * 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
-  =============================================================================
 }

rtl/m68k/makefile.cpu

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

rtl/os2/sysos2.pas

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

rtl/win32/syswin32.pp

@@ -19,19 +19,15 @@ unit syswin32;
 
 {$I os.inc}
 
-{.$DEFINE WINHEAP}   { Use windows heap manager, if not set use FPC heap }
-
-
 interface
 
 { include system-independent routine headers }
 
 {$I systemh.inc}
 
-{$ifndef WinHeap}
-  { include heap support headers }
-  {$I heaph.inc}
-{$endif}
+{ include heap support headers }
+{$I heaph.inc}
+
 
 const
 { Default filehandles }
@@ -72,15 +68,9 @@ var
   hinstance,
   cmdshow     : longint;
 
-{$ifdef WinHeap}
-var
-  heaperror  : pointer;
-
-function HeapSize:longint;
-{$endif}
-
 implementation
 
+
 { include system independent routines }
 {$I system.inc}
 
@@ -234,33 +224,29 @@ end;
                               Heap Management
 *****************************************************************************}
 
-{$ifdef WinHeap}
-
-  {$i winheap.inc}
-
-{$else}
-
    { memory functions }
    function GlobalAlloc(mode,size:longint):longint;
      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;
      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;
      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;
 var
@@ -268,17 +254,17 @@ var
 begin
   h:=GlobalAlloc(258,size);
   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));
+{$endif}
   sbrk:=l;
 end;
 
 { include standard heap management }
 {$I heap.inc}
 
-{$endif WinHeap}
-
-
 {*****************************************************************************
                           Low Level File Routines
 *****************************************************************************}
@@ -742,9 +728,7 @@ begin
 { real test stack depth        }
 {   stacklimit := setupstack;  }
 { Setup heap }
-{$ifndef WinHeap}
   InitHeap;
-{$endif WinHeap}
 { Setup stdin, stdout and stderr }
   StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));
   StdOutputHandle:=longint(GetStdHandle(STD_OUTPUT_HANDLE));
@@ -762,7 +746,11 @@ end.
 
 {
   $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
       was not checked correctly