Browse Source

+ internconst

peter 27 years ago
parent
commit
b8ff0c3320
5 changed files with 114 additions and 79 deletions
  1. 8 5
      rtl/i386/i386.inc
  2. 10 7
      rtl/i386/math.inc
  3. 58 41
      rtl/inc/innr.inc
  4. 27 25
      rtl/inc/system.inc
  5. 11 1
      rtl/inc/systemh.inc

+ 8 - 5
rtl/i386/i386.inc

@@ -536,7 +536,7 @@ end;
 
 function get_error_bp : Longint;assembler;
 asm
-   movl (%ebp),%eax 
+   movl (%ebp),%eax
 end;
 
 begin
@@ -619,7 +619,7 @@ begin
 end;
 
 
-function abs(l:longint):longint;assembler;
+function abs(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_abs];{$endif}
 asm
         movl    l,%eax
         orl     %eax,%eax
@@ -629,7 +629,7 @@ asm
 end ['EAX'];
 
 
-function odd(l:longint):boolean;assembler;
+function odd(l:longint):boolean;assembler;{$ifdef INTERNCONST}[internconst:in_const_odd];{$endif}
 asm
        movl     l,%eax
        andl     $1,%eax
@@ -637,7 +637,7 @@ asm
 end ['EAX'];
 
 
-function sqr(l:longint):longint;assembler;
+function sqr(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_sqr];{$endif}
 asm
         mov     l,%eax
         imull   %eax,%eax
@@ -752,7 +752,10 @@ end;
 
 {
   $Log$
-  Revision 1.18  1998-08-11 00:04:47  peter
+  Revision 1.19  1998-09-01 17:36:17  peter
+    + internconst
+
+  Revision 1.18  1998/08/11 00:04:47  peter
     * $ifdef ver0_99_5 updates
 
   Revision 1.17  1998/07/30 13:26:20  michael

+ 10 - 7
rtl/i386/math.inc

@@ -272,7 +272,7 @@
          end [];
       end;
 
-    function abs(d : extended) : extended;
+    function abs(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_abs];{$endif}
 
       begin
          asm
@@ -283,7 +283,7 @@
          end [];
       end;
 
-    function sqr(d : extended) : extended;
+    function sqr(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_sqr];{$endif}
 
       begin
          asm
@@ -376,7 +376,7 @@
          end;
       end;
 
-    function frac(d : extended) : extended;
+    function frac(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_frac];{$endif}
 
       begin
          asm
@@ -400,7 +400,7 @@
          end ['ECX'];
       end;
 
-    function int(d : extended) : extended;
+    function int(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_int];{$endif}
 
       begin
          asm
@@ -421,7 +421,7 @@
          end ['ECX'];
       end;
 
-    function trunc(d : extended) : longint;
+    function trunc(d : extended) : longint;{$ifdef INTERNCONST}[internconst:in_const_trunc];{$endif}
 
       begin
          asm
@@ -442,7 +442,7 @@
          end ['EAX','ECX'];
       end;
 
-    function round(d : extended) : longint;
+    function round(d : extended) : longint;{$ifdef INTERNCONST}[internconst:in_const_round];{$endif}
 
       begin
          asm
@@ -634,7 +634,10 @@
 
 {
   $Log$
-  Revision 1.7  1998-08-25 08:49:05  florian
+  Revision 1.8  1998-09-01 17:36:18  peter
+    + internconst
+
+  Revision 1.7  1998/08/25 08:49:05  florian
     * corrected exp() function
 
   Revision 1.6  1998/08/11 21:39:04  peter

+ 58 - 41
rtl/inc/innr.inc

@@ -3,6 +3,8 @@
     This file is part of the Free Pascal run time library and compiler.
     Copyright (c) 1993,98 by the Free Pascal development team
 
+    Internal Function/Constant Evaluator numbers
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -13,52 +15,67 @@
  **********************************************************************}
 
 const
-   in_lo_word = 1;
-   in_hi_word = 2;
-   in_lo_long = 3;
-   in_hi_long = 4;
-   { to be able to compile with ord intern or not }
-   in_ord_char = 5;
-   in_ord_x = 5;
-   in_length_string = 6;
-   in_chr_byte = 7;
-   in_inc_byte = 8;
-   in_inc_word = 9;
-   in_inc_dword = 10;
-   in_dec_byte = 11;
-   in_dec_word = 12;
-   in_dec_dword = 13;
-   in_write_x = 14;
-   in_writeln_x = 15;
-   in_read_x = 16;
-   in_readln_x = 17;
-   in_concat_x = 18;
-   in_assigned_x = 19;
-   in_str_x_string = 20;
-   in_ofs_x = 21;
-   in_sizeof_x = 22;
-   in_typeof_x = 23;
-   in_val_x = 24;
-   in_reset_x = 25;
-   in_rewrite_x = 26;
-   in_low_x = 27;
-   in_high_x = 28;
-   in_seg_x = 29;
-   in_pred_x = 30;
-   in_succ_x = 31;
-   in_reset_typedfile = 32;
+{ Internal functions }
+   in_lo_word           = 1;
+   in_hi_word           = 2;
+   in_lo_long           = 3;
+   in_hi_long           = 4;
+   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;
+   in_readln_x          = 17;
+   in_concat_x          = 18;
+   in_assigned_x        = 19;
+   in_str_x_string      = 20;
+   in_ofs_x             = 21;
+   in_sizeof_x          = 22;
+   in_typeof_x          = 23;
+   in_val_x             = 24;
+   in_reset_x           = 25;
+   in_rewrite_x         = 26;
+   in_low_x             = 27;
+   in_high_x            = 28;
+   in_seg_x             = 29;
+   in_pred_x            = 30;
+   in_succ_x            = 31;
+   in_reset_typedfile   = 32;
    in_rewrite_typedfile = 33;
    in_settextbuf_file_x = 34;
-   in_inc_x = 35;
-   in_dec_x = 36;
+   in_inc_x             = 35;
+   in_dec_x             = 36;
+   in_include_x_y       = 37;
+   in_exclude_x_y       = 38;
+   in_break             = 39;
+   in_continue          = 40;
+   in_assert_x          = 41;
+
+{ Internal constant functions }
+   in_const_trunc      = 100;
+   in_const_round      = 101;
+   in_const_frac       = 102;
+   in_const_abs        = 103;
+   in_const_int        = 104;
+   in_const_sqr        = 105;
+   in_const_odd        = 106;
+   in_const_ptr        = 107;
+   in_const_swap_word  = 108;
+   in_const_swap_long  = 109;
 
 {
   $Log$
-  Revision 1.2  1998-05-12 10:42:45  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
+  Revision 1.3  1998-09-01 17:36:19  peter
+    + internconst
 
 }
 

+ 27 - 25
rtl/inc/system.inc

@@ -42,23 +42,6 @@ const
   DoError   : Boolean = FALSE;
   ErrorBase : Longint = 0;
 
-{****************************************************************************
-                    Include processor specific routines
-****************************************************************************}
-
-{$IFDEF I386}
-  {$IFDEF M68K}
-    {$Error Can't determine processor type !}
-  {$ENDIF}
-  {$I i386.inc}  { Case dependent, don't change }
-{$ELSE}
-  {$IFDEF M68K}
-    {$I m68k.inc}  { Case dependent, don't change }
-  {$ELSE}
-    {$Error Can't determine processor type !}
-  {$ENDIF}
-{$ENDIF}
-
 {****************************************************************************
                      Routines which have compiler magic
 ****************************************************************************}
@@ -96,6 +79,22 @@ Function Length(s : string) : byte; [INTERNPROC: In_Length_string];
 Procedure Reset(var f : TypedFile);   [INTERNPROC: In_Reset_TypedFile];
 Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
 
+{****************************************************************************
+                    Include processor specific routines
+****************************************************************************}
+
+{$IFDEF I386}
+  {$IFDEF M68K}
+    {$Error Can't determine processor type !}
+  {$ENDIF}
+  {$I i386.inc}  { Case dependent, don't change }
+{$ELSE}
+  {$IFDEF M68K}
+    {$I m68k.inc}  { Case dependent, don't change }
+  {$ELSE}
+    {$Error Can't determine processor type !}
+  {$ENDIF}
+{$ENDIF}
 
 {****************************************************************************
                                 Set Handling
@@ -242,22 +241,22 @@ End;
 
 {$endif VER0_99_5}
 
-Function swap (X : Word) : Word;
+Function swap (X : Word) : Word;{$ifdef INTERNCONST}[internconst:in_const_swap_word];{$endif}
 Begin
   swap:=(X and $ff) shl 8 + (X shr 8)
 End;
 
-Function Swap (X : Integer) : Integer;
+Function Swap (X : Integer) : Integer;{$ifdef INTERNCONST}[internconst:in_const_swap_word];{$endif}
 Begin
   Swap:=Integer(Swap(Word(X)));
 End;
 
-Function swap (X : Longint) : Longint;
+Function swap (X : Longint) : Longint;{$ifdef INTERNCONST}[internconst:in_const_swap_long];{$endif}
 Begin
   Swap:=(X and $ffff) shl 16 + (X shr 16)
 End;
 
-Function Swap (X : Cardinal) : Cardinal;
+Function Swap (X : Cardinal) : Cardinal;{$ifdef INTERNCONST}[internconst:in_const_swap_long];{$endif}
 Begin
   Swap:=Swap(Longint(X));
 End;
@@ -266,8 +265,8 @@ End;
 
 {****************************************************************************
                           Random function routines
-			      
-	This implements a very long cycle random number generator by combining
+                        
+        This implements a very long cycle random number generator by combining
    three independant generators.  The technique was described in the March
    1987 issue of Byte.
    Taken and modified with permission from the PCQ Pascal rtl code.
@@ -343,7 +342,7 @@ end;
 
 {$ifndef RTLLITE}
 
-Function Ptr(sel,off : Longint) : pointer;
+Function Ptr(sel,off : Longint) : pointer;{$ifdef INTERNCONST}[internconst:in_const_ptr];{$endif}
 Begin
   sel:=0;
   ptr:=pointer(off);
@@ -534,7 +533,10 @@ end;
 
 {
   $Log$
-  Revision 1.28  1998-08-17 12:24:16  carl
+  Revision 1.29  1998-09-01 17:36:21  peter
+    + internconst
+
+  Revision 1.28  1998/08/17 12:24:16  carl
     + important comment added
 
   Revision 1.27  1998/08/13 16:22:11  jonas

+ 11 - 1
rtl/inc/systemh.inc

@@ -28,6 +28,13 @@
 
 {$i version.inc}
 
+{$ifndef VER0_99_5}
+  {$ifndef VER0_99_6}
+    {$define INTERNCONST}
+  {$endif}
+{$endif}
+
+
 {****************************************************************************
                          Global Types and Constants
 ****************************************************************************}
@@ -433,7 +440,10 @@ Procedure halt;
 
 {
   $Log$
-  Revision 1.24  1998-08-11 21:39:08  peter
+  Revision 1.25  1998-09-01 17:36:22  peter
+    + internconst
+
+  Revision 1.24  1998/08/11 21:39:08  peter
     * splitted default_extended from support_extended
 
   Revision 1.23  1998/08/11 00:05:27  peter