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;
 function get_error_bp : Longint;assembler;
 asm
 asm
-   movl (%ebp),%eax 
+   movl (%ebp),%eax
 end;
 end;
 
 
 begin
 begin
@@ -619,7 +619,7 @@ begin
 end;
 end;
 
 
 
 
-function abs(l:longint):longint;assembler;
+function abs(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_abs];{$endif}
 asm
 asm
         movl    l,%eax
         movl    l,%eax
         orl     %eax,%eax
         orl     %eax,%eax
@@ -629,7 +629,7 @@ asm
 end ['EAX'];
 end ['EAX'];
 
 
 
 
-function odd(l:longint):boolean;assembler;
+function odd(l:longint):boolean;assembler;{$ifdef INTERNCONST}[internconst:in_const_odd];{$endif}
 asm
 asm
        movl     l,%eax
        movl     l,%eax
        andl     $1,%eax
        andl     $1,%eax
@@ -637,7 +637,7 @@ asm
 end ['EAX'];
 end ['EAX'];
 
 
 
 
-function sqr(l:longint):longint;assembler;
+function sqr(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_sqr];{$endif}
 asm
 asm
         mov     l,%eax
         mov     l,%eax
         imull   %eax,%eax
         imull   %eax,%eax
@@ -752,7 +752,10 @@ end;
 
 
 {
 {
   $Log$
   $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
     * $ifdef ver0_99_5 updates
 
 
   Revision 1.17  1998/07/30 13:26:20  michael
   Revision 1.17  1998/07/30 13:26:20  michael

+ 10 - 7
rtl/i386/math.inc

@@ -272,7 +272,7 @@
          end [];
          end [];
       end;
       end;
 
 
-    function abs(d : extended) : extended;
+    function abs(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_abs];{$endif}
 
 
       begin
       begin
          asm
          asm
@@ -283,7 +283,7 @@
          end [];
          end [];
       end;
       end;
 
 
-    function sqr(d : extended) : extended;
+    function sqr(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_sqr];{$endif}
 
 
       begin
       begin
          asm
          asm
@@ -376,7 +376,7 @@
          end;
          end;
       end;
       end;
 
 
-    function frac(d : extended) : extended;
+    function frac(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_frac];{$endif}
 
 
       begin
       begin
          asm
          asm
@@ -400,7 +400,7 @@
          end ['ECX'];
          end ['ECX'];
       end;
       end;
 
 
-    function int(d : extended) : extended;
+    function int(d : extended) : extended;{$ifdef INTERNCONST}[internconst:in_const_int];{$endif}
 
 
       begin
       begin
          asm
          asm
@@ -421,7 +421,7 @@
          end ['ECX'];
          end ['ECX'];
       end;
       end;
 
 
-    function trunc(d : extended) : longint;
+    function trunc(d : extended) : longint;{$ifdef INTERNCONST}[internconst:in_const_trunc];{$endif}
 
 
       begin
       begin
          asm
          asm
@@ -442,7 +442,7 @@
          end ['EAX','ECX'];
          end ['EAX','ECX'];
       end;
       end;
 
 
-    function round(d : extended) : longint;
+    function round(d : extended) : longint;{$ifdef INTERNCONST}[internconst:in_const_round];{$endif}
 
 
       begin
       begin
          asm
          asm
@@ -634,7 +634,10 @@
 
 
 {
 {
   $Log$
   $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
     * corrected exp() function
 
 
   Revision 1.6  1998/08/11 21:39:04  peter
   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.
     This file is part of the Free Pascal run time library and compiler.
     Copyright (c) 1993,98 by the Free Pascal development team
     Copyright (c) 1993,98 by the Free Pascal development team
 
 
+    Internal Function/Constant Evaluator numbers
+
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
 
 
@@ -13,52 +15,67 @@
  **********************************************************************}
  **********************************************************************}
 
 
 const
 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_rewrite_typedfile = 33;
    in_settextbuf_file_x = 34;
    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$
   $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;
   DoError   : Boolean = FALSE;
   ErrorBase : Longint = 0;
   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
                      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 Reset(var f : TypedFile);   [INTERNPROC: In_Reset_TypedFile];
 Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_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
                                 Set Handling
@@ -242,22 +241,22 @@ End;
 
 
 {$endif VER0_99_5}
 {$endif VER0_99_5}
 
 
-Function swap (X : Word) : Word;
+Function swap (X : Word) : Word;{$ifdef INTERNCONST}[internconst:in_const_swap_word];{$endif}
 Begin
 Begin
   swap:=(X and $ff) shl 8 + (X shr 8)
   swap:=(X and $ff) shl 8 + (X shr 8)
 End;
 End;
 
 
-Function Swap (X : Integer) : Integer;
+Function Swap (X : Integer) : Integer;{$ifdef INTERNCONST}[internconst:in_const_swap_word];{$endif}
 Begin
 Begin
   Swap:=Integer(Swap(Word(X)));
   Swap:=Integer(Swap(Word(X)));
 End;
 End;
 
 
-Function swap (X : Longint) : Longint;
+Function swap (X : Longint) : Longint;{$ifdef INTERNCONST}[internconst:in_const_swap_long];{$endif}
 Begin
 Begin
   Swap:=(X and $ffff) shl 16 + (X shr 16)
   Swap:=(X and $ffff) shl 16 + (X shr 16)
 End;
 End;
 
 
-Function Swap (X : Cardinal) : Cardinal;
+Function Swap (X : Cardinal) : Cardinal;{$ifdef INTERNCONST}[internconst:in_const_swap_long];{$endif}
 Begin
 Begin
   Swap:=Swap(Longint(X));
   Swap:=Swap(Longint(X));
 End;
 End;
@@ -266,8 +265,8 @@ End;
 
 
 {****************************************************************************
 {****************************************************************************
                           Random function routines
                           Random function routines
-			      
-	This implements a very long cycle random number generator by combining
+                        
+        This implements a very long cycle random number generator by combining
    three independant generators.  The technique was described in the March
    three independant generators.  The technique was described in the March
    1987 issue of Byte.
    1987 issue of Byte.
    Taken and modified with permission from the PCQ Pascal rtl code.
    Taken and modified with permission from the PCQ Pascal rtl code.
@@ -343,7 +342,7 @@ end;
 
 
 {$ifndef RTLLITE}
 {$ifndef RTLLITE}
 
 
-Function Ptr(sel,off : Longint) : pointer;
+Function Ptr(sel,off : Longint) : pointer;{$ifdef INTERNCONST}[internconst:in_const_ptr];{$endif}
 Begin
 Begin
   sel:=0;
   sel:=0;
   ptr:=pointer(off);
   ptr:=pointer(off);
@@ -534,7 +533,10 @@ end;
 
 
 {
 {
   $Log$
   $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
     + important comment added
 
 
   Revision 1.27  1998/08/13 16:22:11  jonas
   Revision 1.27  1998/08/13 16:22:11  jonas

+ 11 - 1
rtl/inc/systemh.inc

@@ -28,6 +28,13 @@
 
 
 {$i version.inc}
 {$i version.inc}
 
 
+{$ifndef VER0_99_5}
+  {$ifndef VER0_99_6}
+    {$define INTERNCONST}
+  {$endif}
+{$endif}
+
+
 {****************************************************************************
 {****************************************************************************
                          Global Types and Constants
                          Global Types and Constants
 ****************************************************************************}
 ****************************************************************************}
@@ -433,7 +440,10 @@ Procedure halt;
 
 
 {
 {
   $Log$
   $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
     * splitted default_extended from support_extended
 
 
   Revision 1.23  1998/08/11 00:05:27  peter
   Revision 1.23  1998/08/11 00:05:27  peter