mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 17:19:33 +02:00
* removed temp symbols
This commit is contained in:
peter
parent
401078117f
commit
516958a67b
@ -551,11 +551,7 @@ begin
|
||||
asm
|
||||
movzwl hz,%ecx
|
||||
movl $1193046,%eax
|
||||
{$ifdef NOATTCDQ}
|
||||
cltd
|
||||
{$else}
|
||||
cdq
|
||||
{$endif}
|
||||
divl %ecx
|
||||
movl %eax,%ecx
|
||||
movb $0xb6,%al
|
||||
@ -920,7 +916,10 @@ end.
|
||||
|
||||
{
|
||||
$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")
|
||||
|
||||
Revision 1.15 1998/11/28 14:09:48 peter
|
||||
|
||||
@ -99,7 +99,7 @@ implementation
|
||||
{$I system.inc}
|
||||
|
||||
{$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
|
||||
{ called when trying to get local stack
|
||||
if the compiler directive $S is set
|
||||
@ -612,7 +612,10 @@ Begin
|
||||
End.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.10 1998/11/16 14:15:01 pierre
|
||||
|
||||
@ -590,7 +590,7 @@ begin
|
||||
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
|
||||
is set this function must preserve esi !!!! because esi is set by
|
||||
@ -1227,7 +1227,10 @@ Begin
|
||||
End.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.23 1998/11/16 14:15:02 pierre
|
||||
|
||||
@ -28,9 +28,7 @@ unit GRAPH;
|
||||
{$endif DEBUG}
|
||||
|
||||
{ Don't use smartlinking, because of the direct assembler that is used }
|
||||
{$ifndef VER0_99_8}
|
||||
{$SMARTLINK OFF}
|
||||
{$endif not VER0_99_8}
|
||||
|
||||
interface
|
||||
|
||||
@ -151,7 +149,7 @@ procedure FillTriangle(A,B,C:Pointtype);
|
||||
function ColorsEqual(c1,c2 : longint) : boolean;
|
||||
{ this will return true if the two colors will appear
|
||||
equal in the current video mode }
|
||||
|
||||
|
||||
procedure WaitRetrace;
|
||||
{$ifdef debug}
|
||||
procedure pixel(offset:longint);
|
||||
@ -276,7 +274,7 @@ var { X/Y Verhaeltnis des Bildschirm }
|
||||
used by getGraphMode PM }
|
||||
oldCRTMode : integer;
|
||||
InTempCRTMode : boolean;
|
||||
|
||||
|
||||
{ Position des Graphikcursors }
|
||||
curx,cury : longint;
|
||||
{ true, wenn die Routinen des Graphikpaketes verwendet werden d<>rfen }
|
||||
@ -334,7 +332,7 @@ var { X/Y Verhaeltnis des Bildschirm }
|
||||
const
|
||||
AWindow = 0;
|
||||
BWindow = 1;
|
||||
|
||||
|
||||
{ Variables for Bankswitching }
|
||||
var
|
||||
BytesPerLine : longint;
|
||||
@ -360,7 +358,7 @@ Begin
|
||||
((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
|
||||
((BytesPerPixel>2) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
|
||||
End;
|
||||
|
||||
|
||||
function GraphErrorMsg(ErrorCode: Integer): string;
|
||||
Begin
|
||||
GraphErrorMsg:='';
|
||||
@ -539,7 +537,7 @@ var bank1,bank2,diff,c:longint;
|
||||
ofs1,ofs2 :longint;
|
||||
y : integer;
|
||||
storewritemode : word;
|
||||
|
||||
|
||||
begin
|
||||
if not isgraphmode then
|
||||
begin
|
||||
@ -711,7 +709,7 @@ procedure SetArrays;
|
||||
for index:=0 to VESAInfo.YResolution do
|
||||
Y_Array[index]:=index * BytesPerLine + AktPageOffset;
|
||||
end;
|
||||
|
||||
|
||||
procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
|
||||
var i : Integer;
|
||||
begin
|
||||
@ -907,12 +905,12 @@ function GetVisualPage : word;
|
||||
begin
|
||||
GetVisualPage:=AktVisualPage;
|
||||
end;
|
||||
|
||||
|
||||
function GetActivePage : word;
|
||||
begin
|
||||
GetActivePage:=AktPage;
|
||||
end;
|
||||
|
||||
|
||||
{ mehrere Bildschirmseiten werden nicht unterst<73>tzt }
|
||||
{ Dummy aus Kompatibilit„tsgr<67>nden }
|
||||
procedure SetActivePage(page : word);
|
||||
@ -936,7 +934,7 @@ function GetNumberOfPages : word;
|
||||
begin
|
||||
GetNumberOfPages:=VESAInfo.NumberOfPages;
|
||||
end;
|
||||
|
||||
|
||||
procedure SetWriteMode(WriteMode : integer);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
@ -1011,7 +1009,10 @@ end.
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.13 1998/11/25 13:04:43 pierre
|
||||
|
||||
@ -89,7 +89,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure FillChar(var x;count:longint;value:byte);{[alias: 'FPC_FILL_OBJECT'];}
|
||||
Procedure FillChar(var x;count:longint;value:byte);
|
||||
begin
|
||||
asm
|
||||
cld
|
||||
@ -151,7 +151,7 @@ end;
|
||||
|
||||
{$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
|
||||
{ Entry without preamble, since we need the ESP of the constructor
|
||||
Stack (relative to %ebp):
|
||||
@ -174,11 +174,7 @@ asm
|
||||
{ Memory size }
|
||||
pushl (%eax)
|
||||
pushl %esi
|
||||
{$ifdef FPCNAMES}
|
||||
call FPC_GETMEM
|
||||
{$else}
|
||||
call GETMEM
|
||||
{$endif}
|
||||
popal
|
||||
{ Memory position to %esi }
|
||||
movl (%esi),%esi
|
||||
@ -215,18 +211,14 @@ asm
|
||||
stosl
|
||||
popal
|
||||
{ set the VMT address for the new created object }
|
||||
{$ifdef OBJECTVMTOFFSET}
|
||||
{ the offset is in %edi since the calling and has not been changed !! }
|
||||
movl %eax,(%esi,%edi,1)
|
||||
{$else OBJECTVMTOFFSET}
|
||||
movl %eax,(%esi)
|
||||
{$endif OBJECTVMTOFFSET}
|
||||
orl %eax,%eax
|
||||
.LHC_5:
|
||||
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
|
||||
{ Stack (relative to %ebp):
|
||||
12 Self
|
||||
@ -243,12 +235,8 @@ asm
|
||||
{ Yes, get size from SELF! }
|
||||
movl 12(%ebp),%eax
|
||||
{ get VMT-pointer (from Self) to %ebx }
|
||||
{$ifdef OBJECTVMTOFFSET}
|
||||
{ the offset is in %edi since the calling and has not been changed !! }
|
||||
movl (%eax,%edi,1),%ebx
|
||||
{$else OBJECTVMTOFFSET}
|
||||
movl (%eax),%ebx
|
||||
{$endif OBJECTVMTOFFSET}
|
||||
{ temporary Variable }
|
||||
subl $4,%esp
|
||||
movl %esp,%edi
|
||||
@ -260,18 +248,14 @@ asm
|
||||
movl $0,(%eax)
|
||||
movl %eax,(%edi)
|
||||
pushl %edi
|
||||
{$ifdef FPCNAMES}
|
||||
call FPC_FREEMEM
|
||||
{$else}
|
||||
call FREEMEM
|
||||
{$endif}
|
||||
addl $4,%esp
|
||||
.LHD_3:
|
||||
popal
|
||||
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
|
||||
{ create class ? }
|
||||
movl 8(%ebp),%edi
|
||||
@ -291,7 +275,7 @@ asm
|
||||
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
|
||||
{ destroy class ? }
|
||||
movl 8(%ebp),%edi
|
||||
@ -314,7 +298,7 @@ end;
|
||||
|
||||
|
||||
{ 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
|
||||
pushl %edi
|
||||
movl 8(%esp),%edi
|
||||
@ -341,7 +325,7 @@ end;
|
||||
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 !!!
|
||||
}
|
||||
@ -383,7 +367,7 @@ begin
|
||||
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
|
||||
asm
|
||||
xorl %ecx,%ecx
|
||||
@ -422,7 +406,7 @@ begin
|
||||
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
|
||||
asm
|
||||
cld
|
||||
@ -472,7 +456,7 @@ end;
|
||||
|
||||
|
||||
{$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
|
||||
asm
|
||||
cld
|
||||
@ -557,7 +541,7 @@ end ['EAX'];
|
||||
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
|
||||
movl l,%eax
|
||||
orl %eax,%eax
|
||||
@ -567,7 +551,7 @@ asm
|
||||
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
|
||||
movl l,%eax
|
||||
andl $1,%eax
|
||||
@ -575,7 +559,7 @@ asm
|
||||
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
|
||||
mov l,%eax
|
||||
imull %eax,%eax
|
||||
@ -618,11 +602,7 @@ begin
|
||||
movb $0x2d,1(%edi) // put '-' in String
|
||||
incl %ecx
|
||||
.LM2:
|
||||
{$ifdef NOATTCDQ}
|
||||
cltd
|
||||
{$else}
|
||||
cdq
|
||||
{$endif}
|
||||
idivl %esi,%eax
|
||||
addb $0x30,%dl // convert Rest to ASCII.
|
||||
movb %dl,-12(%ebp,%ebx)
|
||||
@ -697,7 +677,7 @@ end;
|
||||
IoCheck
|
||||
****************************************************************************}
|
||||
|
||||
procedure int_iocheck(addr : longint);[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'IOCHECK'];
|
||||
procedure int_iocheck(addr : longint);[public,alias:'FPC_IOCHECK'];
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -724,7 +704,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.33 1998/11/28 14:09:49 peter
|
||||
|
||||
@ -217,7 +217,7 @@
|
||||
EXTENDED data type routines
|
||||
****************************************************************************}
|
||||
|
||||
function pi : extended;assembler;{$ifdef MORECONST}[internconst:in_const_pi];{$endif}
|
||||
function pi : extended;assembler;[internconst:in_const_pi];
|
||||
asm
|
||||
fldpi
|
||||
end [];
|
||||
@ -238,14 +238,14 @@
|
||||
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
|
||||
fldt d
|
||||
fsqrt
|
||||
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
|
||||
fldt d
|
||||
fld1
|
||||
@ -253,7 +253,7 @@
|
||||
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
|
||||
fldt d
|
||||
fcos
|
||||
@ -273,7 +273,7 @@
|
||||
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
|
||||
// comes from DJ GPP
|
||||
fldt d
|
||||
@ -376,7 +376,7 @@
|
||||
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
|
||||
fldln2
|
||||
fldt d
|
||||
@ -384,7 +384,7 @@
|
||||
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
|
||||
fldt d
|
||||
fsin
|
||||
@ -543,7 +543,10 @@
|
||||
|
||||
{
|
||||
$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
|
||||
the compiler (needed for stack alignment)
|
||||
|
||||
|
||||
@ -52,11 +52,7 @@ unit mmx;
|
||||
uses
|
||||
cpu;
|
||||
|
||||
{$ifndef CPUIDSUP}
|
||||
{$ASMMODE DIRECT}
|
||||
{$else}
|
||||
{$ASMMODE ATT}
|
||||
{$endif}
|
||||
|
||||
{ returns true, if the processor supports the mmx instructions }
|
||||
function mmx_support : boolean;
|
||||
@ -127,7 +123,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.2 1998/05/31 14:15:50 peter
|
||||
|
||||
@ -16,8 +16,7 @@
|
||||
{ Run-Time type information routines - processor dependent part }
|
||||
{$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
|
||||
# Save registers
|
||||
push %eax
|
||||
@ -109,8 +108,8 @@ asm
|
||||
pop %eax
|
||||
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
|
||||
push %eax
|
||||
push %ebx
|
||||
@ -192,11 +191,7 @@ asm
|
||||
# AnsiString handling :
|
||||
.DoAnsiStringFinal:
|
||||
pushl 8(%ebp)
|
||||
{$ifdef NEWSTRNAMES}
|
||||
call FPC_ANSISTR_DECR_REF
|
||||
{$else}
|
||||
call FPC_DECR_ANSI_REF
|
||||
{$endif}
|
||||
.ExitFinalize:
|
||||
pop %edx
|
||||
pop %ecx
|
||||
@ -204,8 +199,8 @@ asm
|
||||
pop %eax
|
||||
end;
|
||||
|
||||
Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler;
|
||||
|
||||
Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler;
|
||||
asm
|
||||
# Save registers
|
||||
push %eax
|
||||
@ -281,11 +276,7 @@ asm
|
||||
# AnsiString handling :
|
||||
.DoAnsiStringAddRef:
|
||||
pushl 8(%ebp)
|
||||
{$ifdef NEWSTRNAMES}
|
||||
call FPC_ANSISTR_INCR_REF
|
||||
{$else}
|
||||
call FPC_INCR_ANSI_REF
|
||||
{$endif}
|
||||
.ExitAddRef:
|
||||
pop %edx
|
||||
pop %ecx
|
||||
@ -293,8 +284,8 @@ asm
|
||||
pop %eax
|
||||
end;
|
||||
|
||||
Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler;
|
||||
|
||||
Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler;
|
||||
asm
|
||||
# Save registers
|
||||
push %eax
|
||||
@ -371,11 +362,7 @@ asm
|
||||
.DoAnsiStringDecRef:
|
||||
movl 8(%ebp),%eax
|
||||
pushl %eax
|
||||
{$ifdef NEWSTRNAMES}
|
||||
call FPC_ANSISTR_DECR_REF
|
||||
{$else}
|
||||
call FPC_DECR_ANSI_REF
|
||||
{$endif}
|
||||
.ExitDecRef:
|
||||
pop %edx
|
||||
pop %ecx
|
||||
@ -387,7 +374,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.11 1998/11/17 00:41:10 peter
|
||||
|
||||
@ -16,7 +16,7 @@
|
||||
|
||||
{$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
|
||||
}
|
||||
@ -55,8 +55,7 @@ asm
|
||||
popl %eax
|
||||
end;
|
||||
|
||||
procedure do_set_byte(p : pointer;b : byte);assembler;
|
||||
[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_SET_BYTE'];
|
||||
procedure do_set_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_SET_BYTE'];
|
||||
{
|
||||
add the element b to the set pointed by p
|
||||
}
|
||||
@ -74,8 +73,7 @@ asm
|
||||
end;
|
||||
|
||||
|
||||
procedure do_unset_byte(p : pointer;b : byte);assembler;
|
||||
[public,alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'SET_UNSET_BYTE'];
|
||||
procedure do_unset_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_UNSET_BYTE'];
|
||||
{
|
||||
suppresses the element b to the set pointed by p
|
||||
used for exclude(set,element)
|
||||
@ -94,7 +92,7 @@ asm
|
||||
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
|
||||
}
|
||||
@ -121,7 +119,7 @@ asm
|
||||
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
|
||||
}
|
||||
@ -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
|
||||
}
|
||||
@ -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
|
||||
}
|
||||
@ -179,7 +177,7 @@ asm
|
||||
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
|
||||
}
|
||||
@ -200,7 +198,7 @@ asm
|
||||
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
|
||||
}
|
||||
@ -220,7 +218,7 @@ asm
|
||||
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
|
||||
}
|
||||
@ -245,7 +243,7 @@ end;
|
||||
|
||||
{$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
|
||||
not yet use by the compiler so
|
||||
@ -264,7 +262,7 @@ asm
|
||||
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
|
||||
works for sets larger than 256 elements
|
||||
@ -283,7 +281,7 @@ asm
|
||||
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
|
||||
}
|
||||
@ -302,7 +300,7 @@ asm
|
||||
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
|
||||
dest size is the number of bytes in the set
|
||||
@ -322,7 +320,7 @@ asm
|
||||
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
|
||||
movl set1,%esi
|
||||
movl set2,%ebx
|
||||
@ -340,7 +338,7 @@ asm
|
||||
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
|
||||
}
|
||||
@ -360,7 +358,7 @@ asm
|
||||
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
|
||||
movl set1,%esi
|
||||
movl set2,%edi
|
||||
@ -383,7 +381,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.6 1998/10/22 14:50:08 pierre
|
||||
|
||||
@ -114,7 +114,7 @@ begin
|
||||
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;
|
||||
If the reference count is zero, deallocate the string;
|
||||
@ -136,7 +136,7 @@ Begin
|
||||
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
|
||||
If S=Nil then
|
||||
exit;
|
||||
@ -167,7 +167,7 @@ begin
|
||||
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.
|
||||
}
|
||||
@ -722,7 +722,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.3 1998/11/17 12:16:07 michael
|
||||
|
||||
@ -248,7 +248,7 @@ end;
|
||||
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
|
||||
{$ifdef i386}
|
||||
str_real(len,fr,d,rt_s64real,s);
|
||||
@ -259,7 +259,7 @@ end;
|
||||
|
||||
|
||||
{$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
|
||||
str_real(len,fr,d,rt_s32real,s);
|
||||
end;
|
||||
@ -267,7 +267,7 @@ end;
|
||||
|
||||
|
||||
{$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
|
||||
str_real(len,fr,d,rt_s80real,s);
|
||||
end;
|
||||
@ -275,7 +275,7 @@ end;
|
||||
|
||||
|
||||
{$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
|
||||
str_real(len,fr,d,rt_s64bit,s);
|
||||
end;
|
||||
@ -283,14 +283,14 @@ end;
|
||||
|
||||
|
||||
{$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
|
||||
str_real(len,fr,d,rt_f32bit,s);
|
||||
end;
|
||||
{$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
|
||||
int_str(v,s);
|
||||
if length(s)<len then
|
||||
@ -298,7 +298,7 @@ begin
|
||||
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
|
||||
int_str(v,s);
|
||||
if length(s)<len then
|
||||
@ -937,7 +937,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.15 1998/11/04 10:20:50 peter
|
||||
|
||||
@ -275,7 +275,7 @@ end;
|
||||
Miscellaneous
|
||||
*****************************************************************************}
|
||||
|
||||
procedure int_overflow;[public,alias: {$ifdef FPCNAMES}'FPC_OVERFLOW'{$else}'RE_OVERFLOW'{$endif}];
|
||||
procedure int_overflow;[public,alias:'FPC_OVERFLOW'];
|
||||
var
|
||||
addr : longint;
|
||||
begin
|
||||
@ -378,7 +378,7 @@ Begin
|
||||
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
|
||||
and by the halt procedure.
|
||||
@ -480,7 +480,7 @@ end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SetJmp/LongJmp support.
|
||||
SetJmp/LongJmp support.
|
||||
*****************************************************************************}
|
||||
|
||||
{$i setjump.inc}
|
||||
@ -488,7 +488,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.45 1998/12/01 14:00:10 pierre
|
||||
|
||||
@ -27,9 +27,7 @@
|
||||
{$I-,Q-,H-,R-,V-}
|
||||
|
||||
{ needed for insert,delete,readln }
|
||||
{$ifdef OPENSTRINGS}
|
||||
{$P+}
|
||||
{$endif}
|
||||
{$P+}
|
||||
|
||||
{ Stack check gives a note under linux }
|
||||
{$ifndef linux}
|
||||
@ -64,19 +62,13 @@ Type
|
||||
{$endif}
|
||||
|
||||
{$ifdef m68k}
|
||||
StrLenInt = Integer;
|
||||
StrLenInt = Longint;
|
||||
ValReal = Real;
|
||||
{$ifdef USEANSISTRINGS}
|
||||
{$error StrLenInt must be a longint if ansi strings are used}
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
{ some type aliases }
|
||||
dword = cardinal;
|
||||
longword = cardinal;
|
||||
{$ifndef useansistrings}
|
||||
shortstring = string;
|
||||
{$endif}
|
||||
|
||||
{ Zero - terminated strings }
|
||||
PChar = ^Char;
|
||||
@ -437,7 +429,10 @@ const
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.43 1998/11/26 23:16:13 jonas
|
||||
|
||||
@ -401,14 +401,14 @@ begin
|
||||
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
|
||||
if f.FlushFunc<>nil then
|
||||
FileFunc(f.FlushFunc)(f);
|
||||
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
|
||||
{$IFDEF SHORT_LINEBREAK}
|
||||
eollen=1;
|
||||
@ -427,7 +427,7 @@ begin
|
||||
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
|
||||
If (InOutRes<>0) then
|
||||
exit;
|
||||
@ -444,7 +444,7 @@ End;
|
||||
|
||||
Type
|
||||
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
|
||||
ArrayLen : longint;
|
||||
Begin
|
||||
@ -462,7 +462,7 @@ Begin
|
||||
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
|
||||
PCharLen : longint;
|
||||
Begin
|
||||
@ -480,7 +480,7 @@ Begin
|
||||
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
|
||||
}
|
||||
@ -491,7 +491,7 @@ begin
|
||||
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
|
||||
s : String;
|
||||
Begin
|
||||
@ -502,7 +502,7 @@ Begin
|
||||
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
|
||||
s : String;
|
||||
Begin
|
||||
@ -517,7 +517,7 @@ Begin
|
||||
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
|
||||
s : String;
|
||||
Begin
|
||||
@ -529,7 +529,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
s : String;
|
||||
Begin
|
||||
@ -542,7 +542,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
s : String;
|
||||
Begin
|
||||
@ -555,7 +555,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
s : String;
|
||||
Begin
|
||||
@ -568,7 +568,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
s : String;
|
||||
Begin
|
||||
@ -580,7 +580,7 @@ End;
|
||||
{$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
|
||||
If (InOutRes<>0) then
|
||||
exit;
|
||||
@ -592,7 +592,7 @@ Begin
|
||||
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
|
||||
If (InOutRes<>0) then
|
||||
exit;
|
||||
@ -692,14 +692,14 @@ begin
|
||||
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
|
||||
if f.FlushFunc<>nil then
|
||||
FileFunc(f.FlushFunc)(f);
|
||||
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
|
||||
{ Check error and if file is open and load buf if empty }
|
||||
If (InOutRes<>0) then
|
||||
@ -726,15 +726,9 @@ Begin
|
||||
End;
|
||||
|
||||
|
||||
{$ifdef OPENSTRINGS}
|
||||
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}
|
||||
Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:'FPC_READ_TEXT_STRING'];
|
||||
var
|
||||
{$ifdef OPENSTRINGS}
|
||||
maxlen,
|
||||
{$endif}
|
||||
sPos,len : Longint;
|
||||
p,startp,maxp : pchar;
|
||||
Begin
|
||||
@ -750,9 +744,7 @@ Begin
|
||||
end;
|
||||
{ Read maximal until Maxlen is reached }
|
||||
sPos:=0;
|
||||
{$ifdef OPENSTRINGS}
|
||||
MaxLen:=high(s);
|
||||
{$endif}
|
||||
repeat
|
||||
If f.BufPos>=f.BufEnd Then
|
||||
begin
|
||||
@ -790,7 +782,7 @@ Begin
|
||||
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
|
||||
c:=#0;
|
||||
{ Check error and if file is open }
|
||||
@ -816,7 +808,7 @@ Begin
|
||||
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
|
||||
p,maxp,startp,sidx : PChar;
|
||||
len : longint;
|
||||
@ -864,7 +856,7 @@ Begin
|
||||
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
|
||||
p,maxp,startp,sidx : PChar;
|
||||
len : longint;
|
||||
@ -912,17 +904,10 @@ Begin
|
||||
End;
|
||||
|
||||
|
||||
{$ifdef OPENSTRINGS}
|
||||
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}
|
||||
Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias:'FPC_READ_TEXT_ANSISTRING'];
|
||||
var
|
||||
p,maxp,startp,sidx : PChar;
|
||||
{$ifdef OPENSTRINGS}
|
||||
maxlen,
|
||||
{$endif}
|
||||
spos,len : longint;
|
||||
maxlen,spos,len : longint;
|
||||
Begin
|
||||
{ Delete the string }
|
||||
Decr_ansi_ref (Pointer(S));
|
||||
@ -981,7 +966,7 @@ Begin
|
||||
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
|
||||
hs : String;
|
||||
code : Word;
|
||||
@ -1007,7 +992,7 @@ Begin
|
||||
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
|
||||
ll : Longint;
|
||||
Begin
|
||||
@ -1021,7 +1006,7 @@ Begin
|
||||
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
|
||||
ll : Longint;
|
||||
Begin
|
||||
@ -1035,7 +1020,7 @@ Begin
|
||||
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
|
||||
ll : Longint;
|
||||
Begin
|
||||
@ -1049,7 +1034,7 @@ Begin
|
||||
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
|
||||
ll : Longint;
|
||||
Begin
|
||||
@ -1063,7 +1048,7 @@ Begin
|
||||
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
|
||||
hs : String;
|
||||
code : Word;
|
||||
@ -1088,6 +1073,7 @@ Begin
|
||||
HandleError(106);
|
||||
End;
|
||||
|
||||
|
||||
function ReadRealStr(var f:TextRec):string;
|
||||
var
|
||||
hs : string;
|
||||
@ -1130,7 +1116,7 @@ begin
|
||||
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
|
||||
code : Word;
|
||||
Begin
|
||||
@ -1141,7 +1127,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
code : Word;
|
||||
Begin
|
||||
@ -1153,7 +1139,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
code : Word;
|
||||
Begin
|
||||
@ -1165,7 +1151,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
code : Word;
|
||||
Begin
|
||||
@ -1177,7 +1163,7 @@ End;
|
||||
|
||||
|
||||
{$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
|
||||
code : Word;
|
||||
Begin
|
||||
@ -1212,7 +1198,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.35 1998/11/27 14:50:58 peter
|
||||
|
||||
@ -112,11 +112,7 @@ Var SInfo : Stat;
|
||||
|
||||
begin
|
||||
P:=pglob(Info.FindHandle);
|
||||
{$ifdef AUTOOBJPAS}
|
||||
Result:=Fstat(p^.name,SInfo);
|
||||
{$else}
|
||||
Result:=Fstat(StrPas(p^.name),SInfo);
|
||||
{$endif}
|
||||
Info.FindHandle:=Longint(P^.Next);
|
||||
P^.Next:=Nil;
|
||||
GlobFree(P);
|
||||
@ -235,7 +231,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.2 1998/10/13 10:20:07 peter
|
||||
|
||||
@ -39,15 +39,7 @@ const
|
||||
{$I heaph.inc}
|
||||
|
||||
const
|
||||
{$ifndef VER0_99_5}
|
||||
{$ifndef VER0_99_6}
|
||||
UnusedHandle = -1;
|
||||
{$else}
|
||||
UnusedHandle = $ffff;
|
||||
{$endif}
|
||||
{$else}
|
||||
UnusedHandle = $ffff;
|
||||
{$endif}
|
||||
UnusedHandle = -1;
|
||||
StdInputHandle = 0;
|
||||
StdOutputHandle = 1;
|
||||
StdErrorHandle = 2;
|
||||
@ -739,7 +731,10 @@ End.
|
||||
|
||||
{
|
||||
$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+
|
||||
|
||||
Revision 1.17 1998/10/15 08:30:00 peter
|
||||
|
||||
@ -408,12 +408,8 @@ function StrToInt(const S: string): integer;
|
||||
var Error: word;
|
||||
|
||||
begin
|
||||
Val(S, result, Error);
|
||||
{$ifdef autoobjpas}
|
||||
Val(S, result, Error);
|
||||
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 ;
|
||||
|
||||
{ StrToIntDef converts the string S to an integer value,
|
||||
@ -435,11 +431,9 @@ end ;
|
||||
{ FmtLoadStr returns the string resource Ident and formats it accordingly }
|
||||
|
||||
|
||||
{$ifdef autoobjpas}
|
||||
function FmtLoadStr(Ident: integer; const Args: array of const): string;
|
||||
begin
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
Const
|
||||
feInvalidFormat = 1;
|
||||
@ -461,18 +455,14 @@ Var S : String;
|
||||
begin
|
||||
//!! must be changed to contain format string...
|
||||
S:='';
|
||||
{$ifdef autoobjpas}
|
||||
Case ErrCode of
|
||||
feInvalidFormat : EConvertError.Createfmt(SInvalidFormat,[s]);
|
||||
feMissingArgument : EConvertError.Createfmt(SArgumentMissing,[s]);
|
||||
feInvalidArgIndex : EConvertError.Createfmt(SInvalidArgIndex,[s]);
|
||||
end;
|
||||
{$else}
|
||||
EConvertError.Create('Invalid format encountered : '+S);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{$ifdef AUTOOBJPAS}
|
||||
|
||||
Function Format (Const Fmt : String; const Args : Array of const) : String;
|
||||
|
||||
Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
|
||||
@ -710,7 +700,6 @@ begin
|
||||
Oldpos:=chpos;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{==============================================================================}
|
||||
{ extra functions }
|
||||
@ -813,10 +802,8 @@ const
|
||||
CP_NorwayDenmark = 865;
|
||||
|
||||
{ CountryInfo }
|
||||
|
||||
{$PACKRECORDS 1}
|
||||
type
|
||||
TCountryInfo = record
|
||||
TCountryInfo = packed record
|
||||
InfoId: byte;
|
||||
case integer of
|
||||
1: ( Size: word;
|
||||
@ -830,7 +817,6 @@ type
|
||||
7: ( DBCSLeadByteTable: longint );
|
||||
end ;
|
||||
|
||||
{$PACKRECORDS NORMAL}
|
||||
|
||||
procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo);
|
||||
var Regs: Registers;
|
||||
@ -894,7 +880,10 @@ end ;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
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
|
||||
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
|
||||
+ Initial implementation; Donated by Gertjan Schouten
|
||||
His file was split into several files, to keep it a little bit structured.
|
||||
|
||||
@ -69,9 +69,7 @@ function StrToIntDef(const S: string; Default: integer): integer;
|
||||
// function StrToInt64Def(const S: string; Default: int64): int64;
|
||||
function LoadStr(Ident: integer): string;
|
||||
// function FmtLoadStr(Ident: integer; const Args: array of const): string;
|
||||
{$ifdef autoobjpas}
|
||||
Function Format (Const Fmt : String; const Args : Array of const) : String;
|
||||
{$endif}
|
||||
|
||||
{==============================================================================}
|
||||
{ extra functions }
|
||||
@ -83,7 +81,10 @@ function BCDToInt(Value: integer): integer;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.3 1998/11/02 12:53:53 michael
|
||||
|
||||
@ -26,9 +26,6 @@ interface
|
||||
,go32
|
||||
{$endif go32v2}
|
||||
{$endif linux}
|
||||
{$ifndef AUTOOBJPAS}
|
||||
,objpas
|
||||
{$endif}
|
||||
;
|
||||
|
||||
|
||||
@ -54,9 +51,7 @@ interface
|
||||
fhelpcontext : longint;
|
||||
public
|
||||
constructor create(const msg : string);
|
||||
{$ifdef autoobjpas}
|
||||
constructor createfmt(const msg : string; const args : array of const);
|
||||
{$endif}
|
||||
constructor createres(ident : longint);
|
||||
{ !!!! }
|
||||
property helpcontext : longint read fhelpcontext write fhelpcontext;
|
||||
@ -77,7 +72,7 @@ interface
|
||||
EZeroDivide = Class(EMathError);
|
||||
EOverflow = Class(EMathError);
|
||||
EUnderflow = Class(EMathError);
|
||||
|
||||
|
||||
{ Run-time and I/O Errors }
|
||||
EInOutError = class(Exception)
|
||||
public
|
||||
@ -87,16 +82,16 @@ interface
|
||||
EOutOfMemory = Class(Exception);
|
||||
EAccessViolation = Class(Exception);
|
||||
EInvalidCast = Class(Exception);
|
||||
|
||||
|
||||
|
||||
|
||||
{ String conversion errors }
|
||||
EConvertError = class(Exception);
|
||||
|
||||
{ Other errors }
|
||||
{ Other errors }
|
||||
EAbort = Class(Exception);
|
||||
EAbstractError = Class(Exception);
|
||||
EAssertionFailed = Class(Exception);
|
||||
|
||||
|
||||
{ Read date & Time function declarations }
|
||||
{$i datih.inc}
|
||||
|
||||
@ -111,14 +106,14 @@ interface
|
||||
|
||||
{ Read other file handling function declarations }
|
||||
{$i filutilh.inc}
|
||||
|
||||
|
||||
{ Read disk function declarations }
|
||||
{$i diskh.inc}
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{ Read message string definitions }
|
||||
{
|
||||
{
|
||||
Add a language with IFDEF LANG_NAME
|
||||
just befor the final ELSE. This way English will always be the default.
|
||||
}
|
||||
@ -134,10 +129,10 @@ interface
|
||||
|
||||
{ Read other file handling function implementations }
|
||||
{$i filutil.inc}
|
||||
|
||||
|
||||
{ Read disk function implementations }
|
||||
{$i disk.inc}
|
||||
|
||||
|
||||
{ Read date & Time function implementations }
|
||||
{$i dati.inc}
|
||||
|
||||
@ -155,14 +150,14 @@ interface
|
||||
fmessage:=msg;
|
||||
end;
|
||||
|
||||
{$ifdef autoobjpas}
|
||||
|
||||
constructor exception.createfmt(const msg : string; const args : array of const);
|
||||
|
||||
begin
|
||||
inherited create;
|
||||
fmessage:=Format(msg,args);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
|
||||
constructor exception.createres(ident : longint);
|
||||
|
||||
@ -171,8 +166,8 @@ interface
|
||||
{!!!!!}
|
||||
end;
|
||||
|
||||
|
||||
Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer);
|
||||
|
||||
Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer);
|
||||
Var
|
||||
Message : String;
|
||||
begin
|
||||
@ -193,13 +188,13 @@ end;
|
||||
|
||||
Var OutOfMemory : EOutOfMemory;
|
||||
InValidPointer : EInvalidPointer;
|
||||
|
||||
|
||||
|
||||
Procedure RunErrorToExcept (ErrNo : Longint; Address : Pointer);
|
||||
|
||||
Var E : Exception;
|
||||
S : String;
|
||||
|
||||
|
||||
begin
|
||||
Case Errno of
|
||||
1,203 : E:=OutOfMemory;
|
||||
@ -224,37 +219,32 @@ begin
|
||||
E:=EinOutError.Create (S);
|
||||
EInoutError(E).ErrorCode:=IOresult; // Clears InOutRes !!
|
||||
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...
|
||||
200 : E:=EDivByZero.Create(SDivByZero);
|
||||
201 : E:=ERangeError.Create(SRangeError);
|
||||
201 : E:=ERangeError.Create(SRangeError);
|
||||
211 : E:=EAbstractError.Create(SAbstractError);
|
||||
216 : E:=EAccessViolation.Create(SAccessViolation);
|
||||
219 : E:=EInvalidCast.Create(SInvalidCast);
|
||||
227 : E:=EAssertionFailed.Create(SAssertionFailed);
|
||||
else
|
||||
{$ifdef autoobjpas}
|
||||
E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
|
||||
{$else}
|
||||
E:=Exception.Create(SUnknownRunTimeError);
|
||||
{$endif}
|
||||
end;
|
||||
Raise E {at Address};
|
||||
end;
|
||||
|
||||
{$ifdef autoobjpas}
|
||||
|
||||
Procedure AssertErrorHandler (Const Msg,FN : String;LineNo,TheAddr : Longint);
|
||||
|
||||
Var S: String;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
begin
|
||||
If Msg='' then
|
||||
If Msg='' then
|
||||
S:=SAssertionFailed
|
||||
else
|
||||
S:=Msg;
|
||||
Raise EAssertionFailed.Createfmt(SAssertError,[S,Fn,LineNo]); // at Pointer(theAddr);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
|
||||
Procedure InitExceptions;
|
||||
{
|
||||
@ -267,9 +257,7 @@ begin
|
||||
// Create objects that may have problems when there is no memory.
|
||||
OutOfMemory:=EOutOfMemory.Create(SOutOfMemory);
|
||||
InvalidPointer:=EInvalidPointer.Create(SInvalidPointer);
|
||||
{$ifdef autoobjpas}
|
||||
AssertErrorProc:=@AssertErrorHandler;
|
||||
{$endif}
|
||||
ErrorProc:=@RunErrorToExcept;
|
||||
end;
|
||||
|
||||
@ -280,7 +268,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.16 1998/10/11 12:23:41 michael
|
||||
|
||||
@ -23,11 +23,6 @@ unit typinfo;
|
||||
|
||||
{$MODE objfpc}
|
||||
|
||||
{$ifndef AUTOOBJPAS}
|
||||
uses
|
||||
objpas;
|
||||
{$endif}
|
||||
|
||||
// temporary types:
|
||||
|
||||
type
|
||||
@ -39,7 +34,7 @@ unit typinfo;
|
||||
PDouble =^Double;
|
||||
PExtended =^Extended;
|
||||
PComp =^Comp;
|
||||
PFixed16 =^Fixed16;
|
||||
PFixed16 =^Fixed16;
|
||||
{ Doesn't exist ?
|
||||
PFIxed32 = ^Fixed32;
|
||||
}
|
||||
@ -143,7 +138,7 @@ unit typinfo;
|
||||
// bit 0..1 GetProc
|
||||
// 2..3 SetProc
|
||||
// 4..5 StoredProc
|
||||
// 6 : true, constant index property
|
||||
// 6 : true, constant index property
|
||||
PropProcs : Byte;
|
||||
|
||||
Name : ShortString;
|
||||
@ -202,7 +197,7 @@ unit typinfo;
|
||||
{$ASMMODE ATT}
|
||||
|
||||
function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler;
|
||||
|
||||
|
||||
Label LINoPush;
|
||||
|
||||
asm
|
||||
@ -228,7 +223,7 @@ unit typinfo;
|
||||
movl Address,%edi
|
||||
// Push value to set
|
||||
movl Value,%eax
|
||||
pushl %eax
|
||||
pushl %eax
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
@ -241,7 +236,7 @@ unit typinfo;
|
||||
end;
|
||||
|
||||
function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
|
||||
|
||||
|
||||
Label LINoPush;
|
||||
|
||||
asm
|
||||
@ -268,7 +263,7 @@ unit typinfo;
|
||||
// Push value to set
|
||||
//!! MUST BE CHANGED !!
|
||||
movl Value,%eax
|
||||
pushl %eax
|
||||
pushl %eax
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
@ -282,7 +277,7 @@ unit typinfo;
|
||||
function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
|
||||
|
||||
Label LBNoPush;
|
||||
|
||||
|
||||
asm
|
||||
movl S,%edi
|
||||
movl Address,%edi
|
||||
@ -302,7 +297,7 @@ unit typinfo;
|
||||
|
||||
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
|
||||
Var Res: Shortstring);assembler;
|
||||
|
||||
|
||||
Label LSSNoPush;
|
||||
|
||||
asm
|
||||
@ -329,7 +324,7 @@ unit typinfo;
|
||||
// Push value to set
|
||||
//!! Is this correct for short strings ????
|
||||
movl Value,%eax
|
||||
pushl %eax
|
||||
pushl %eax
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
@ -403,10 +398,10 @@ unit typinfo;
|
||||
Var TD : PTypeData;
|
||||
TP : PPropInfo;
|
||||
Count : Longint;
|
||||
|
||||
|
||||
begin
|
||||
TD:=GetTypeData(TypeInfo);
|
||||
// Get this objects TOTAL published properties count
|
||||
// Get this objects TOTAL published properties count
|
||||
TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
|
||||
Count:=PWord(TP)^;
|
||||
// Now point TP to first propinfo record.
|
||||
@ -415,7 +410,7 @@ unit typinfo;
|
||||
begin
|
||||
PropList^[0]:=TP;
|
||||
Inc(Longint(PropList),SizeOf(Pointer));
|
||||
// Point to TP next propinfo record.
|
||||
// Point to TP next propinfo record.
|
||||
// Located at Name[Length(Name)+1] !
|
||||
TP:=PPropInfo((@TP^.Name)+PByte(@TP^.Name)^+1);
|
||||
Dec(Count);
|
||||
@ -424,17 +419,17 @@ unit typinfo;
|
||||
If TD^.Parentinfo<>Nil then
|
||||
GetPropInfos (TD^.ParentInfo,PropList);
|
||||
end;
|
||||
|
||||
Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
|
||||
|
||||
|
||||
Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
|
||||
|
||||
VAr I : Longint;
|
||||
|
||||
|
||||
begin
|
||||
I:=0;
|
||||
While (I<Count) and (PI^.Name>PL^[I]^.Name) do Inc(I);
|
||||
If I<Count then
|
||||
Move(PL^[I],PL[I+1],Count-I*SizeOf(Pointer));
|
||||
PL^[I]:=PI;
|
||||
PL^[I]:=PI;
|
||||
end;
|
||||
|
||||
function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
|
||||
@ -448,7 +443,7 @@ unit typinfo;
|
||||
Var TempList : PPropList;
|
||||
PropInfo : PPropinfo;
|
||||
I,Count : longint;
|
||||
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
Count:=GetTypeData(TypeInfo)^.Propcount;
|
||||
@ -467,13 +462,13 @@ unit typinfo;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeMem(TempList,Count*SizeOf(Pointer));
|
||||
FreeMem(TempList,Count*SizeOf(Pointer));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure SetIndexValues (P: PPRopInfo; Var Index,IValue : Longint);
|
||||
|
||||
|
||||
begin
|
||||
Index:=((P^.PropProcs shr 6) and 1);
|
||||
If Index=0 then
|
||||
@ -536,16 +531,16 @@ unit typinfo;
|
||||
end;
|
||||
|
||||
Function GetAStrProp(Instance : TObject;PropInfo : PPropInfo):Pointer;
|
||||
|
||||
|
||||
{
|
||||
Dirty trick based on fact that AnsiString is just a pointer,
|
||||
hence can be treated like an integer type.
|
||||
}
|
||||
|
||||
|
||||
var
|
||||
value : Pointer;
|
||||
Index,Ivalue : Longint;
|
||||
|
||||
|
||||
begin
|
||||
SetIndexValues(PropInfo,Index,IValue);
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
@ -562,11 +557,11 @@ unit typinfo;
|
||||
end;
|
||||
|
||||
Function GetSStrProp(Instance : TObject;PropInfo : PPropInfo):ShortString;
|
||||
|
||||
|
||||
var
|
||||
value : ShortString;
|
||||
Index,IValue : Longint;
|
||||
|
||||
|
||||
begin
|
||||
SetIndexValues(PropInfo,Index,IValue);
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
@ -601,16 +596,16 @@ unit typinfo;
|
||||
Dirty trick based on fact that AnsiString is just a pointer,
|
||||
hence can be treated like an integer type.
|
||||
}
|
||||
|
||||
|
||||
var
|
||||
Index,Ivalue : Longint;
|
||||
|
||||
|
||||
begin
|
||||
SetIndexValues(PropInfo,Index,IValue);
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
ptfield:
|
||||
PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Longint(Pointer(Value)) ;
|
||||
ptstatic:
|
||||
ptstatic:
|
||||
CallIntegerProc(Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue);
|
||||
ptvirtual:
|
||||
CallIntegerProc(Instance,
|
||||
@ -618,7 +613,7 @@ unit typinfo;
|
||||
Longint(Pointer(Value)),Index,IValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
const Value : ShortString);
|
||||
|
||||
@ -637,7 +632,7 @@ unit typinfo;
|
||||
Value,Index,IValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
const Value : AnsiString);
|
||||
|
||||
@ -660,7 +655,7 @@ unit typinfo;
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
ptfield:
|
||||
Case GetTypeData(PropInfo^.PropType)^.FloatType of
|
||||
ftSingle:
|
||||
ftSingle:
|
||||
Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
||||
ftDouble:
|
||||
Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
||||
@ -673,7 +668,7 @@ unit typinfo;
|
||||
Value:=PFixed16(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
||||
ftfixed32:
|
||||
Value:=PFixed32(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
||||
}
|
||||
}
|
||||
end;
|
||||
ptstatic:
|
||||
Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
|
||||
@ -686,15 +681,15 @@ unit typinfo;
|
||||
|
||||
procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
Value : Extended);
|
||||
|
||||
|
||||
Var IValue,Index : longint;
|
||||
|
||||
|
||||
begin
|
||||
SetIndexValues(PropInfo,Index,Ivalue);
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
ptfield:
|
||||
Case GetTypeData(PropInfo^.PropType)^.FloatType of
|
||||
ftSingle:
|
||||
ftSingle:
|
||||
PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
ftDouble:
|
||||
PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
@ -707,7 +702,7 @@ unit typinfo;
|
||||
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
ftfixed32:
|
||||
PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
}
|
||||
}
|
||||
end;
|
||||
ptstatic:
|
||||
CallExtendedProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
|
||||
@ -747,7 +742,7 @@ unit typinfo;
|
||||
function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
|
||||
|
||||
Var PS : PShortString;
|
||||
PT : PTypeData;
|
||||
PT : PTypeData;
|
||||
|
||||
begin
|
||||
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
|
||||
@ -762,20 +757,20 @@ unit typinfo;
|
||||
end;
|
||||
|
||||
function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
|
||||
|
||||
|
||||
Var PS : PShortString;
|
||||
PT : PTypeData;
|
||||
Count : longint;
|
||||
|
||||
|
||||
begin
|
||||
If Length(Name)=0 then exit(-1);
|
||||
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
|
||||
Count:=0;
|
||||
Result:=-1;
|
||||
PS:=@PT^.NameList;
|
||||
While (Result=-1) and (PByte(PS)^<>0) do
|
||||
While (Result=-1) and (PByte(PS)^<>0) do
|
||||
begin
|
||||
If PS^=Name then
|
||||
If PS^=Name then
|
||||
Result:=Count;
|
||||
PS:=PS+PByte(PS)^;
|
||||
Inc(Count);
|
||||
@ -786,7 +781,10 @@ end.
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.15 1998/11/26 14:57:47 michael
|
||||
|
||||
@ -74,9 +74,7 @@ var
|
||||
MainInstance,
|
||||
cmdshow : longint;
|
||||
IsLibrary,IsMultiThreaded,IsConsole : boolean;
|
||||
{* Changes made by Ozerski 26.10.1998}
|
||||
DLLreason,DLLparam:longint;
|
||||
{* End Changes}
|
||||
|
||||
implementation
|
||||
|
||||
@ -639,7 +637,6 @@ begin
|
||||
GetCommandFile:=@ModuleName;
|
||||
end;
|
||||
|
||||
{* End changes}
|
||||
|
||||
procedure setup_arguments;
|
||||
var
|
||||
@ -695,30 +692,6 @@ begin
|
||||
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}
|
||||
Function SetUpStack : longint;
|
||||
{ This routine does the following : }
|
||||
@ -942,8 +915,6 @@ var
|
||||
Exe_entry_code : pointer = @Exe_entry;
|
||||
Dll_entry_code : pointer = @Dll_entry;
|
||||
|
||||
{$endif def FPC_WIN32_DLL_SUPPORT}
|
||||
|
||||
{$ASMMODE ATT}
|
||||
|
||||
begin
|
||||
@ -980,7 +951,10 @@ end.
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.27 1998/12/01 14:00:08 pierre
|
||||
|
||||
Loading…
Reference in New Issue
Block a user