paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-29 03:13:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

* merges from fixes

Browse Source
This commit is contained in:
peter 2000-08-04 22:00:50 +00:00
parent 6bf27d1c7a
commit 4549ef44e1
10 changed files with 102 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/ag386bin.pas
View File

@ -977,15 +977,28 @@ unit ag386bin;
destructor ti386binasmlist.done;
{$ifdef MEMDEBUG}
var
d : tmemdebug;
{$endif}
begin
{$ifdef MEMDEBUG}
d.init('agbin');
{$endif}
dispose(objectoutput,done);
dispose(objectalloc,done);
{$ifdef MEMDEBUG}
d.done;
{$endif}
end;
end.
{
$Log$
Revision 1.3 2000-07-13 12:08:24 michael
Revision 1.4 2000-08-04 22:00:50 peter
* merges from fixes
Revision 1.3 2000/07/13 12:08:24 michael
+ patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:29 michael

9
compiler/cg386add.pas
View File

@ -673,7 +673,7 @@ implementation
pushed,mboverflow,cmpop : boolean;
op,op2 : tasmop;
flags : tresflags;
otl,ofl,hl : pasmlabel;
otl,ofl : pasmlabel;
power : longint;
opsize : topsize;
hl4: pasmlabel;
@ -2324,7 +2324,10 @@ implementation
end.
{
$Log$
Revision 1.3 2000-07-27 09:25:05 jonas
Revision 1.4 2000-08-04 22:00:50 peter
* merges from fixes
Revision 1.3 2000/07/27 09:25:05 jonas
* moved locflags2reg() procedure from cg386add to cgai386
+ added locjump2reg() procedure to cgai386
* fixed internalerror(2002) when the result of a case expression has
@ -2334,4 +2337,4 @@ end.
Revision 1.2 2000/07/13 11:32:32 michael
+ removed logs
}
}

9
compiler/cg386inl.pas
View File

@ -898,7 +898,7 @@ implementation
l : longint;
ispushed : boolean;
hregister : tregister;
otlabel,oflabel,l1 : pasmlabel;
otlabel,oflabel{,l1} : pasmlabel;
oldpushedparasize : longint;
begin
@ -1468,7 +1468,7 @@ implementation
else
emit_none(A_FCOS,S_NO);
{
getlabel(l1);
getlabel(l1);
emit_reg(A_FNSTSW,S_NO,R_AX);
emit_none(A_SAHF,S_NO);
emitjmp(C_NP,l1);
@ -1528,7 +1528,10 @@ implementation
end.
{
$Log$
Revision 1.4 2000-07-29 18:27:53 sg
Revision 1.5 2000-08-04 22:00:50 peter
* merges from fixes
Revision 1.4 2000/07/29 18:27:53 sg
* Applied patch by Markus Kaemmerer which removes a tiny memory leak
for the generation of code for in_[sin|cos]_extended code
(a label has been created but never used afterwards)

9
compiler/compiler.pas
View File

@ -342,6 +342,9 @@ begin
Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
{$endif newcg}
{$endif EXTDEBUG}
{$ifdef MEMDEBUG}
Writeln('Memory used: ',system.Heapsize);
{$endif}
{$ifdef fixLeaksOnError}
{$ifdef tp}
do_stop;
@ -355,7 +358,9 @@ end;
end.
{
$Log$
Revision 1.2 2000-07-13 11:32:38 michael
+ removed logs
Revision 1.3 2000-08-04 22:00:50 peter
* merges from fixes
Revision 1.2 2000/07/13 11:32:38 michael
+ removed logs
}

21
compiler/comprsrc.pas
View File

@ -66,17 +66,21 @@ end;
procedure tresourcefile.compile;
var
respath : pathstr;
n : namestr;
e : extstr;
s,
resobj,
respath,
resbin : string;
resbin : string;
resfound : boolean;
begin
resbin:='';
if utilsdirectory<>'' then
respath:=FindFile(target_res.resbin+source_os.exeext,utilsdirectory,resfound)
else
respath:=FindExe(target_res.resbin,resfound);
resbin:=respath+target_res.resbin+source_os.exeext;
resbin:=FindFile(target_res.resbin+source_os.exeext,utilsdirectory,resfound)+target_res.resbin+source_os.exeext;
if resbin='' then
resbin:=FindExe(target_res.resbin,resfound);
{ get also the path to be searched for the windres.h }
fsplit(resbin,respath,n,e);
if (not resfound) and not(cs_link_extern in aktglobalswitches) then
begin
Message(exec_w_res_not_found);
@ -136,7 +140,10 @@ end;
end.
{
$Log$
Revision 1.2 2000-07-13 11:32:38 michael
Revision 1.3 2000-08-04 22:00:51 peter
* merges from fixes
Revision 1.2 2000/07/13 11:32:38 michael
+ removed logs
}

8
compiler/pexpr.pas
View File

@ -141,7 +141,7 @@ unit pexpr;
do_firstpass(p);
set_varstate(p,false);
{ reset varstateset to maybe set used state later web bug769 PM }
p^.varstateset:=false;
unset_varstate(p);
if not(getprocvar) and (p^.resulttype^.deftype=procvardef) then
begin
p1:=gencallnode(nil,nil);
@ -2170,7 +2170,9 @@ _LECKKLAMMER : begin
end.
{
$Log$
Revision 1.2 2000-07-13 11:32:44 michael
+ removed logs
Revision 1.3 2000-08-04 22:00:52 peter
* merges from fixes
Revision 1.2 2000/07/13 11:32:44 michael
+ removed logs
}

7
compiler/popt386.pas
View File

@ -101,7 +101,7 @@ Procedure PeepHoleOptPass1(Asml: PAasmOutput; BlockStart, BlockEnd: Pai);
{First pass of peepholeoptimizations}
Var
l, l1 : longint;
l : longint;
p,hp1,hp2 : pai;
hp3,hp4: pai;
@ -1945,7 +1945,10 @@ End.
{
$Log$
Revision 1.6 2000-07-31 08:44:05 jonas
Revision 1.7 2000-08-04 22:00:52 peter
* merges from fixes
Revision 1.6 2000/07/31 08:44:05 jonas
- removed imul support from -dfoldarithops since "imull [reg32],[mem32]"
doesn't exist (merged from fixes branch)

10
compiler/tcmem.pas
View File

@ -607,10 +607,7 @@ implementation
if assigned(p^.left) and assigned(p^.right) then
begin
firstpass(p^.left);
{ is this correct ? At least after is like if used
set_varstate(p^.left,false);
already done in _with_statment }
p^.left^.varstateset:=false;
unset_varstate(p^.left);
set_varstate(p^.left,true);
if codegenerror then
exit;
@ -642,7 +639,10 @@ implementation
end.
{
$Log$
Revision 1.4 2000-08-02 19:49:59 peter
Revision 1.5 2000-08-04 22:00:52 peter
* merges from fixes
Revision 1.4 2000/08/02 19:49:59 peter
* first things for default parameters
Revision 1.3 2000/07/13 12:08:28 michael

78
compiler/tree.pas
View File

@ -342,6 +342,7 @@ unit tree;
vsr_is_used_after,vsr_must_be_valid_and_is_used_after); }
{ sets varsym varstate field correctly }
procedure unset_varstate(p : ptree);
procedure set_varstate(p : ptree;must_be_valid : boolean);
{ gibt den ordinalen Werten der Node zurueck oder falls sie }
@ -1808,6 +1809,24 @@ unit tree;
end;
end;
procedure unset_varstate(p : ptree);
begin
while assigned(p) do
begin
p^.varstateset:=false;
case p^.treetype of
typeconvn,
subscriptn,
vecn :
p:=p^.left;
else
break;
end;
end;
end;
procedure set_varstate(p : ptree;must_be_valid : boolean);
begin
@ -1838,18 +1857,10 @@ unit tree;
set_varstate(p^.left,must_be_valid);
vecn:
begin
{$IFDEF NEWST}
if (typeof(p^.left^.resulttype^)=typeof(Tstringdef)) or
(typeof(p^.left^.resulttype^)=typeof(Tarraydef)) then
set_varstate(p^.left,must_be_valid)
else
set_varstate(p^.left,true);
{$ELSE}
if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then
set_varstate(p^.left,must_be_valid)
else
set_varstate(p^.left,true);
{$ENDIF NEWST}
set_varstate(p^.right,true);
end;
{ do not parse calln }
@ -1860,50 +1871,6 @@ unit tree;
set_varstate(p^.right,must_be_valid);
end;
loadn :
{$IFDEF NEWST}
if (typeof(p^.symtableentry^)=typeof(Tvarsym)) or
(typeof(p^.symtableentry^)=typeof(Tparamsym)) then
begin
if must_be_valid and p^.is_first then
begin
if (pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found) or
(pvarsym(p^.symtableentry)^.state=vs_set_but_first_not_passed) then
if (assigned(pvarsym(p^.symtableentry)^.owner) and
assigned(aktprocsym) and
(pvarsym(p^.symtableentry)^.owner=
Pcontainingsymtable(aktprocdef^.localst))) then
begin
if typeof(p^.symtable^)=typeof(Tprocsymtable) then
CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
else
CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
end;
end;
if (p^.is_first) then
begin
if pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found then
{ this can only happen at left of an assignment, no ? PM }
if (parsing_para_level=0) and not must_be_valid then
pvarsym(p^.symtableentry)^.state:=vs_assigned
else
pvarsym(p^.symtableentry)^.state:=vs_used;
if pvarsym(p^.symtableentry)^.state=vs_set_but_first_not_passed then
pvarsym(p^.symtableentry)^.state:=vs_used;
p^.is_first:=false;
end
else
begin
if (pvarsym(p^.symtableentry)^.state=vs_assigned) and
(must_be_valid or (parsing_para_level>0) or
(typeof(p^.resulttype^)=typeof(Tprocvardef))) then
pvarsym(p^.symtableentry)^.state:=vs_used;
if (pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found) and
(must_be_valid or (parsing_para_level>0) or
(typeof(p^.resulttype^)=typeof(Tprocvardef))) then
pvarsym(p^.symtableentry)^.state:=vs_set_but_first_not_passed;
end;
end;
{$ELSE}
if (p^.symtableentry^.typ=varsym) then
begin
if must_be_valid and p^.is_first then
@ -1944,7 +1911,6 @@ unit tree;
pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
end;
end;
{$ENDIF NEWST}
funcretn:
begin
{ no claim if setting higher return value_str }
@ -2121,7 +2087,9 @@ unit tree;
end.
{
$Log$
Revision 1.2 2000-07-13 11:32:52 michael
+ removed logs
Revision 1.3 2000-08-04 22:00:52 peter
* merges from fixes
Revision 1.2 2000/07/13 11:32:52 michael
+ removed logs
}

26
compiler/utils/samplecfg
View File

@ -4,18 +4,26 @@
#
# Generate Sample Free Pascal configuration file
#
if [ $# != 1 ]; then
if [ $# == 0 ]; then
echo 'Usage :'
echo 'samplecfg fpcdir'
echo 'samplecfg fpcdir confdir'
echo 'fpcdir = Path where FPC is installed'
echo 'confdir = Path to /etc'
exit 1
fi
# Detect if we have write permission in root.
if [ -w /etc ] ; then
echo Write permission in /etc.
thefile=/etc/ppc386.cfg
if [ $2 ]; then
sysdir=$2
[ -d $sysdir ] || mkdir $sysdir
else
echo No write premission in /etc.
sysdir=/etc
fi
# Detect if we have write permission in root.
if [ -w $sysdir ] ; then
echo Write permission in $sysdir.
thefile=$sysdir/ppc386.cfg
else
echo No write premission in $sysdir.
thefile=$HOME/.ppc386.cfg
fi
#
@ -38,7 +46,7 @@ echo Found libgcc.a in $GCCDIR
echo Writing sample configuration file to $thefile
cat <<EOFCFG > $thefile
#
# Example ppc386.cfg for Free Pascal Compiler Version 1.00
# Example ppc386.cfg for Free Pascal Compiler
#
# ----------------------
@ -193,7 +201,7 @@ cat <<EOFCFG > $thefile
# a : Show everything 0 : Show nothing (except errors)
# Display Info, Warnings, Notes and Hints
-viwnh
-viwn
# If you don't want so much verbosity use
#-vw