mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-01 09:42:39 +02:00
+ RTLLITE directive to compile minimal RTL.
This commit is contained in:
daniel
parent
2abf9ca1b3
commit
c43a386001
@ -140,6 +140,8 @@ begin
|
||||
upcase[i] := upcase (s[i]);
|
||||
end;
|
||||
|
||||
{$ifndef RTLLITE}
|
||||
|
||||
function lowercase(c : char) : char;
|
||||
{$IFDEF IBM_CHAR_SET}
|
||||
var
|
||||
@ -172,13 +174,6 @@ begin
|
||||
lowercase[i] := lowercase (s[i]);
|
||||
end;
|
||||
|
||||
function space (b : byte): string;
|
||||
|
||||
begin
|
||||
space[0] := chr(b);
|
||||
FillChar (Space[1],b,' ');
|
||||
end;
|
||||
|
||||
function hexstr(val : longint;cnt : byte) : string;
|
||||
|
||||
const
|
||||
@ -209,6 +204,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$endif RTLLITE}
|
||||
|
||||
function space (b : byte): string;
|
||||
|
||||
begin
|
||||
space[0] := chr(b);
|
||||
FillChar (Space[1],b,' ');
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
Str() Helpers
|
||||
@ -300,7 +303,7 @@ begin
|
||||
inc(code);
|
||||
until (code>=length(s)) or (s[code]<>'0');
|
||||
if length(s)-code>7 then
|
||||
inc(code,8);
|
||||
code:=code+8;
|
||||
end;
|
||||
'%' : begin
|
||||
base:=2;
|
||||
@ -331,9 +334,9 @@ begin
|
||||
begin
|
||||
u:=ord(s[code]);
|
||||
case u of
|
||||
48..57 : dec(u,48);
|
||||
65..70 : dec(u,55);
|
||||
97..104 : dec(u,87);
|
||||
48..57 : u:=u-48;
|
||||
65..70 : u:=u-55;
|
||||
97..104 : u:=u-87;
|
||||
else
|
||||
u:=16;
|
||||
end;
|
||||
@ -343,7 +346,7 @@ begin
|
||||
l:=0;
|
||||
exit;
|
||||
end;
|
||||
inc(l,u);
|
||||
l:=l+u;
|
||||
inc(code);
|
||||
end;
|
||||
code := 0;
|
||||
@ -676,9 +679,9 @@ begin
|
||||
begin
|
||||
u:=ord(s[code]);
|
||||
case u of
|
||||
48..57 : dec(u,48);
|
||||
65..70 : dec(u,55);
|
||||
97..104 : dec(u,87);
|
||||
48..57 : u:=u-48;
|
||||
65..70 : u:=u-55;
|
||||
97..104 : u:=u-87;
|
||||
else
|
||||
u:=16;
|
||||
end;
|
||||
@ -688,7 +691,7 @@ begin
|
||||
v:=0;
|
||||
exit;
|
||||
end;
|
||||
inc(v,u);
|
||||
v:=v+u;
|
||||
inc(code);
|
||||
end;
|
||||
code:=0;
|
||||
@ -710,7 +713,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1998-06-04 23:45:59 peter
|
||||
Revision 1.6 1998-06-25 09:44:19 daniel
|
||||
+ RTLLITE directive to compile minimal RTL.
|
||||
|
||||
Revision 1.5 1998/06/04 23:45:59 peter
|
||||
* comp,extended are only i386 added support_comp,support_extended
|
||||
|
||||
Revision 1.4 1998/05/31 14:14:52 peter
|
||||
|
||||
@ -120,7 +120,7 @@ Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Run-Time Type Information (RTTI)
|
||||
Run-Time Type Information (RTTI)
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
@ -335,7 +335,7 @@ Begin
|
||||
halt(216);
|
||||
End;
|
||||
}
|
||||
|
||||
{$ifndef RTLLITE}
|
||||
Procedure dump_stack(bp : Longint);
|
||||
|
||||
Procedure dump_frame(addr : Longint);
|
||||
@ -361,6 +361,7 @@ Begin
|
||||
End;
|
||||
End;
|
||||
|
||||
{$endif RTLLITE}
|
||||
|
||||
Procedure Do_exit;[Public,Alias: '__EXIT'];
|
||||
{
|
||||
@ -376,16 +377,23 @@ Begin
|
||||
exitProc:=nil;
|
||||
current_exit();
|
||||
End;
|
||||
If DoError Then
|
||||
If erroraddr<>nil Then
|
||||
Begin
|
||||
{$ifndef RTLLITE}
|
||||
Writeln('Run time error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
|
||||
dump_stack(ErrorBase);
|
||||
{$else RTLLITE}
|
||||
writeln('Runerror ',errorcode,' at ',longint(erroraddr));
|
||||
{$endif RTLLITE}
|
||||
End;
|
||||
Flush(stderr);
|
||||
|
||||
End;
|
||||
|
||||
|
||||
{$ifndef RTLLITE}
|
||||
|
||||
|
||||
Type
|
||||
PExitProcInfo = ^TExitProcInfo;
|
||||
TExitProcInfo = Record
|
||||
@ -422,9 +430,14 @@ Begin
|
||||
ExitProc:=@DoExitProc;
|
||||
End;
|
||||
|
||||
{$endif RTLLITE}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-06-15 15:16:26 daniel
|
||||
Revision 1.11 1998-06-25 09:44:20 daniel
|
||||
+ RTLLITE directive to compile minimal RTL.
|
||||
|
||||
Revision 1.10 1998/06/15 15:16:26 daniel
|
||||
|
||||
* RTLLITE conditional added to produce smaller RTL
|
||||
|
||||
|
||||
@ -206,11 +206,13 @@ Function Pos(const substr:string;const s:string):byte;
|
||||
Function Pos(C:Char;const s:string):byte;
|
||||
Function upCase(c:Char):Char;
|
||||
Function upCase(const s:string):string;
|
||||
{$ifndef RTLLITE}
|
||||
Function lowerCase(c:Char):Char;
|
||||
Function lowerCase(const s:string):string;
|
||||
Function Space(b:byte):string;
|
||||
Function hexStr(Val:Longint;cnt:byte):string;
|
||||
Function binStr(Val:Longint;cnt:byte):string;
|
||||
{$endif RTLLITE}
|
||||
Function Space(b:byte):string;
|
||||
Procedure Val(const s:string;Var l:Longint;Var code:Word);
|
||||
Procedure Val(const s:string;Var l:Longint;Var code:Integer);
|
||||
Procedure Val(const s:string;Var l:Longint);
|
||||
@ -373,17 +375,24 @@ Function Sptr:Longint;
|
||||
|
||||
Function Paramcount:Longint;
|
||||
Function ParamStr(l:Longint):string;
|
||||
{$ifndef RTLLITE}
|
||||
Procedure Dump_Stack(bp:Longint);
|
||||
{$endif RTLLITE}
|
||||
Procedure RunError(w:Word);
|
||||
Procedure RunError;
|
||||
Procedure halt(errnum:byte);
|
||||
Procedure halt;
|
||||
{$ifndef RTLLITE}
|
||||
Procedure AddExitProc(Proc:TProcedure);
|
||||
{$endif RTLLITE}
|
||||
Procedure halt;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1998-06-15 15:16:27 daniel
|
||||
Revision 1.13 1998-06-25 09:44:21 daniel
|
||||
+ RTLLITE directive to compile minimal RTL.
|
||||
|
||||
Revision 1.12 1998/06/15 15:16:27 daniel
|
||||
|
||||
* RTLLITE conditional added to produce smaller RTL
|
||||
|
||||
|
||||
@ -364,8 +364,8 @@ Begin
|
||||
Begin
|
||||
Move(s[Pos],f.Bufptr^[f.BufPos],hbytes);
|
||||
f.BufPos:=f.BufPos+hbytes;
|
||||
dec(copybytes,hbytes);
|
||||
Inc(Pos,hbytes);
|
||||
copybytes:=copybytes-hbytes;
|
||||
pos:=pos+hbytes;
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
hbytes:=f.BufSize-f.BufPos;
|
||||
End;
|
||||
@ -411,8 +411,8 @@ Begin
|
||||
Begin
|
||||
Move(p[Pos],f.Bufptr^[f.BufPos],hbytes);
|
||||
f.BufPos:=f.BufPos+hbytes;
|
||||
dec(copybytes,hbytes);
|
||||
Inc(Pos,hbytes);
|
||||
copybytes:=copybytes-hbytes;
|
||||
pos:=pos+hbytes;
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
hbytes:=f.BufSize-f.BufPos;
|
||||
End;
|
||||
@ -711,7 +711,7 @@ Begin
|
||||
inc(Temp);
|
||||
{ copy string. }
|
||||
Move (f.Bufptr^[f.BufPos],p^,Temp-f.BufPos);
|
||||
Inc(Longint(p),Temp-f.BufPos);
|
||||
longint(p):=longint(p)+(temp-f.bufpos);
|
||||
If pchar(p-1)^=#13 Then
|
||||
dec(p);
|
||||
{ update f.BufPos }
|
||||
@ -744,7 +744,7 @@ Begin
|
||||
inc(Temp);
|
||||
{ copy string. }
|
||||
Move (f.Bufptr^[f.BufPos],p^,Temp-f.BufPos);
|
||||
Inc(Longint(p),Temp-f.BufPos);
|
||||
longint(p):=longint(p)+(temp-f.bufpos);
|
||||
If pchar(p-1)^=#13 Then
|
||||
dec(p);
|
||||
{ update f.BufPos }
|
||||
@ -959,7 +959,10 @@ End;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-06-04 23:46:03 peter
|
||||
Revision 1.11 1998-06-25 09:44:22 daniel
|
||||
+ RTLLITE directive to compile minimal RTL.
|
||||
|
||||
Revision 1.10 1998/06/04 23:46:03 peter
|
||||
* comp,extended are only i386 added support_comp,support_extended
|
||||
|
||||
Revision 1.9 1998/06/02 16:47:56 pierre
|
||||
|
||||
Loading…
Reference in New Issue
Block a user