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

* removed temp symbols

Browse Source
This commit is contained in:
peter 1998-12-15 22:42:49 +00:00
parent 401078117f
commit 516958a67b
21 changed files with 256 additions and 353 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
rtl/dos/crt.pp
View File

@ -551,11 +551,7 @@ begin
asm asm
movzwl hz,%ecx movzwl hz,%ecx
movl $1193046,%eax movl $1193046,%eax
{$ifdef NOATTCDQ}
cltd cltd
{$else}
cdq
{$endif}
divl %ecx divl %ecx
movl %eax,%ecx movl %eax,%ecx
movb $0xb6,%al movb $0xb6,%al
@ -920,7 +916,10 @@ end.
{ {
$Log$ $Log$
Revision 1.16 1998-12-09 23:04:36 jonas Revision 1.17 1998-12-15 22:42:49 peter
* removed temp symbols
Revision 1.16 1998/12/09 23:04:36 jonas
* fixed bug in InsLine (changed "my" from "WinMaxY -1" to "WinMaxY - WinMinY") * fixed bug in InsLine (changed "my" from "WinMaxY -1" to "WinMaxY - WinMinY")
Revision 1.15 1998/11/28 14:09:48 peter Revision 1.15 1998/11/28 14:09:48 peter

7
rtl/dos/go32v1/system.pp
View File

@ -99,7 +99,7 @@ implementation
{$I system.inc} {$I system.inc}
{$ASMMODE DIRECT} {$ASMMODE DIRECT}
procedure int_stackcheck(stack_size:longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STACKCHECK']; procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
begin begin
{ called when trying to get local stack { called when trying to get local stack
if the compiler directive $S is set if the compiler directive $S is set
@ -612,7 +612,10 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.11 1998-11-29 22:28:09 peter Revision 1.12 1998-12-15 22:42:51 peter
* removed temp symbols
Revision 1.11 1998/11/29 22:28:09 peter
+ io-error 103 added + io-error 103 added
Revision 1.10 1998/11/16 14:15:01 pierre Revision 1.10 1998/11/16 14:15:01 pierre

7
rtl/dos/go32v2/system.pp
View File

@ -590,7 +590,7 @@ begin
end; end;
procedure int_stackcheck(stack_size:longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'STACKCHECK']; procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
{ {
called when trying to get local stack if the compiler directive $S called when trying to get local stack if the compiler directive $S
is set this function must preserve esi !!!! because esi is set by is set this function must preserve esi !!!! because esi is set by
@ -1227,7 +1227,10 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.24 1998-11-29 22:28:10 peter Revision 1.25 1998-12-15 22:42:52 peter
* removed temp symbols
Revision 1.24 1998/11/29 22:28:10 peter
+ io-error 103 added + io-error 103 added
Revision 1.23 1998/11/16 14:15:02 pierre Revision 1.23 1998/11/16 14:15:02 pierre

25
rtl/dos/graph.pp
View File

@ -28,9 +28,7 @@ unit GRAPH;
{$endif DEBUG} {$endif DEBUG}
{ Don't use smartlinking, because of the direct assembler that is used } { Don't use smartlinking, because of the direct assembler that is used }
{$ifndef VER0_99_8}
{$SMARTLINK OFF} {$SMARTLINK OFF}
{$endif not VER0_99_8}
interface interface
@ -151,7 +149,7 @@ procedure FillTriangle(A,B,C:Pointtype);
function ColorsEqual(c1,c2 : longint) : boolean; function ColorsEqual(c1,c2 : longint) : boolean;
{ this will return true if the two colors will appear { this will return true if the two colors will appear
equal in the current video mode } equal in the current video mode }
procedure WaitRetrace; procedure WaitRetrace;
{$ifdef debug} {$ifdef debug}
procedure pixel(offset:longint); procedure pixel(offset:longint);
@ -276,7 +274,7 @@ var { X/Y Verhaeltnis des Bildschirm }
used by getGraphMode PM } used by getGraphMode PM }
oldCRTMode : integer; oldCRTMode : integer;
InTempCRTMode : boolean; InTempCRTMode : boolean;
{ Position des Graphikcursors } { Position des Graphikcursors }
curx,cury : longint; curx,cury : longint;
{ true, wenn die Routinen des Graphikpaketes verwendet werden d<>rfen } { true, wenn die Routinen des Graphikpaketes verwendet werden d<>rfen }
@ -334,7 +332,7 @@ var { X/Y Verhaeltnis des Bildschirm }
const const
AWindow = 0; AWindow = 0;
BWindow = 1; BWindow = 1;
{ Variables for Bankswitching } { Variables for Bankswitching }
var var
BytesPerLine : longint; BytesPerLine : longint;
@ -360,7 +358,7 @@ Begin
((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or ((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
((BytesPerPixel>2) and ((c1 and $FFFFFF)=(c2 and $FFFFFF))); ((BytesPerPixel>2) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
End; End;
function GraphErrorMsg(ErrorCode: Integer): string; function GraphErrorMsg(ErrorCode: Integer): string;
Begin Begin
GraphErrorMsg:=''; GraphErrorMsg:='';
@ -539,7 +537,7 @@ var bank1,bank2,diff,c:longint;
ofs1,ofs2 :longint; ofs1,ofs2 :longint;
y : integer; y : integer;
storewritemode : word; storewritemode : word;
begin begin
if not isgraphmode then if not isgraphmode then
begin begin
@ -711,7 +709,7 @@ procedure SetArrays;
for index:=0 to VESAInfo.YResolution do for index:=0 to VESAInfo.YResolution do
Y_Array[index]:=index * BytesPerLine + AktPageOffset; Y_Array[index]:=index * BytesPerLine + AktPageOffset;
end; end;
procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String); procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
var i : Integer; var i : Integer;
begin begin
@ -907,12 +905,12 @@ function GetVisualPage : word;
begin begin
GetVisualPage:=AktVisualPage; GetVisualPage:=AktVisualPage;
end; end;
function GetActivePage : word; function GetActivePage : word;
begin begin
GetActivePage:=AktPage; GetActivePage:=AktPage;
end; end;
{ mehrere Bildschirmseiten werden nicht unterst<73>tzt } { mehrere Bildschirmseiten werden nicht unterst<73>tzt }
{ Dummy aus Kompatibilit„tsgr<67>nden } { Dummy aus Kompatibilit„tsgr<67>nden }
procedure SetActivePage(page : word); procedure SetActivePage(page : word);
@ -936,7 +934,7 @@ function GetNumberOfPages : word;
begin begin
GetNumberOfPages:=VESAInfo.NumberOfPages; GetNumberOfPages:=VESAInfo.NumberOfPages;
end; end;
procedure SetWriteMode(WriteMode : integer); procedure SetWriteMode(WriteMode : integer);
begin begin
_graphresult:=grOk; _graphresult:=grOk;
@ -1011,7 +1009,10 @@ end.
{ {
$Log$ $Log$
Revision 1.14 1998-11-25 22:59:23 pierre Revision 1.15 1998-12-15 22:42:50 peter
* removed temp symbols
Revision 1.14 1998/11/25 22:59:23 pierre
* fillpoly works * fillpoly works
Revision 1.13 1998/11/25 13:04:43 pierre Revision 1.13 1998/11/25 13:04:43 pierre

53
rtl/i386/i386.inc
View File

@ -89,7 +89,7 @@ begin
end; end;
Procedure FillChar(var x;count:longint;value:byte);{[alias: 'FPC_FILL_OBJECT'];} Procedure FillChar(var x;count:longint;value:byte);
begin begin
asm asm
cld cld
@ -151,7 +151,7 @@ end;
{$ASMMODE DIRECT} {$ASMMODE DIRECT}
procedure int_help_constructor;assembler; [public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'HELP_CONSTRUCTOR']; procedure int_help_constructor;assembler; [public,alias:'FPC_HELP_CONSTRUCTOR'];
asm asm
{ Entry without preamble, since we need the ESP of the constructor { Entry without preamble, since we need the ESP of the constructor
Stack (relative to %ebp): Stack (relative to %ebp):
@ -174,11 +174,7 @@ asm
{ Memory size } { Memory size }
pushl (%eax) pushl (%eax)
pushl %esi pushl %esi
{$ifdef FPCNAMES}
call FPC_GETMEM call FPC_GETMEM
{$else}
call GETMEM
{$endif}
popal popal
{ Memory position to %esi } { Memory position to %esi }
movl (%esi),%esi movl (%esi),%esi
@ -215,18 +211,14 @@ asm
stosl stosl
popal popal
{ set the VMT address for the new created object } { set the VMT address for the new created object }
{$ifdef OBJECTVMTOFFSET}
{ the offset is in %edi since the calling and has not been changed !! } { the offset is in %edi since the calling and has not been changed !! }
movl %eax,(%esi,%edi,1) movl %eax,(%esi,%edi,1)
{$else OBJECTVMTOFFSET}
movl %eax,(%esi)
{$endif OBJECTVMTOFFSET}
orl %eax,%eax orl %eax,%eax
.LHC_5: .LHC_5:
end; end;
procedure int_help_destructor;assembler;[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'HELP_DESTRUCTOR']; procedure int_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR'];
asm asm
{ Stack (relative to %ebp): { Stack (relative to %ebp):
12 Self 12 Self
@ -243,12 +235,8 @@ asm
{ Yes, get size from SELF! } { Yes, get size from SELF! }
movl 12(%ebp),%eax movl 12(%ebp),%eax
{ get VMT-pointer (from Self) to %ebx } { get VMT-pointer (from Self) to %ebx }
{$ifdef OBJECTVMTOFFSET}
{ the offset is in %edi since the calling and has not been changed !! } { the offset is in %edi since the calling and has not been changed !! }
movl (%eax,%edi,1),%ebx movl (%eax,%edi,1),%ebx
{$else OBJECTVMTOFFSET}
movl (%eax),%ebx
{$endif OBJECTVMTOFFSET}
{ temporary Variable } { temporary Variable }
subl $4,%esp subl $4,%esp
movl %esp,%edi movl %esp,%edi
@ -260,18 +248,14 @@ asm
movl $0,(%eax) movl $0,(%eax)
movl %eax,(%edi) movl %eax,(%edi)
pushl %edi pushl %edi
{$ifdef FPCNAMES}
call FPC_FREEMEM call FPC_FREEMEM
{$else}
call FREEMEM
{$endif}
addl $4,%esp addl $4,%esp
.LHD_3: .LHD_3:
popal popal
end; end;
procedure int_new_class;assembler;[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'NEW_CLASS']; procedure int_new_class;assembler;[public,alias:'FPC_NEW_CLASS'];
asm asm
{ create class ? } { create class ? }
movl 8(%ebp),%edi movl 8(%ebp),%edi
@ -291,7 +275,7 @@ asm
end; end;
procedure int_dispose_class;assembler;[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'DISPOSE_CLASS']; procedure int_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS'];
asm asm
{ destroy class ? } { destroy class ? }
movl 8(%ebp),%edi movl 8(%ebp),%edi
@ -314,7 +298,7 @@ end;
{ checks for a correct vmt pointer } { checks for a correct vmt pointer }
procedure int_check_object;assembler;[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'CHECK_OBJECT']; procedure int_check_object;assembler;[public,alias:'FPC_CHECK_OBJECT'];
asm asm
pushl %edi pushl %edi
movl 8(%esp),%edi movl 8(%esp),%edi
@ -341,7 +325,7 @@ end;
String String
****************************************************************************} ****************************************************************************}
procedure int_strcopy(len:longint;sstr,dstr:pointer);[public,alias:{$ifdef NEWSTRNAMES}'FPC_SHORTSTR_COPY'{$else}{$ifdef FPCNAMES}'FPC_'+{$endif}'STRCOPY'{$endif}]; procedure int_strcopy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
{ {
this procedure must save all modified registers except EDI and ESI !!! this procedure must save all modified registers except EDI and ESI !!!
} }
@ -383,7 +367,7 @@ begin
end; end;
procedure int_strconcat(s1,s2:pointer);[public,alias:{$ifdef NEWSTRNAMES}'FPC_SHORTSTR_CONCAT'{$else}{$ifdef FPCNAMES}'FPC_'+{$endif}'STRCONCAT'{$endif}]; procedure int_strconcat(s1,s2:pointer);[public,alias:'FPC_SHORTSTR_CONCAT'];
begin begin
asm asm
xorl %ecx,%ecx xorl %ecx,%ecx
@ -422,7 +406,7 @@ begin
end; end;
procedure int_strcmp(dstr,sstr:pointer);[public,alias:{$ifdef NEWSTRNAMES}'FPC_SHORTSTR_COMPARE'{$else}{$ifdef FPCNAMES}'FPC_'+{$endif}'STRCMP'{$endif}]; procedure int_strcmp(dstr,sstr:pointer);[public,alias:'FPC_SHORTSTR_COMPARE'];
begin begin
asm asm
cld cld
@ -472,7 +456,7 @@ end;
{$ASMMODE DIRECT} {$ASMMODE DIRECT}
function strpas(p:pchar):string;[public,alias:{$ifdef NEWSTRNAMES}'FPC_PCHAR_TO_SHORTSTR'{$else}'FPC_PCHAR_TO_STR'{$endif}]; function strpas(p:pchar):string;[public,alias:'FPC_PCHAR_TO_SHORTSTR'];
begin begin
asm asm
cld cld
@ -557,7 +541,7 @@ end ['EAX'];
Math Math
****************************************************************************} ****************************************************************************}
function abs(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_abs];{$endif} function abs(l:longint):longint;assembler;[internconst:in_const_abs];
asm asm
movl l,%eax movl l,%eax
orl %eax,%eax orl %eax,%eax
@ -567,7 +551,7 @@ asm
end ['EAX']; end ['EAX'];
function odd(l:longint):boolean;assembler;{$ifdef INTERNCONST}[internconst:in_const_odd];{$endif} function odd(l:longint):boolean;assembler;[internconst:in_const_odd];
asm asm
movl l,%eax movl l,%eax
andl $1,%eax andl $1,%eax
@ -575,7 +559,7 @@ asm
end ['EAX']; end ['EAX'];
function sqr(l:longint):longint;assembler;{$ifdef INTERNCONST}[internconst:in_const_sqr];{$endif} function sqr(l:longint):longint;assembler;[internconst:in_const_sqr];
asm asm
mov l,%eax mov l,%eax
imull %eax,%eax imull %eax,%eax
@ -618,11 +602,7 @@ begin
movb $0x2d,1(%edi) // put '-' in String movb $0x2d,1(%edi) // put '-' in String
incl %ecx incl %ecx
.LM2: .LM2:
{$ifdef NOATTCDQ}
cltd cltd
{$else}
cdq
{$endif}
idivl %esi,%eax idivl %esi,%eax
addb $0x30,%dl // convert Rest to ASCII. addb $0x30,%dl // convert Rest to ASCII.
movb %dl,-12(%ebp,%ebx) movb %dl,-12(%ebp,%ebx)
@ -697,7 +677,7 @@ end;
IoCheck IoCheck
****************************************************************************} ****************************************************************************}
procedure int_iocheck(addr : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'IOCHECK']; procedure int_iocheck(addr : longint);[public,alias:'FPC_IOCHECK'];
var var
l : longint; l : longint;
begin begin
@ -724,7 +704,10 @@ end;
{ {
$Log$ $Log$
Revision 1.34 1998-11-30 15:27:28 pierre Revision 1.35 1998-12-15 22:42:53 peter
* removed temp symbols
Revision 1.34 1998/11/30 15:27:28 pierre
* vmt address pushed for CHECK_OBJECT was not removed from stack * vmt address pushed for CHECK_OBJECT was not removed from stack
Revision 1.33 1998/11/28 14:09:49 peter Revision 1.33 1998/11/28 14:09:49 peter

19
rtl/i386/math.inc
View File

@ -217,7 +217,7 @@
EXTENDED data type routines EXTENDED data type routines
****************************************************************************} ****************************************************************************}
function pi : extended;assembler;{$ifdef MORECONST}[internconst:in_const_pi];{$endif} function pi : extended;assembler;[internconst:in_const_pi];
asm asm
fldpi fldpi
end []; end [];
@ -238,14 +238,14 @@
end []; end [];
function sqrt(d : extended) : extended;assembler;{$ifdef MORECONST}[internconst:in_const_sqrt];{$endif} function sqrt(d : extended) : extended;assembler;[internconst:in_const_sqrt];
asm asm
fldt d fldt d
fsqrt fsqrt
end []; end [];
function arctan(d : extended) : extended;assembler;{$ifdef MORECONST}[internconst:in_const_arctan];{$endif} function arctan(d : extended) : extended;assembler;[internconst:in_const_arctan];
asm asm
fldt d fldt d
fld1 fld1
@ -253,7 +253,7 @@
end []; end [];
function cos(d : extended) : extended;assembler;{$ifdef MORECONST}[internconst:in_const_cos];{$endif} function cos(d : extended) : extended;assembler;[internconst:in_const_cos];
asm asm
fldt d fldt d
fcos fcos
@ -273,7 +273,7 @@
end ['EAX']; end ['EAX'];
function exp(d : extended) : extended;assembler;{$ifdef MORECONST}[internconst:in_const_exp];{$endif} function exp(d : extended) : extended;assembler;[internconst:in_const_exp];
asm asm
// comes from DJ GPP // comes from DJ GPP
fldt d fldt d
@ -376,7 +376,7 @@
end ['EAX','ECX']; end ['EAX','ECX'];
function ln(d : extended) : extended;assembler;{$ifdef MORECONST}[internconst:in_const_ln];{$endif} function ln(d : extended) : extended;assembler;[internconst:in_const_ln];
asm asm
fldln2 fldln2
fldt d fldt d
@ -384,7 +384,7 @@
end []; end [];
function sin(d : extended) : extended;assembler;{$ifdef MORECONST}[internconst:in_const_sin];{$endif} function sin(d : extended) : extended;assembler;[internconst:in_const_sin];
asm asm
fldt d fldt d
fsin fsin
@ -543,7 +543,10 @@
{ {
$Log$ $Log$
Revision 1.12 1998-11-24 12:54:57 peter Revision 1.13 1998-12-15 22:42:56 peter
* removed temp symbols
Revision 1.12 1998/11/24 12:54:57 peter
* removed all explicit leave;ret commands and let them generate by * removed all explicit leave;ret commands and let them generate by
the compiler (needed for stack alignment) the compiler (needed for stack alignment)

9
rtl/i386/mmx.pp
View File

@ -52,11 +52,7 @@ unit mmx;
uses uses
cpu; cpu;
{$ifndef CPUIDSUP}
{$ASMMODE DIRECT}
{$else}
{$ASMMODE ATT} {$ASMMODE ATT}
{$endif}
{ returns true, if the processor supports the mmx instructions } { returns true, if the processor supports the mmx instructions }
function mmx_support : boolean; function mmx_support : boolean;
@ -127,7 +123,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-11-13 10:10:54 peter Revision 1.4 1998-12-15 22:42:58 peter
* removed temp symbols
Revision 1.3 1998/11/13 10:10:54 peter
* ATT reader * ATT reader
Revision 1.2 1998/05/31 14:15:50 peter Revision 1.2 1998/05/31 14:15:50 peter

26
rtl/i386/rttip.inc
View File

@ -16,8 +16,7 @@
{ Run-Time type information routines - processor dependent part } { Run-Time type information routines - processor dependent part }
{$ASMMODE DIRECT} {$ASMMODE DIRECT}
Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'{$ifndef FPC_NAMES},alias:'INITIALIZE'{$endif}];assembler; Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE'];assembler;
asm asm
# Save registers # Save registers
push %eax push %eax
@ -109,8 +108,8 @@ asm
pop %eax pop %eax
end; end;
Procedure Finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'{$ifndef FPC_NAMES},alias:'FINALIZE'{$endif}]; assembler;
Procedure Finalize (Data,TypeInfo: Pointer);[Public,Alias:'FPC_FINALIZE'];assembler;
asm asm
push %eax push %eax
push %ebx push %ebx
@ -192,11 +191,7 @@ asm
# AnsiString handling : # AnsiString handling :
.DoAnsiStringFinal: .DoAnsiStringFinal:
pushl 8(%ebp) pushl 8(%ebp)
{$ifdef NEWSTRNAMES}
call FPC_ANSISTR_DECR_REF call FPC_ANSISTR_DECR_REF
{$else}
call FPC_DECR_ANSI_REF
{$endif}
.ExitFinalize: .ExitFinalize:
pop %edx pop %edx
pop %ecx pop %ecx
@ -204,8 +199,8 @@ asm
pop %eax pop %eax
end; end;
Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler;
Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler;
asm asm
# Save registers # Save registers
push %eax push %eax
@ -281,11 +276,7 @@ asm
# AnsiString handling : # AnsiString handling :
.DoAnsiStringAddRef: .DoAnsiStringAddRef:
pushl 8(%ebp) pushl 8(%ebp)
{$ifdef NEWSTRNAMES}
call FPC_ANSISTR_INCR_REF call FPC_ANSISTR_INCR_REF
{$else}
call FPC_INCR_ANSI_REF
{$endif}
.ExitAddRef: .ExitAddRef:
pop %edx pop %edx
pop %ecx pop %ecx
@ -293,8 +284,8 @@ asm
pop %eax pop %eax
end; end;
Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler;
Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler;
asm asm
# Save registers # Save registers
push %eax push %eax
@ -371,11 +362,7 @@ asm
.DoAnsiStringDecRef: .DoAnsiStringDecRef:
movl 8(%ebp),%eax movl 8(%ebp),%eax
pushl %eax pushl %eax
{$ifdef NEWSTRNAMES}
call FPC_ANSISTR_DECR_REF call FPC_ANSISTR_DECR_REF
{$else}
call FPC_DECR_ANSI_REF
{$endif}
.ExitDecRef: .ExitDecRef:
pop %edx pop %edx
pop %ecx pop %ecx
@ -387,7 +374,10 @@ end;
{ {
$Log$ $Log$
Revision 1.12 1998-11-30 10:07:34 michael Revision 1.13 1998-12-15 22:42:59 peter
* removed temp symbols
Revision 1.12 1998/11/30 10:07:34 michael
+ Adjusted typeinfo constants + Adjusted typeinfo constants
Revision 1.11 1998/11/17 00:41:10 peter Revision 1.11 1998/11/17 00:41:10 peter

41
rtl/i386/set.inc
View File

@ -16,7 +16,7 @@
{$ASMMODE ATT} {$ASMMODE ATT}
procedure do_load_small(p : pointer;l:longint);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_LOAD_SMALL']; procedure do_load_small(p : pointer;l:longint);assembler;[public,alias:'FPC_SET_LOAD_SMALL'];
{ {
load a normal set p from a smallset l load a normal set p from a smallset l
} }
@ -55,8 +55,7 @@ asm
popl %eax popl %eax
end; end;
procedure do_set_byte(p : pointer;b : byte);assembler; procedure do_set_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_SET_BYTE'];
[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SET_BYTE'];
{ {
add the element b to the set pointed by p add the element b to the set pointed by p
} }
@ -74,8 +73,7 @@ asm
end; end;
procedure do_unset_byte(p : pointer;b : byte);assembler; procedure do_unset_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_UNSET_BYTE'];
[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_UNSET_BYTE'];
{ {
suppresses the element b to the set pointed by p suppresses the element b to the set pointed by p
used for exclude(set,element) used for exclude(set,element)
@ -94,7 +92,7 @@ asm
end; end;
procedure do_set_range(p : pointer;l,h : byte);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SET_RANGE']; procedure do_set_range(p : pointer;l,h : byte);assembler;[public,alias:'FPC_SET_SET_RANGE'];
{ {
bad implementation, but it's very seldom used bad implementation, but it's very seldom used
} }
@ -121,7 +119,7 @@ asm
end; end;
procedure do_in_byte(p : pointer;b : byte);assembler;[public,alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'SET_IN_BYTE']; procedure do_in_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_IN_BYTE'];
{ {
tests if the element b is in the set p the carryflag is set if it present tests if the element b is in the set p the carryflag is set if it present
} }
@ -140,7 +138,7 @@ end;
procedure do_add_sets(set1,set2,dest : pointer);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_ADD_SETS']; procedure do_add_sets(set1,set2,dest : pointer);assembler;[public,alias:'FPC_SET_ADD_SETS'];
{ {
adds set1 and set2 into set dest adds set1 and set2 into set dest
} }
@ -160,7 +158,7 @@ end;
procedure do_mul_sets(set1,set2,dest:pointer);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_MUL_SETS']; procedure do_mul_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_MUL_SETS'];
{ {
multiplies (takes common elements of) set1 and set2 result put in dest multiplies (takes common elements of) set1 and set2 result put in dest
} }
@ -179,7 +177,7 @@ asm
end; end;
procedure do_sub_sets(set1,set2,dest:pointer);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SUB_SETS']; procedure do_sub_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SUB_SETS'];
{ {
computes the diff from set1 to set2 result in dest computes the diff from set1 to set2 result in dest
} }
@ -200,7 +198,7 @@ asm
end; end;
procedure do_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SYMDIF_SETS']; procedure do_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SYMDIF_SETS'];
{ {
computes the symetric diff from set1 to set2 result in dest computes the symetric diff from set1 to set2 result in dest
} }
@ -220,7 +218,7 @@ asm
end; end;
procedure do_comp_sets(set1,set2 : pointer);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_COMP_SETS']; procedure do_comp_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_COMP_SETS'];
{ {
compares set1 and set2 zeroflag is set if they are equal compares set1 and set2 zeroflag is set if they are equal
} }
@ -245,7 +243,7 @@ end;
{$ifdef LARGESETS} {$ifdef LARGESETS}
procedure do_set(p : pointer;b : word);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SET_WORD']; procedure do_set(p : pointer;b : word);assembler;[public,alias:'FPC_SET_SET_WORD'];
{ {
sets the element b in set p works for sets larger than 256 elements sets the element b in set p works for sets larger than 256 elements
not yet use by the compiler so not yet use by the compiler so
@ -264,7 +262,7 @@ asm
end; end;
procedure do_in(p : pointer;b : word);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_IN_WORD']; procedure do_in(p : pointer;b : word);assembler;[public,alias:'FPC_SET_IN_WORD'];
{ {
tests if the element b is in the set p the carryflag is set if it present tests if the element b is in the set p the carryflag is set if it present
works for sets larger than 256 elements works for sets larger than 256 elements
@ -283,7 +281,7 @@ asm
end; end;
procedure add_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_ADD_SETS_SIZE']; procedure add_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_ADD_SETS_SIZE'];
{ {
adds set1 and set2 into set dest size is the number of bytes in the set adds set1 and set2 into set dest size is the number of bytes in the set
} }
@ -302,7 +300,7 @@ asm
end; end;
procedure mul_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_MUL_SETS_SIZE']; procedure mul_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_MUL_SETS_SIZE'];
{ {
multiplies (i.E. takes common elements of) set1 and set2 result put in multiplies (i.E. takes common elements of) set1 and set2 result put in
dest size is the number of bytes in the set dest size is the number of bytes in the set
@ -322,7 +320,7 @@ asm
end; end;
procedure sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SUB_SETS_SIZE']; procedure sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SUB_SETS_SIZE'];
asm asm
movl set1,%esi movl set1,%esi
movl set2,%ebx movl set2,%ebx
@ -340,7 +338,7 @@ asm
end; end;
procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SYMDIF_SETS_SIZE']; procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SYMDIF_SETS_SIZE'];
{ {
computes the symetric diff from set1 to set2 result in dest computes the symetric diff from set1 to set2 result in dest
} }
@ -360,7 +358,7 @@ asm
end; end;
procedure comp_sets(set1,set2 : pointer;size : longint);assembler;[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_COMP_SETS_SIZE']; procedure comp_sets(set1,set2 : pointer;size : longint);assembler;[public,alias:'FPC_SET_COMP_SETS_SIZE'];
asm asm
movl set1,%esi movl set1,%esi
movl set2,%edi movl set2,%edi
@ -383,7 +381,10 @@ end;
{ {
$Log$ $Log$
Revision 1.7 1998-11-24 12:54:01 peter Revision 1.8 1998-12-15 22:43:00 peter
* removed temp symbols
Revision 1.7 1998/11/24 12:54:01 peter
+ FPC_SET_CREATE_ELEMENT + FPC_SET_CREATE_ELEMENT
Revision 1.6 1998/10/22 14:50:08 pierre Revision 1.6 1998/10/22 14:50:08 pierre

11
rtl/inc/astrings.inc
View File

@ -114,7 +114,7 @@ begin
end; end;
Procedure Decr_Ansi_Ref (Var S : Pointer);[Public,Alias:{$ifdef NEWSTRNAMES}'FPC_ANSISTR_DECR_REF'{$else}'FPC_DECR_ANSI_REF'{$endif}]; Procedure Decr_Ansi_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_DECR_REF'];
{ {
Decreases the ReferenceCount of a non constant ansistring; Decreases the ReferenceCount of a non constant ansistring;
If the reference count is zero, deallocate the string; If the reference count is zero, deallocate the string;
@ -136,7 +136,7 @@ Begin
end; end;
Procedure Incr_Ansi_Ref (Var S : Pointer);[Public,Alias:{$ifdef NEWSTRNAMES}'FPC_ANSISTR_INCR_REF'{$else}'FPC_INCR_ANSI_REF'{$endif}]; Procedure Incr_Ansi_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_INCR_REF'];
Begin Begin
If S=Nil then If S=Nil then
exit; exit;
@ -167,7 +167,7 @@ begin
end; end;
Procedure AssignAnsiString (Var S1 : Pointer;S2 : Pointer);[Public,Alias:{$ifdef NEWSTRNAMES}'FPC_ANSISTR_ASSIGN'{$else}'FPC_ASSIGN_ANSI_STRING'{$endif}]; Procedure AssignAnsiString (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_ANSISTR_ASSIGN'];
{ {
Assigns S2 to S1 (S1:=S2), taking in account reference counts. Assigns S2 to S1 (S1:=S2), taking in account reference counts.
} }
@ -722,7 +722,10 @@ end;
{ {
$Log$ $Log$
Revision 1.4 1998-11-18 10:56:46 michael Revision 1.5 1998-12-15 22:43:01 peter
* removed temp symbols
Revision 1.4 1998/11/18 10:56:46 michael
+ Fixed pchar2ansi + Fixed pchar2ansi
Revision 1.3 1998/11/17 12:16:07 michael Revision 1.3 1998/11/17 12:16:07 michael

19
rtl/inc/sstrings.inc
View File

@ -248,7 +248,7 @@ end;
Str() Helpers Str() Helpers
*****************************************************************************} *****************************************************************************}
procedure int_str_real(d : real;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_REAL'{$else}'STR_REAL'{$endif}]; procedure int_str_real(d : real;len,fr : longint;var s : shortstring);[public,alias:'FPC_STR_REAL'];
begin begin
{$ifdef i386} {$ifdef i386}
str_real(len,fr,d,rt_s64real,s); str_real(len,fr,d,rt_s64real,s);
@ -259,7 +259,7 @@ end;
{$ifdef SUPPORT_SINGLE} {$ifdef SUPPORT_SINGLE}
procedure int_str_single(d : single;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_SINGLE'{$else}'STR_SINGLE'{$endif}]; procedure int_str_single(d : single;len,fr : longint;var s : shortstring);[public,alias:'FPC_STR_SINGLE'];
begin begin
str_real(len,fr,d,rt_s32real,s); str_real(len,fr,d,rt_s32real,s);
end; end;
@ -267,7 +267,7 @@ end;
{$ifdef SUPPORT_EXTENDED} {$ifdef SUPPORT_EXTENDED}
procedure int_str_extended(d : extended;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_EXTENDED'{$else}'STR_EXTENDED'{$endif}]; procedure int_str_extended(d : extended;len,fr : longint;var s : shortstring);[public,alias:'FPC_STR_EXTENDED'];
begin begin
str_real(len,fr,d,rt_s80real,s); str_real(len,fr,d,rt_s80real,s);
end; end;
@ -275,7 +275,7 @@ end;
{$ifdef SUPPORT_COMP} {$ifdef SUPPORT_COMP}
procedure int_str_comp(d : comp;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_COMP'{$else}'STR_COMP'{$endif}]; procedure int_str_comp(d : comp;len,fr : longint;var s : shortstring);[public,alias:'FPC_STR_COMP'];
begin begin
str_real(len,fr,d,rt_s64bit,s); str_real(len,fr,d,rt_s64bit,s);
end; end;
@ -283,14 +283,14 @@ end;
{$ifdef SUPPORT_FIXED} {$ifdef SUPPORT_FIXED}
procedure int_str_fixed(d : fixed;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_FIXED'{$else}'STR_FIXED'{$endif}]; procedure int_str_fixed(d : fixed;len,fr : longint;var s : shortstring);[public,alias:'FPC_STR_FIXED'];
begin begin
str_real(len,fr,d,rt_f32bit,s); str_real(len,fr,d,rt_f32bit,s);
end; end;
{$endif SUPPORT_FIXED} {$endif SUPPORT_FIXED}
procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_LONGINT'{$else}'STR_LONGINT'{$endif}]; procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public,alias:'FPC_STR_LONGINT'];
begin begin
int_str(v,s); int_str(v,s);
if length(s)<len then if length(s)<len then
@ -298,7 +298,7 @@ begin
end; end;
procedure int_str_cardinal(v : cardinal;len : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_CARDINAL'{$else}'STR_CARDINAL'{$endif}]; procedure int_str_cardinal(v : cardinal;len : longint;var s : shortstring);[public,alias:'FPC_STR_CARDINAL'];
begin begin
int_str(v,s); int_str(v,s);
if length(s)<len then if length(s)<len then
@ -937,7 +937,10 @@ end;
{ {
$Log$ $Log$
Revision 1.16 1998-11-05 10:29:34 pierre Revision 1.17 1998-12-15 22:43:02 peter
* removed temp symbols
Revision 1.16 1998/11/05 10:29:34 pierre
* fix for length(char) in const expressions * fix for length(char) in const expressions
Revision 1.15 1998/11/04 10:20:50 peter Revision 1.15 1998/11/04 10:20:50 peter

11
rtl/inc/system.inc
View File

@ -275,7 +275,7 @@ end;
Miscellaneous Miscellaneous
*****************************************************************************} *****************************************************************************}
procedure int_overflow;[public,alias: {$ifdef FPCNAMES}'FPC_OVERFLOW'{$else}'RE_OVERFLOW'{$endif}]; procedure int_overflow;[public,alias:'FPC_OVERFLOW'];
var var
addr : longint; addr : longint;
begin begin
@ -378,7 +378,7 @@ Begin
End; End;
Procedure do_exit;[Public,Alias: {$ifdef FPCNAMES}'FPC_DO_EXIT'{$else}'__EXIT'{$endif}]; Procedure do_exit;[Public,Alias:'FPC_DO_EXIT'];
{ {
Don't call this direct, the call is generated by the compiler Don't call this direct, the call is generated by the compiler
and by the halt procedure. and by the halt procedure.
@ -480,7 +480,7 @@ end;
{***************************************************************************** {*****************************************************************************
SetJmp/LongJmp support. SetJmp/LongJmp support.
*****************************************************************************} *****************************************************************************}
{$i setjump.inc} {$i setjump.inc}
@ -488,7 +488,10 @@ end;
{ {
$Log$ $Log$
Revision 1.46 1998-12-10 23:59:56 peter Revision 1.47 1998-12-15 22:43:03 peter
* removed temp symbols
Revision 1.46 1998/12/10 23:59:56 peter
* removed warnign * removed warnign
Revision 1.45 1998/12/01 14:00:10 pierre Revision 1.45 1998/12/01 14:00:10 pierre

17
rtl/inc/systemh.inc
View File

@ -27,9 +27,7 @@
{$I-,Q-,H-,R-,V-} {$I-,Q-,H-,R-,V-}
{ needed for insert,delete,readln } { needed for insert,delete,readln }
{$ifdef OPENSTRINGS} {$P+}
{$P+}
{$endif}
{ Stack check gives a note under linux } { Stack check gives a note under linux }
{$ifndef linux} {$ifndef linux}
@ -64,19 +62,13 @@ Type
{$endif} {$endif}
{$ifdef m68k} {$ifdef m68k}
StrLenInt = Integer; StrLenInt = Longint;
ValReal = Real; ValReal = Real;
{$ifdef USEANSISTRINGS}
{$error StrLenInt must be a longint if ansi strings are used}
{$endif}
{$endif} {$endif}
{ some type aliases } { some type aliases }
dword = cardinal; dword = cardinal;
longword = cardinal; longword = cardinal;
{$ifndef useansistrings}
shortstring = string;
{$endif}
{ Zero - terminated strings } { Zero - terminated strings }
PChar = ^Char; PChar = ^Char;
@ -437,7 +429,10 @@ const
{ {
$Log$ $Log$
Revision 1.44 1998-11-27 14:50:57 peter Revision 1.45 1998-12-15 22:43:04 peter
* removed temp symbols
Revision 1.44 1998/11/27 14:50:57 peter
+ open strings, $P switch support + open strings, $P switch support
Revision 1.43 1998/11/26 23:16:13 jonas Revision 1.43 1998/11/26 23:16:13 jonas

89
rtl/inc/text.inc
View File

@ -401,14 +401,14 @@ begin
end; end;
Procedure Write_End(var f:TextRec);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_END']; Procedure Write_End(var f:TextRec);[Public,Alias:'FPC_WRITE_END'];
begin begin
if f.FlushFunc<>nil then if f.FlushFunc<>nil then
FileFunc(f.FlushFunc)(f); FileFunc(f.FlushFunc)(f);
end; end;
Procedure Writeln_End(var f:TextRec);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'WRITELN_END']; Procedure Writeln_End(var f:TextRec);[Public,Alias:'FPC_WRITELN_END'];
const const
{$IFDEF SHORT_LINEBREAK} {$IFDEF SHORT_LINEBREAK}
eollen=1; eollen=1;
@ -427,7 +427,7 @@ begin
end; end;
Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_STRING']; Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias:'FPC_WRITE_TEXT_STRING'];
Begin Begin
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -444,7 +444,7 @@ End;
Type Type
array00 = array[0..0] Of Char; array00 = array[0..0] Of Char;
Procedure Write_Array(Len : Longint;var f : TextRec;const p : array00);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_PCHAR_AS_ARRAY']; Procedure Write_Array(Len : Longint;var f : TextRec;const p : array00);[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY'];
var var
ArrayLen : longint; ArrayLen : longint;
Begin Begin
@ -462,7 +462,7 @@ Begin
End; End;
Procedure Write_PChar(Len : Longint;var f : TextRec;p : PChar);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_PCHAR_AS_POINTER']; Procedure Write_PChar(Len : Longint;var f : TextRec;p : PChar);[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_POINTER'];
var var
PCharLen : longint; PCharLen : longint;
Begin Begin
@ -480,7 +480,7 @@ Begin
End; End;
Procedure Write_Text_AnsiString (Len : Longint; Var T : TextRec; S : Pointer);[Public, alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_ANSISTRING']; Procedure Write_Text_AnsiString (Len : Longint; Var T : TextRec; S : Pointer);[Public,alias:'FPC_WRITE_TEXT_ANSISTRING'];
{ {
Writes a AnsiString to the Text file T Writes a AnsiString to the Text file T
} }
@ -491,7 +491,7 @@ begin
end; end;
Procedure Write_LongInt(Len : Longint;var t : TextRec;l : Longint);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_LONGINT']; Procedure Write_LongInt(Len : Longint;var t : TextRec;l : Longint);[Public,Alias:'FPC_WRITE_TEXT_LONGINT'];
var var
s : String; s : String;
Begin Begin
@ -502,7 +502,7 @@ Begin
End; End;
Procedure Write_Real(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_REAL']; Procedure Write_Real(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias:'FPC_WRITE_TEXT_REAL'];
var var
s : String; s : String;
Begin Begin
@ -517,7 +517,7 @@ Begin
End; End;
Procedure Write_Cardinal(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_CARDINAL']; Procedure Write_Cardinal(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias:'FPC_WRITE_TEXT_CARDINAL'];
var var
s : String; s : String;
Begin Begin
@ -529,7 +529,7 @@ End;
{$ifdef SUPPORT_SINGLE} {$ifdef SUPPORT_SINGLE}
Procedure Write_Single(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_SINGLE']; Procedure Write_Single(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias:'FPC_WRITE_TEXT_SINGLE'];
var var
s : String; s : String;
Begin Begin
@ -542,7 +542,7 @@ End;
{$ifdef SUPPORT_EXTENDED} {$ifdef SUPPORT_EXTENDED}
Procedure Write_Extended(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_EXTENDED']; Procedure Write_Extended(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias:'FPC_WRITE_TEXT_EXTENDED'];
var var
s : String; s : String;
Begin Begin
@ -555,7 +555,7 @@ End;
{$ifdef SUPPORT_COMP} {$ifdef SUPPORT_COMP}
Procedure Write_Comp(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_COMP']; Procedure Write_Comp(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias:'FPC_WRITE_TEXT_COMP'];
var var
s : String; s : String;
Begin Begin
@ -568,7 +568,7 @@ End;
{$ifdef SUPPORT_FIXED} {$ifdef SUPPORT_FIXED}
Procedure Write_Fixed(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_FIXED']; Procedure Write_Fixed(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias:'FPC_WRITE_TEXT_FIXED'];
var var
s : String; s : String;
Begin Begin
@ -580,7 +580,7 @@ End;
{$endif SUPPORT_FIXED} {$endif SUPPORT_FIXED}
Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_BOOLEAN']; Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias:'FPC_WRITE_TEXT_BOOLEAN'];
Begin Begin
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -592,7 +592,7 @@ Begin
End; End;
Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'WRITE_TEXT_CHAR']; Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias:'FPC_WRITE_TEXT_CHAR'];
Begin Begin
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -692,14 +692,14 @@ begin
end; end;
Procedure Read_End(var f:TextRec);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_END']; Procedure Read_End(var f:TextRec);[Public,Alias:'FPC_READ_END'];
begin begin
if f.FlushFunc<>nil then if f.FlushFunc<>nil then
FileFunc(f.FlushFunc)(f); FileFunc(f.FlushFunc)(f);
end; end;
Procedure ReadLn_End(var f : TextRec);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READLN_END']; Procedure ReadLn_End(var f : TextRec);[Public,Alias:'FPC_READLN_END'];
Begin Begin
{ Check error and if file is open and load buf if empty } { Check error and if file is open and load buf if empty }
If (InOutRes<>0) then If (InOutRes<>0) then
@ -726,15 +726,9 @@ Begin
End; End;
{$ifdef OPENSTRINGS} Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:'FPC_READ_TEXT_STRING'];
Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_STRING'];
{$else}
Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_STRING'];
{$endif}
var var
{$ifdef OPENSTRINGS}
maxlen, maxlen,
{$endif}
sPos,len : Longint; sPos,len : Longint;
p,startp,maxp : pchar; p,startp,maxp : pchar;
Begin Begin
@ -750,9 +744,7 @@ Begin
end; end;
{ Read maximal until Maxlen is reached } { Read maximal until Maxlen is reached }
sPos:=0; sPos:=0;
{$ifdef OPENSTRINGS}
MaxLen:=high(s); MaxLen:=high(s);
{$endif}
repeat repeat
If f.BufPos>=f.BufEnd Then If f.BufPos>=f.BufEnd Then
begin begin
@ -790,7 +782,7 @@ Begin
End; End;
Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_CHAR']; Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias:'FPC_READ_TEXT_CHAR'];
Begin Begin
c:=#0; c:=#0;
{ Check error and if file is open } { Check error and if file is open }
@ -816,7 +808,7 @@ Begin
end; end;
Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_PCHAR_AS_POINTER']; Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER'];
var var
p,maxp,startp,sidx : PChar; p,maxp,startp,sidx : PChar;
len : longint; len : longint;
@ -864,7 +856,7 @@ Begin
End; End;
Procedure Read_Array(var f : TextRec;var s : array00);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_PCHAR_AS_ARRAY']; Procedure Read_Array(var f : TextRec;var s : array00);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY'];
var var
p,maxp,startp,sidx : PChar; p,maxp,startp,sidx : PChar;
len : longint; len : longint;
@ -912,17 +904,10 @@ Begin
End; End;
{$ifdef OPENSTRINGS} Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias:'FPC_READ_TEXT_ANSISTRING'];
Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
{$else}
Procedure Read_AnsiString(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
{$endif}
var var
p,maxp,startp,sidx : PChar; p,maxp,startp,sidx : PChar;
{$ifdef OPENSTRINGS} maxlen,spos,len : longint;
maxlen,
{$endif}
spos,len : longint;
Begin Begin
{ Delete the string } { Delete the string }
Decr_ansi_ref (Pointer(S)); Decr_ansi_ref (Pointer(S));
@ -981,7 +966,7 @@ Begin
End; End;
Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_LONGINT']; Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias:'FPC_READ_TEXT_LONGINT'];
var var
hs : String; hs : String;
code : Word; code : Word;
@ -1007,7 +992,7 @@ Begin
End; End;
Procedure Read_Integer(var f : TextRec;var l : Integer);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_INTEGER']; Procedure Read_Integer(var f : TextRec;var l : Integer);[Public,Alias:'FPC_READ_TEXT_INTEGER'];
var var
ll : Longint; ll : Longint;
Begin Begin
@ -1021,7 +1006,7 @@ Begin
End; End;
Procedure Read_Word(var f : TextRec;var l : Word);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_WORD']; Procedure Read_Word(var f : TextRec;var l : Word);[Public,Alias:'FPC_READ_TEXT_WORD'];
var var
ll : Longint; ll : Longint;
Begin Begin
@ -1035,7 +1020,7 @@ Begin
End; End;
Procedure Read_Byte(var f : TextRec;var l : byte);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_BYTE']; Procedure Read_Byte(var f : TextRec;var l : byte);[Public,Alias:'FPC_READ_TEXT_BYTE'];
var var
ll : Longint; ll : Longint;
Begin Begin
@ -1049,7 +1034,7 @@ Begin
End; End;
Procedure Read_Shortint(var f : TextRec;var l : shortint);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_SHORTINT']; Procedure Read_Shortint(var f : TextRec;var l : shortint);[Public,Alias:'FPC_READ_TEXT_SHORTINT'];
var var
ll : Longint; ll : Longint;
Begin Begin
@ -1063,7 +1048,7 @@ Begin
End; End;
Procedure Read_Cardinal(var f : TextRec;var l : cardinal);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_CARDINAL']; Procedure Read_Cardinal(var f : TextRec;var l : cardinal);[Public,Alias:'FPC_READ_TEXT_CARDINAL'];
var var
hs : String; hs : String;
code : Word; code : Word;
@ -1088,6 +1073,7 @@ Begin
HandleError(106); HandleError(106);
End; End;
function ReadRealStr(var f:TextRec):string; function ReadRealStr(var f:TextRec):string;
var var
hs : string; hs : string;
@ -1130,7 +1116,7 @@ begin
end; end;
Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_REAL']; Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias:'FPC_READ_TEXT_REAL'];
var var
code : Word; code : Word;
Begin Begin
@ -1141,7 +1127,7 @@ End;
{$ifdef SUPPORT_SINGLE} {$ifdef SUPPORT_SINGLE}
Procedure Read_Single(var f : TextRec;var d : single);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_SINGLE']; Procedure Read_Single(var f : TextRec;var d : single);[Public,Alias:'FPC_READ_TEXT_SINGLE'];
var var
code : Word; code : Word;
Begin Begin
@ -1153,7 +1139,7 @@ End;
{$ifdef SUPPORT_EXTENDED} {$ifdef SUPPORT_EXTENDED}
Procedure Read_Extended(var f : TextRec;var d : extended);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_EXTENDED']; Procedure Read_Extended(var f : TextRec;var d : extended);[Public,Alias:'FPC_READ_TEXT_EXTENDED'];
var var
code : Word; code : Word;
Begin Begin
@ -1165,7 +1151,7 @@ End;
{$ifdef SUPPORT_COMP} {$ifdef SUPPORT_COMP}
Procedure Read_Comp(var f : TextRec;var d : comp);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_COMP']; Procedure Read_Comp(var f : TextRec;var d : comp);[Public,Alias:'FPC_READ_TEXT_COMP'];
var var
code : Word; code : Word;
Begin Begin
@ -1177,7 +1163,7 @@ End;
{$ifdef SUPPORT_FIXED} {$ifdef SUPPORT_FIXED}
Procedure Read_Fixed(var f : TextRec;var d : fixed);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_FIXED']; Procedure Read_Fixed(var f : TextRec;var d : fixed);[Public,Alias:'FPC_READ_TEXT_FIXED'];
var var
code : Word; code : Word;
Begin Begin
@ -1212,7 +1198,10 @@ end;
{ {
$Log$ $Log$
Revision 1.36 1998-12-11 18:07:39 peter Revision 1.37 1998-12-15 22:43:06 peter
* removed temp symbols
Revision 1.36 1998/12/11 18:07:39 peter
* fixed read(char) with empty buffer * fixed read(char) with empty buffer
Revision 1.35 1998/11/27 14:50:58 peter Revision 1.35 1998/11/27 14:50:58 peter

9
rtl/linux/filutil.inc
View File

@ -112,11 +112,7 @@ Var SInfo : Stat;
begin begin
P:=pglob(Info.FindHandle); P:=pglob(Info.FindHandle);
{$ifdef AUTOOBJPAS}
Result:=Fstat(p^.name,SInfo); Result:=Fstat(p^.name,SInfo);
{$else}
Result:=Fstat(StrPas(p^.name),SInfo);
{$endif}
Info.FindHandle:=Longint(P^.Next); Info.FindHandle:=Longint(P^.Next);
P^.Next:=Nil; P^.Next:=Nil;
GlobFree(P); GlobFree(P);
@ -235,7 +231,10 @@ end;
{ {
$Log$ $Log$
Revision 1.3 1998-11-10 14:57:55 peter Revision 1.4 1998-12-15 22:43:07 peter
* removed temp symbols
Revision 1.3 1998/11/10 14:57:55 peter
* renamed rename -> FRename * renamed rename -> FRename
Revision 1.2 1998/10/13 10:20:07 peter Revision 1.2 1998/10/13 10:20:07 peter

15
rtl/linux/syslinux.pp
View File

@ -39,15 +39,7 @@ const
{$I heaph.inc} {$I heaph.inc}
const const
{$ifndef VER0_99_5} UnusedHandle = -1;
{$ifndef VER0_99_6}
UnusedHandle = -1;
{$else}
UnusedHandle = $ffff;
{$endif}
{$else}
UnusedHandle = $ffff;
{$endif}
StdInputHandle = 0; StdInputHandle = 0;
StdOutputHandle = 1; StdOutputHandle = 1;
StdErrorHandle = 2; StdErrorHandle = 2;
@ -739,7 +731,10 @@ End.
{ {
$Log$ $Log$
Revision 1.18 1998-11-16 10:21:32 peter Revision 1.19 1998-12-15 22:43:08 peter
* removed temp symbols
Revision 1.18 1998/11/16 10:21:32 peter
* fixes for H+ * fixes for H+
Revision 1.17 1998/10/15 08:30:00 peter Revision 1.17 1998/10/15 08:30:00 peter

44
rtl/objpas/sysstr.inc
View File

@ -408,12 +408,8 @@ function StrToInt(const S: string): integer;
var Error: word; var Error: word;
begin begin
Val(S, result, Error); Val(S, result, Error);
{$ifdef autoobjpas}
if Error <> 0 then raise EConvertError.createfmt(SInValidInteger,[S]); if Error <> 0 then raise EConvertError.createfmt(SInValidInteger,[S]);
{$else}
if Error <> 0 then raise EConvertError.create(s + ' is not a valid integer');
{$endif}
end ; end ;
{ StrToIntDef converts the string S to an integer value, { StrToIntDef converts the string S to an integer value,
@ -435,11 +431,9 @@ end ;
{ FmtLoadStr returns the string resource Ident and formats it accordingly } { FmtLoadStr returns the string resource Ident and formats it accordingly }
{$ifdef autoobjpas}
function FmtLoadStr(Ident: integer; const Args: array of const): string; function FmtLoadStr(Ident: integer; const Args: array of const): string;
begin begin
end; end;
{$endif}
Const Const
feInvalidFormat = 1; feInvalidFormat = 1;
@ -461,18 +455,14 @@ Var S : String;
begin begin
//!! must be changed to contain format string... //!! must be changed to contain format string...
S:=''; S:='';
{$ifdef autoobjpas}
Case ErrCode of Case ErrCode of
feInvalidFormat : EConvertError.Createfmt(SInvalidFormat,[s]); feInvalidFormat : EConvertError.Createfmt(SInvalidFormat,[s]);
feMissingArgument : EConvertError.Createfmt(SArgumentMissing,[s]); feMissingArgument : EConvertError.Createfmt(SArgumentMissing,[s]);
feInvalidArgIndex : EConvertError.Createfmt(SInvalidArgIndex,[s]); feInvalidArgIndex : EConvertError.Createfmt(SInvalidArgIndex,[s]);
end; end;
{$else}
EConvertError.Create('Invalid format encountered : '+S);
{$endif}
end; end;
{$ifdef AUTOOBJPAS}
Function Format (Const Fmt : String; const Args : Array of const) : String; Function Format (Const Fmt : String; const Args : Array of const) : String;
Var ChPos,OldPos,ArgPos,DoArg,Len : Longint; Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
@ -710,7 +700,6 @@ begin
Oldpos:=chpos; Oldpos:=chpos;
end; end;
end; end;
{$endif}
{==============================================================================} {==============================================================================}
{ extra functions } { extra functions }
@ -813,10 +802,8 @@ const
CP_NorwayDenmark = 865; CP_NorwayDenmark = 865;
{ CountryInfo } { CountryInfo }
{$PACKRECORDS 1}
type type
TCountryInfo = record TCountryInfo = packed record
InfoId: byte; InfoId: byte;
case integer of case integer of
1: ( Size: word; 1: ( Size: word;
@ -830,7 +817,6 @@ type
7: ( DBCSLeadByteTable: longint ); 7: ( DBCSLeadByteTable: longint );
end ; end ;
{$PACKRECORDS NORMAL}
procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo); procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo);
var Regs: Registers; var Regs: Registers;
@ -894,7 +880,10 @@ end ;
{ {
$Log$ $Log$
Revision 1.9 1998-11-04 10:20:52 peter Revision 1.10 1998-12-15 22:43:09 peter
* removed temp symbols
Revision 1.9 1998/11/04 10:20:52 peter
* ansistring fixes * ansistring fixes
Revision 1.8 1998/10/02 13:57:38 michael Revision 1.8 1998/10/02 13:57:38 michael
@ -919,25 +908,6 @@ end ;
Revision 1.2 1998/09/16 08:28:42 michael Revision 1.2 1998/09/16 08:28:42 michael
Update from gertjan Schouten, plus small fix for linux Update from gertjan Schouten, plus small fix for linux
$Log$
Revision 1.9 1998-11-04 10:20:52 peter
* ansistring fixes
Revision 1.8 1998/10/02 13:57:38 michael
Format error now causes exception
Revision 1.7 1998/10/02 12:17:17 michael
+ Made sure it compiles with official 0.99.8
Revision 1.6 1998/10/02 10:42:17 michael
+ Initial implementation of format
Revision 1.5 1998/10/01 16:05:37 michael
Added (empty) format function
Revision 1.4 1998/09/17 12:39:52 michael
+ Further fixes from GertJan Schouten
Revision 1.1 1998/04/10 15:17:46 michael Revision 1.1 1998/04/10 15:17:46 michael
+ Initial implementation; Donated by Gertjan Schouten + Initial implementation; Donated by Gertjan Schouten
His file was split into several files, to keep it a little bit structured. His file was split into several files, to keep it a little bit structured.

7
rtl/objpas/sysstrh.inc
View File

@ -69,9 +69,7 @@ function StrToIntDef(const S: string; Default: integer): integer;
// function StrToInt64Def(const S: string; Default: int64): int64; // function StrToInt64Def(const S: string; Default: int64): int64;
function LoadStr(Ident: integer): string; function LoadStr(Ident: integer): string;
// function FmtLoadStr(Ident: integer; const Args: array of const): string; // function FmtLoadStr(Ident: integer; const Args: array of const): string;
{$ifdef autoobjpas}
Function Format (Const Fmt : String; const Args : Array of const) : String; Function Format (Const Fmt : String; const Args : Array of const) : String;
{$endif}
{==============================================================================} {==============================================================================}
{ extra functions } { extra functions }
@ -83,7 +81,10 @@ function BCDToInt(Value: integer): integer;
{ {
$Log$ $Log$
Revision 1.4 1998-11-04 10:20:53 peter Revision 1.5 1998-12-15 22:43:11 peter
* removed temp symbols
Revision 1.4 1998/11/04 10:20:53 peter
* ansistring fixes * ansistring fixes
Revision 1.3 1998/11/02 12:53:53 michael Revision 1.3 1998/11/02 12:53:53 michael

65
rtl/objpas/sysutils.pp
View File

@ -26,9 +26,6 @@ interface
,go32 ,go32
{$endif go32v2} {$endif go32v2}
{$endif linux} {$endif linux}
{$ifndef AUTOOBJPAS}
,objpas
{$endif}
; ;
@ -54,9 +51,7 @@ interface
fhelpcontext : longint; fhelpcontext : longint;
public public
constructor create(const msg : string); constructor create(const msg : string);
{$ifdef autoobjpas}
constructor createfmt(const msg : string; const args : array of const); constructor createfmt(const msg : string; const args : array of const);
{$endif}
constructor createres(ident : longint); constructor createres(ident : longint);
{ !!!! } { !!!! }
property helpcontext : longint read fhelpcontext write fhelpcontext; property helpcontext : longint read fhelpcontext write fhelpcontext;
@ -77,7 +72,7 @@ interface
EZeroDivide = Class(EMathError); EZeroDivide = Class(EMathError);
EOverflow = Class(EMathError); EOverflow = Class(EMathError);
EUnderflow = Class(EMathError); EUnderflow = Class(EMathError);
{ Run-time and I/O Errors } { Run-time and I/O Errors }
EInOutError = class(Exception) EInOutError = class(Exception)
public public
@ -87,16 +82,16 @@ interface
EOutOfMemory = Class(Exception); EOutOfMemory = Class(Exception);
EAccessViolation = Class(Exception); EAccessViolation = Class(Exception);
EInvalidCast = Class(Exception); EInvalidCast = Class(Exception);
{ String conversion errors } { String conversion errors }
EConvertError = class(Exception); EConvertError = class(Exception);
{ Other errors } { Other errors }
EAbort = Class(Exception); EAbort = Class(Exception);
EAbstractError = Class(Exception); EAbstractError = Class(Exception);
EAssertionFailed = Class(Exception); EAssertionFailed = Class(Exception);
{ Read date & Time function declarations } { Read date & Time function declarations }
{$i datih.inc} {$i datih.inc}
@ -111,14 +106,14 @@ interface
{ Read other file handling function declarations } { Read other file handling function declarations }
{$i filutilh.inc} {$i filutilh.inc}
{ Read disk function declarations } { Read disk function declarations }
{$i diskh.inc} {$i diskh.inc}
implementation implementation
{ Read message string definitions } { Read message string definitions }
{ {
Add a language with IFDEF LANG_NAME Add a language with IFDEF LANG_NAME
just befor the final ELSE. This way English will always be the default. just befor the final ELSE. This way English will always be the default.
} }
@ -134,10 +129,10 @@ interface
{ Read other file handling function implementations } { Read other file handling function implementations }
{$i filutil.inc} {$i filutil.inc}
{ Read disk function implementations } { Read disk function implementations }
{$i disk.inc} {$i disk.inc}
{ Read date & Time function implementations } { Read date & Time function implementations }
{$i dati.inc} {$i dati.inc}
@ -155,14 +150,14 @@ interface
fmessage:=msg; fmessage:=msg;
end; end;
{$ifdef autoobjpas}
constructor exception.createfmt(const msg : string; const args : array of const); constructor exception.createfmt(const msg : string; const args : array of const);
begin begin
inherited create; inherited create;
fmessage:=Format(msg,args); fmessage:=Format(msg,args);
end; end;
{$endif}
constructor exception.createres(ident : longint); constructor exception.createres(ident : longint);
@ -171,8 +166,8 @@ interface
{!!!!!} {!!!!!}
end; end;
Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer); Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer);
Var Var
Message : String; Message : String;
begin begin
@ -193,13 +188,13 @@ end;
Var OutOfMemory : EOutOfMemory; Var OutOfMemory : EOutOfMemory;
InValidPointer : EInvalidPointer; InValidPointer : EInvalidPointer;
Procedure RunErrorToExcept (ErrNo : Longint; Address : Pointer); Procedure RunErrorToExcept (ErrNo : Longint; Address : Pointer);
Var E : Exception; Var E : Exception;
S : String; S : String;
begin begin
Case Errno of Case Errno of
1,203 : E:=OutOfMemory; 1,203 : E:=OutOfMemory;
@ -224,37 +219,32 @@ begin
E:=EinOutError.Create (S); E:=EinOutError.Create (S);
EInoutError(E).ErrorCode:=IOresult; // Clears InOutRes !! EInoutError(E).ErrorCode:=IOresult; // Clears InOutRes !!
end; end;
// We don't set abstracterrorhandler, but we do it here. // We don't set abstracterrorhandler, but we do it here.
// Unless the use sets another handler we'll get here anyway... // Unless the use sets another handler we'll get here anyway...
200 : E:=EDivByZero.Create(SDivByZero); 200 : E:=EDivByZero.Create(SDivByZero);
201 : E:=ERangeError.Create(SRangeError); 201 : E:=ERangeError.Create(SRangeError);
211 : E:=EAbstractError.Create(SAbstractError); 211 : E:=EAbstractError.Create(SAbstractError);
216 : E:=EAccessViolation.Create(SAccessViolation); 216 : E:=EAccessViolation.Create(SAccessViolation);
219 : E:=EInvalidCast.Create(SInvalidCast); 219 : E:=EInvalidCast.Create(SInvalidCast);
227 : E:=EAssertionFailed.Create(SAssertionFailed); 227 : E:=EAssertionFailed.Create(SAssertionFailed);
else else
{$ifdef autoobjpas}
E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]); E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
{$else}
E:=Exception.Create(SUnknownRunTimeError);
{$endif}
end; end;
Raise E {at Address}; Raise E {at Address};
end; end;
{$ifdef autoobjpas}
Procedure AssertErrorHandler (Const Msg,FN : String;LineNo,TheAddr : Longint); Procedure AssertErrorHandler (Const Msg,FN : String;LineNo,TheAddr : Longint);
Var
Var S: String; S : String;
begin begin
If Msg='' then If Msg='' then
S:=SAssertionFailed S:=SAssertionFailed
else else
S:=Msg; S:=Msg;
Raise EAssertionFailed.Createfmt(SAssertError,[S,Fn,LineNo]); // at Pointer(theAddr); Raise EAssertionFailed.Createfmt(SAssertError,[S,Fn,LineNo]); // at Pointer(theAddr);
end; end;
{$endif}
Procedure InitExceptions; Procedure InitExceptions;
{ {
@ -267,9 +257,7 @@ begin
// Create objects that may have problems when there is no memory. // Create objects that may have problems when there is no memory.
OutOfMemory:=EOutOfMemory.Create(SOutOfMemory); OutOfMemory:=EOutOfMemory.Create(SOutOfMemory);
InvalidPointer:=EInvalidPointer.Create(SInvalidPointer); InvalidPointer:=EInvalidPointer.Create(SInvalidPointer);
{$ifdef autoobjpas}
AssertErrorProc:=@AssertErrorHandler; AssertErrorProc:=@AssertErrorHandler;
{$endif}
ErrorProc:=@RunErrorToExcept; ErrorProc:=@RunErrorToExcept;
end; end;
@ -280,7 +268,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.17 1998-10-20 19:26:37 michael Revision 1.18 1998-12-15 22:43:12 peter
* removed temp symbols
Revision 1.17 1998/10/20 19:26:37 michael
+ Forgot to include disk functions + Forgot to include disk functions
Revision 1.16 1998/10/11 12:23:41 michael Revision 1.16 1998/10/11 12:23:41 michael

92
rtl/objpas/typinfo.pp
View File

@ -23,11 +23,6 @@ unit typinfo;
{$MODE objfpc} {$MODE objfpc}
{$ifndef AUTOOBJPAS}
uses
objpas;
{$endif}
// temporary types: // temporary types:
type type
@ -39,7 +34,7 @@ unit typinfo;
PDouble =^Double; PDouble =^Double;
PExtended =^Extended; PExtended =^Extended;
PComp =^Comp; PComp =^Comp;
PFixed16 =^Fixed16; PFixed16 =^Fixed16;
{ Doesn't exist ? { Doesn't exist ?
PFIxed32 = ^Fixed32; PFIxed32 = ^Fixed32;
} }
@ -143,7 +138,7 @@ unit typinfo;
// bit 0..1 GetProc // bit 0..1 GetProc
// 2..3 SetProc // 2..3 SetProc
// 4..5 StoredProc // 4..5 StoredProc
// 6 : true, constant index property // 6 : true, constant index property
PropProcs : Byte; PropProcs : Byte;
Name : ShortString; Name : ShortString;
@ -202,7 +197,7 @@ unit typinfo;
{$ASMMODE ATT} {$ASMMODE ATT}
function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler; function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler;
Label LINoPush; Label LINoPush;
asm asm
@ -228,7 +223,7 @@ unit typinfo;
movl Address,%edi movl Address,%edi
// Push value to set // Push value to set
movl Value,%eax movl Value,%eax
pushl %eax pushl %eax
// ? Indexed procedure // ? Indexed procedure
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
@ -241,7 +236,7 @@ unit typinfo;
end; end;
function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler; function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
Label LINoPush; Label LINoPush;
asm asm
@ -268,7 +263,7 @@ unit typinfo;
// Push value to set // Push value to set
//!! MUST BE CHANGED !! //!! MUST BE CHANGED !!
movl Value,%eax movl Value,%eax
pushl %eax pushl %eax
// ? Indexed procedure // ? Indexed procedure
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
@ -282,7 +277,7 @@ unit typinfo;
function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler; function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
Label LBNoPush; Label LBNoPush;
asm asm
movl S,%edi movl S,%edi
movl Address,%edi movl Address,%edi
@ -302,7 +297,7 @@ unit typinfo;
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint; Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
Var Res: Shortstring);assembler; Var Res: Shortstring);assembler;
Label LSSNoPush; Label LSSNoPush;
asm asm
@ -329,7 +324,7 @@ unit typinfo;
// Push value to set // Push value to set
//!! Is this correct for short strings ???? //!! Is this correct for short strings ????
movl Value,%eax movl Value,%eax
pushl %eax pushl %eax
// ? Indexed procedure // ? Indexed procedure
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
@ -403,10 +398,10 @@ unit typinfo;
Var TD : PTypeData; Var TD : PTypeData;
TP : PPropInfo; TP : PPropInfo;
Count : Longint; Count : Longint;
begin begin
TD:=GetTypeData(TypeInfo); TD:=GetTypeData(TypeInfo);
// Get this objects TOTAL published properties count // Get this objects TOTAL published properties count
TP:=(@TD^.UnitName+Length(TD^.UnitName)+1); TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
Count:=PWord(TP)^; Count:=PWord(TP)^;
// Now point TP to first propinfo record. // Now point TP to first propinfo record.
@ -415,7 +410,7 @@ unit typinfo;
begin begin
PropList^[0]:=TP; PropList^[0]:=TP;
Inc(Longint(PropList),SizeOf(Pointer)); Inc(Longint(PropList),SizeOf(Pointer));
// Point to TP next propinfo record. // Point to TP next propinfo record.
// Located at Name[Length(Name)+1] ! // Located at Name[Length(Name)+1] !
TP:=PPropInfo((@TP^.Name)+PByte(@TP^.Name)^+1); TP:=PPropInfo((@TP^.Name)+PByte(@TP^.Name)^+1);
Dec(Count); Dec(Count);
@ -424,17 +419,17 @@ unit typinfo;
If TD^.Parentinfo<>Nil then If TD^.Parentinfo<>Nil then
GetPropInfos (TD^.ParentInfo,PropList); GetPropInfos (TD^.ParentInfo,PropList);
end; end;
Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint); Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
VAr I : Longint; VAr I : Longint;
begin begin
I:=0; I:=0;
While (I<Count) and (PI^.Name>PL^[I]^.Name) do Inc(I); While (I<Count) and (PI^.Name>PL^[I]^.Name) do Inc(I);
If I<Count then If I<Count then
Move(PL^[I],PL[I+1],Count-I*SizeOf(Pointer)); Move(PL^[I],PL[I+1],Count-I*SizeOf(Pointer));
PL^[I]:=PI; PL^[I]:=PI;
end; end;
function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds; function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
@ -448,7 +443,7 @@ unit typinfo;
Var TempList : PPropList; Var TempList : PPropList;
PropInfo : PPropinfo; PropInfo : PPropinfo;
I,Count : longint; I,Count : longint;
begin begin
Result:=0; Result:=0;
Count:=GetTypeData(TypeInfo)^.Propcount; Count:=GetTypeData(TypeInfo)^.Propcount;
@ -467,13 +462,13 @@ unit typinfo;
end; end;
end; end;
finally finally
FreeMem(TempList,Count*SizeOf(Pointer)); FreeMem(TempList,Count*SizeOf(Pointer));
end; end;
end; end;
end; end;
Procedure SetIndexValues (P: PPRopInfo; Var Index,IValue : Longint); Procedure SetIndexValues (P: PPRopInfo; Var Index,IValue : Longint);
begin begin
Index:=((P^.PropProcs shr 6) and 1); Index:=((P^.PropProcs shr 6) and 1);
If Index=0 then If Index=0 then
@ -536,16 +531,16 @@ unit typinfo;
end; end;
Function GetAStrProp(Instance : TObject;PropInfo : PPropInfo):Pointer; Function GetAStrProp(Instance : TObject;PropInfo : PPropInfo):Pointer;
{ {
Dirty trick based on fact that AnsiString is just a pointer, Dirty trick based on fact that AnsiString is just a pointer,
hence can be treated like an integer type. hence can be treated like an integer type.
} }
var var
value : Pointer; value : Pointer;
Index,Ivalue : Longint; Index,Ivalue : Longint;
begin begin
SetIndexValues(PropInfo,Index,IValue); SetIndexValues(PropInfo,Index,IValue);
case (PropInfo^.PropProcs) and 3 of case (PropInfo^.PropProcs) and 3 of
@ -562,11 +557,11 @@ unit typinfo;
end; end;
Function GetSStrProp(Instance : TObject;PropInfo : PPropInfo):ShortString; Function GetSStrProp(Instance : TObject;PropInfo : PPropInfo):ShortString;
var var
value : ShortString; value : ShortString;
Index,IValue : Longint; Index,IValue : Longint;
begin begin
SetIndexValues(PropInfo,Index,IValue); SetIndexValues(PropInfo,Index,IValue);
case (PropInfo^.PropProcs) and 3 of case (PropInfo^.PropProcs) and 3 of
@ -601,16 +596,16 @@ unit typinfo;
Dirty trick based on fact that AnsiString is just a pointer, Dirty trick based on fact that AnsiString is just a pointer,
hence can be treated like an integer type. hence can be treated like an integer type.
} }
var var
Index,Ivalue : Longint; Index,Ivalue : Longint;
begin begin
SetIndexValues(PropInfo,Index,IValue); SetIndexValues(PropInfo,Index,IValue);
case (PropInfo^.PropProcs) and 3 of case (PropInfo^.PropProcs) and 3 of
ptfield: ptfield:
PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Longint(Pointer(Value)) ; PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Longint(Pointer(Value)) ;
ptstatic: ptstatic:
CallIntegerProc(Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue); CallIntegerProc(Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue);
ptvirtual: ptvirtual:
CallIntegerProc(Instance, CallIntegerProc(Instance,
@ -618,7 +613,7 @@ unit typinfo;
Longint(Pointer(Value)),Index,IValue); Longint(Pointer(Value)),Index,IValue);
end; end;
end; end;
procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo; procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
const Value : ShortString); const Value : ShortString);
@ -637,7 +632,7 @@ unit typinfo;
Value,Index,IValue); Value,Index,IValue);
end; end;
end; end;
procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo; procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
const Value : AnsiString); const Value : AnsiString);
@ -660,7 +655,7 @@ unit typinfo;
case (PropInfo^.PropProcs) and 3 of case (PropInfo^.PropProcs) and 3 of
ptfield: ptfield:
Case GetTypeData(PropInfo^.PropType)^.FloatType of Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle: ftSingle:
Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^; Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftDouble: ftDouble:
Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^; Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
@ -673,7 +668,7 @@ unit typinfo;
Value:=PFixed16(Pointer(Instance)+Longint(PropInfo^.GetProc))^; Value:=PFixed16(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftfixed32: ftfixed32:
Value:=PFixed32(Pointer(Instance)+Longint(PropInfo^.GetProc))^; Value:=PFixed32(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
} }
end; end;
ptstatic: ptstatic:
Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue); Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
@ -686,15 +681,15 @@ unit typinfo;
procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo; procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
Value : Extended); Value : Extended);
Var IValue,Index : longint; Var IValue,Index : longint;
begin begin
SetIndexValues(PropInfo,Index,Ivalue); SetIndexValues(PropInfo,Index,Ivalue);
case (PropInfo^.PropProcs) and 3 of case (PropInfo^.PropProcs) and 3 of
ptfield: ptfield:
Case GetTypeData(PropInfo^.PropType)^.FloatType of Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle: ftSingle:
PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value; PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftDouble: ftDouble:
PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value; PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
@ -707,7 +702,7 @@ unit typinfo;
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value; PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftfixed32: ftfixed32:
PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value; PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
} }
end; end;
ptstatic: ptstatic:
CallExtendedProc(Instance,PropInfo^.SetProc,Value,Index,IValue); CallExtendedProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
@ -747,7 +742,7 @@ unit typinfo;
function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string; function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
Var PS : PShortString; Var PS : PShortString;
PT : PTypeData; PT : PTypeData;
begin begin
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType); PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
@ -762,20 +757,20 @@ unit typinfo;
end; end;
function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer; function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
Var PS : PShortString; Var PS : PShortString;
PT : PTypeData; PT : PTypeData;
Count : longint; Count : longint;
begin begin
If Length(Name)=0 then exit(-1); If Length(Name)=0 then exit(-1);
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType); PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
Count:=0; Count:=0;
Result:=-1; Result:=-1;
PS:=@PT^.NameList; PS:=@PT^.NameList;
While (Result=-1) and (PByte(PS)^<>0) do While (Result=-1) and (PByte(PS)^<>0) do
begin begin
If PS^=Name then If PS^=Name then
Result:=Count; Result:=Count;
PS:=PS+PByte(PS)^; PS:=PS+PByte(PS)^;
Inc(Count); Inc(Count);
@ -786,7 +781,10 @@ end.
{ {
$Log$ $Log$
Revision 1.16 1998-12-02 12:35:07 michael Revision 1.17 1998-12-15 22:43:13 peter
* removed temp symbols
Revision 1.16 1998/12/02 12:35:07 michael
More changes for type-information More changes for type-information
Revision 1.15 1998/11/26 14:57:47 michael Revision 1.15 1998/11/26 14:57:47 michael

34
rtl/win32/syswin32.pp
View File

@ -74,9 +74,7 @@ var
MainInstance, MainInstance,
cmdshow : longint; cmdshow : longint;
IsLibrary,IsMultiThreaded,IsConsole : boolean; IsLibrary,IsMultiThreaded,IsConsole : boolean;
{* Changes made by Ozerski 26.10.1998}
DLLreason,DLLparam:longint; DLLreason,DLLparam:longint;
{* End Changes}
implementation implementation
@ -639,7 +637,6 @@ begin
GetCommandFile:=@ModuleName; GetCommandFile:=@ModuleName;
end; end;
{* End changes}
procedure setup_arguments; procedure setup_arguments;
var var
@ -695,30 +692,6 @@ begin
end; end;
{$ifndef FPC_WIN32_DLL_SUPPORT}
{$ASMMODE DIRECT}
var
fpucw : word;
procedure Entry;[public,alias: '_mainCRTStartup'];
{ Can't use here any locals, because ebp is set to zero to indicate end of
backtrace (PFV) }
begin
{ init fpu and call to the pascal main }
fpucw:=$1332;
asm
finit
fwait
fldcw _FPUCW
xorl %ebp,%ebp
call PASCALMAIN
end;
{ that's all folks }
ExitProcess(0);
end;
{$else FPC_WIN32_DLL_SUPPORT}
{$ifdef dummy} {$ifdef dummy}
Function SetUpStack : longint; Function SetUpStack : longint;
{ This routine does the following : } { This routine does the following : }
@ -942,8 +915,6 @@ var
Exe_entry_code : pointer = @Exe_entry; Exe_entry_code : pointer = @Exe_entry;
Dll_entry_code : pointer = @Dll_entry; Dll_entry_code : pointer = @Dll_entry;
{$endif def FPC_WIN32_DLL_SUPPORT}
{$ASMMODE ATT} {$ASMMODE ATT}
begin begin
@ -980,7 +951,10 @@ end.
{ {
$Log$ $Log$
Revision 1.28 1998-12-09 17:57:33 pierre Revision 1.29 1998-12-15 22:43:14 peter
* removed temp symbols
Revision 1.28 1998/12/09 17:57:33 pierre
+ exception handling by default + exception handling by default
Revision 1.27 1998/12/01 14:00:08 pierre Revision 1.27 1998/12/01 14:00:08 pierre