paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 15:09:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ internconst

Browse Source
This commit is contained in:
peter 1998-09-01 17:36:17 +00:00
parent c4ed67543a
commit b8ff0c3320
5 changed files with 114 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
rtl/i386/i386.inc
View File

@ -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

17
rtl/i386/math.inc
View File

@ -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

99
rtl/inc/innr.inc
View File

@ -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
}

52
rtl/inc/system.inc
View File

@ -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

12
rtl/inc/systemh.inc
View File

@ -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