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

+ $ifdef NEWPPU for the new ppuformat

Browse Source 
+ $define GDB not longer required
  * removed all warnings and stripped some log comments
  * no findfirst/findnext anymore to remove smartlink *.o files
This commit is contained in:
peter 1998-05-11 13:07:53 +00:00
parent 0a48f4956c
commit 5e4c788be5
16 changed files with 536 additions and 990 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
compiler/assemble.pas
View File

@ -44,7 +44,6 @@ type
objfile,
srcfile,
as_bin : string;
smartcnt : longint;
{outfile}
outcnt : longint;
outbuf : array[0..AsmOutSize-1] of char;
@ -70,6 +69,9 @@ type
Procedure GenerateAsm(const fn:string);
Procedure OnlyAsm(const fn:string);
var
SmartLinkFilesCnt : longint;
Function SmartLinkPath(const s:string):string;
Implementation
@ -88,16 +90,30 @@ uses
;
{*****************************************************************************
SmartLink Helpers
*****************************************************************************}
Function SmartLinkPath(const s:string):string;
var
p : dirstr;
n : namestr;
e : extstr;
begin
FSplit(s,p,n,e);
SmartLinkPath:=FixFileName(n+target_info.smartext);
end;
{*****************************************************************************
TAsmList
*****************************************************************************}
Function DoPipe:boolean;
begin
DoPipe:=use_pipe and (not WriteAsmFile) and (current_module^.output_format=of_o);
end;
{*****************************************************************************
TAsmList Calling and Name
*****************************************************************************}
const
lastas : byte=255;
var
@ -175,7 +191,7 @@ begin
DoAssemble:=true;
if DoPipe then
exit;
if (smartcnt<=1) and (not externasm) then
if (SmartLinkFilesCnt<=1) and (not externasm) then
Message1(exec_i_assembling,name);
s:=target_asm.asmcmd;
Replace(s,'$ASM',AsmFile);
@ -187,11 +203,11 @@ end;
procedure TAsmList.NextSmartName;
begin
inc(smartcnt);
if smartcnt>999999 then
inc(SmartLinkFilesCnt);
if SmartLinkFilesCnt>999999 then
Comment(V_Fatal,'Too many assembler files');
AsmFile:=Path+FixFileName('as'+tostr(smartcnt)+target_info.asmext);
ObjFile:=Path+FixFileName('as'+tostr(smartcnt)+target_info.objext);
AsmFile:=Path+FixFileName('as'+tostr(SmartLinkFilesCnt)+target_info.asmext);
ObjFile:=Path+FixFileName('as'+tostr(SmartLinkFilesCnt)+target_info.objext);
end;
@ -336,7 +352,7 @@ begin
objfile:=path+name+target_info.objext;
OutCnt:=0;
{Smartlinking}
smartcnt:=0;
SmartLinkFilesCnt:=0;
if smartlink then
begin
path:=SmartLinkPath(name);
@ -397,10 +413,17 @@ begin
dispose(a,Done);
end;
end.
{
$Log$
Revision 1.7 1998-05-07 00:17:00 peter
Revision 1.8 1998-05-11 13:07:53 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.7 1998/05/07 00:17:00 peter
* smartlinking for sets
+ consts labels are now concated/generated in hcodegen
* moved some cpu code to cga and some none cpu depended code from cga

57
compiler/cgi386ad.inc
View File

@ -401,7 +401,9 @@
{ true, if for sets subtractions the extra not should generated }
extra_not : boolean;
{$ifdef SUPPORT_MMX}
mmxbase : tmmxtype;
{$endif SUPPORT_MMX}
begin
if (p^.left^.resulttype^.deftype=stringdef) then
@ -1271,7 +1273,13 @@
{
$Log$
Revision 1.7 1998-05-01 16:38:44 florian
Revision 1.8 1998-05-11 13:07:53 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.7 1998/05/01 16:38:44 florian
* handling of private and protected fixed
+ change_keywords_to_tp implemented to remove
keywords which aren't supported by tp
@ -1295,51 +1303,4 @@
Revision 1.3 1998/04/08 11:34:22 peter
* nasm works (linux only tested)
Revision 1.2 1998/03/28 23:09:55 florian
* secondin bugfix (m68k and i386)
* overflow checking bugfix (m68k and i386) -- pretty useless in
secondadd, since everything is done using 32-bit
* loading pointer to routines hopefully fixed (m68k)
* flags problem with calls to RTL internal routines fixed (still strcmp
to fix) (m68k)
* #ELSE was still incorrect (didn't take care of the previous level)
* problem with filenames in the command line solved
* problem with mangledname solved
* linking name problem solved (was case insensitive)
* double id problem and potential crash solved
* stop after first error
* and=>test problem removed
* correct read for all float types
* 2 sigsegv fixes and a cosmetic fix for Internal Error
* push/pop is now correct optimized (=> mov (%esp),reg)
Revision 1.1.1.1 1998/03/25 11:18:12 root
* Restored version
Revision 1.15 1998/03/10 23:48:36 florian
* a couple of bug fixes to get the compiler with -OGaxz compiler, sadly
enough, it doesn't run
Revision 1.14 1998/03/10 01:17:18 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.13 1998/03/09 10:44:38 peter
+ string='', string<>'', string:='', string:=char optimizes (the first 2
were already in cg68k2)
Revision 1.12 1998/03/06 00:52:16 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.11 1998/03/02 01:48:30 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.10 1998/02/15 21:27:50 florian
*** empty log message ***
}

295
compiler/files.pas
View File

@ -26,7 +26,11 @@ unit files;
interface
uses
cobjects,globals;
cobjects,globals
{$ifdef NEWPPU}
,ppu
{$endif}
;
const
{$ifdef FPC}
@ -80,10 +84,13 @@ unit files;
pmodule = ^tmodule;
tmodule = object(tlinkedlist_item)
{$ifdef NEWPPU}
ppufile : pppufile; { the PPU file }
{$else}
ppufile : pextfile; { the PPU file }
ppuversion, { PPU version, handle different versions }
crc, { check sum written to the file }
flags : longint; { flags }
{$endif}
crc,
flags : longint; { the PPU flags }
compiled, { unit is already compiled }
do_assemble, { only assemble the object, don't recompile }
@ -120,7 +127,11 @@ unit files;
destructor special_done;virtual; { this is to be called only when compiling again }
procedure setfilename(const path,name:string);
{$ifdef NEWPPU}
function openppu(const unit_path:string):boolean;
{$else}
function load_ppu(const unit_path,n,ext:string):boolean;
{$endif}
procedure search_unit(const n : string);
end;
@ -135,8 +146,9 @@ unit files;
destructor done;virtual;
end;
{$ifndef NEWPPU}
type
tunitheader = array[0..19] of char;
const
{ compiler version }
{ format | }
@ -167,7 +179,7 @@ unit files;
ibvarsym = 10;
ibconstsym = 11;
ibinitunit = 12;
ibaufzaehlsym = 13;
ibenumsym = 13;
ibtypedconstsym = 14;
ibrecorddef = 15;
ibfiledef = 16;
@ -201,12 +213,11 @@ unit files;
uf_shared_library = $10;
uf_big_endian = $20;
uf_smartlink = $40;
const
main_module : pmodule = nil;
current_module : pmodule = nil;
{$endif}
var
main_module : pmodule;
current_module : pmodule;
loaded_units : tlinkedlist;
@ -314,6 +325,7 @@ unit files;
ff:=ff^._next;
get_file:=ff;
end;
{****************************************************************************
TMODULE
****************************************************************************}
@ -333,6 +345,238 @@ unit files;
arfilename:=stringdup(s+target_os.staticlibext);
end;
{$ifdef NEWPPU}
function tmodule.openppu(const unit_path:string):boolean;
var
temp,hs : string;
b : byte;
incfile_found : boolean;
objfiletime,
ppufiletime,
asmfiletime,
source_time : longint;
{$ifdef UseBrowser}
hp : pextfile;
_d : dirstr;
_n : namestr;
_e : extstr;
{$endif UseBrowser}
begin
openppu:=false;
{ Get ppufile time (also check if the file exists) }
ppufiletime:=getnamedfiletime(ppufilename^);
if ppufiletime=-1 then
exit;
Message1(unit_u_ppu_loading,ppufilename^);
ppufile:=new(pppufile,init(ppufilename^));
if not ppufile^.open then
begin
dispose(ppufile,done);
Message(unit_d_ppu_file_too_short);
exit;
end;
{ check for a valid PPU file }
if not ppufile^.CheckPPUId then
begin
dispose(ppufile,done);
Message(unit_d_ppu_invalid_header);
exit;
end;
{ check for allowed PPU versions }
if not (ppufile^.GetPPUVersion in [15]) then
begin
dispose(ppufile,done);
Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
exit;
end;
flags:=ppufile^.header.flags;
{ Show Debug info }
Message1(unit_d_ppu_time,filetimestring(ppufiletime));
Message1(unit_d_ppu_flags,tostr(flags));
Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
{ Unitname }
b:=ppufile^.readentry;
if b=ibunitname then
begin
stringdispose(unitname);
unitname:=stringdup(ppufile^.getstring);
b:=ppufile^.readentry;
end;
{ search source files there is at least one source file }
do_compile:=false;
sources_avail:=true;
if b=ibsourcefile then
begin
while not ppufile^.endofentry do
begin
hs:=ppufile^.getstring;
if (flags and uf_in_library)<>0 then
begin
sources_avail:=false;
temp:=' library';
end
else
begin
{ check the date of the source files }
Source_Time:=GetNamedFileTime(unit_path+hs);
if Source_Time=-1 then
begin
{ search for include files in the includepathlist }
if b<>ibend then
temp:=search(hs,includesearchpath,incfile_found);
if incfile_found then
begin
hs:=temp+hs;
Source_Time:=GetNamedFileTime(hs);
end;
end
else
hs:=unit_path+hs;
if Source_Time=-1 then
begin
sources_avail:=false;
temp:=' not found';
end
else
begin
temp:=' time '+filetimestring(source_time);
if (source_time>ppufiletime) then
begin
do_compile:=true;
temp:=temp+' *'
end;
end;
end;
Message1(unit_t_ppu_source,hs+temp);
{$ifdef UseBrowser}
fsplit(hs,_d,_n,_e);
new(hp,init(_d,_n,_e));
{ the indexing should match what is done in writeasunit }
sourcefiles.register_file(hp);
{$endif UseBrowser}
end;
end;
{ main source is always the last }
stringdispose(mainsource);
mainsource:=stringdup(hs);
{ check the object and assembler file if not a library }
if (flags and uf_in_library)=0 then
begin
if (flags and uf_smartlink)<>0 then
begin
objfiletime:=getnamedfiletime(arfilename^);
if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
do_compile:=true;
end
else
begin
{ the objectfile should be newer than the ppu file }
objfiletime:=getnamedfiletime(objfilename^);
if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
begin
{ check if assembler file is older than ppu file }
asmfileTime:=GetNamedFileTime(asmfilename^);
if (asmfiletime<0) or (ppufiletime>asmfiletime) then
begin
Message(unit_d_obj_and_asm_are_older_than_ppu);
do_compile:=true;
end
else
begin
Message(unit_d_obj_is_older_than_asm);
do_assemble:=true;
end;
end;
end;
end;
openppu:=true;
end;
procedure tmodule.search_unit(const n : string);
var
ext : string[8];
singlepathstring,
Path,
filename : string;
found : boolean;
start,i : longint;
Function UnitExists(const ext:string):boolean;
begin
Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
UnitExists:=FileExists(Singlepathstring+FileName+ext);
end;
begin
start:=1;
filename:=FixFileName(n);
path:=UnitSearchPath;
Found:=false;
repeat
{ Create current path to check }
i:=pos(';',path);
if i=0 then
i:=length(path)+1;
singlepathstring:=FixPath(copy(path,start,i-start));
delete(path,start,i-start+1);
{ Check for PPL file }
if not (cs_link_static in aktswitches) then
begin
Found:=UnitExists(target_info.unitlibext);
if Found then
Begin
SetFileName(SinglePathString,FileName);
Found:=OpenPPU(singlepathstring);
End;
end;
{ Check for PPU file }
if not (cs_link_dynamic in aktswitches) and not Found then
begin
Found:=UnitExists(target_info.unitext);
if Found then
Begin
SetFileName(SinglePathString,FileName);
Found:=OpenPPU(singlepathstring);
End;
end;
{ Check for Sources }
if not Found then
begin
ppufile:=nil;
do_compile:=true;
{Check for .pp file}
Found:=UnitExists(target_os.sourceext);
if Found then
Ext:=target_os.sourceext
else
begin
{Check for .pas}
Found:=UnitExists(target_os.pasext);
if Found then
Ext:=target_os.pasext;
end;
stringdispose(mainsource);
if Found then
begin
sources_avail:=true;
{Load Filenames when found}
mainsource:=StringDup(SinglePathString+FileName+Ext);
SetFileName(SinglePathString,FileName);
end
else
sources_avail:=false;
end;
until Found or (path='');
end;
{$else NEWPPU}
function tmodule.load_ppu(const unit_path,n,ext : string):boolean;
var
header : tunitheader;
@ -341,6 +585,7 @@ unit files;
b : byte;
incfile_found : boolean;
code : word;
ppuversion,
objfiletime,
ppufiletime,
asmfiletime,
@ -354,16 +599,15 @@ unit files;
begin
load_ppu:=false;
{ Get ppufile time (also check if the file exists) }
ppufiletime:=getnamedfiletime(ppufilename^);
if ppufiletime=-1 then
exit;
Message1(unit_u_ppu_loading,ppufilename^);
ppufile:=new(pextfile,init(unit_path,n,ext));
ppufile^.reset;
ppufile^.flush;
{Get ppufile time}
ppufiletime:=getnamedfiletime(ppufilename^);
Message1(unit_d_ppu_time,filetimestring(ppufiletime));
{ load the header }
ppufile^.read_data(header,sizeof(header),count);
if count<>sizeof(header) then
@ -372,7 +616,6 @@ unit files;
Message(unit_d_ppu_file_too_short);
exit;
end;
{ check for a valid PPU file }
if (header[0]<>'P') or (header[1]<>'P') or (header[2]<>'U') then
begin
@ -380,7 +623,6 @@ unit files;
Message(unit_d_ppu_invalid_header);
exit;
end;
{ load ppu version }
val(header[3]+header[4]+header[5],ppuversion,code);
if not(ppuversion in [13..14]) then
@ -389,11 +631,13 @@ unit files;
Message1(unit_d_ppu_invalid_version,tostr(ppuversion));
exit;
end;
flags:=byte(header[9]);
Message1(unit_d_ppu_flags,tostr(flags));
crc:=plongint(@header[10])^;
{Get ppufile time}
ppufiletime:=getnamedfiletime(ppufilename^);
{Show Debug info}
Message1(unit_d_ppu_time,filetimestring(ppufiletime));
Message1(unit_d_ppu_flags,tostr(flags));
Message1(unit_d_ppu_crc,tostr(crc));
{ read name if its there }
@ -574,6 +818,9 @@ unit files;
until Found or (path='');
end;
{$endif NEWPPU}
constructor tmodule.init(const s:string;is_unit:boolean);
var
@ -660,7 +907,13 @@ unit files;
end.
{
$Log$
Revision 1.9 1998-05-06 15:04:20 pierre
Revision 1.10 1998-05-11 13:07:53 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.9 1998/05/06 15:04:20 pierre
+ when trying to find source files of a ppufile
check the includepathlist for included files
the main file must still be in the same directory

24
compiler/link.pas
View File

@ -55,7 +55,7 @@ Type
Function DoExec(const command,para:string;info,useshell:boolean):boolean;
Function WriteResponseFile:Boolean;
Function MakeExecutable:boolean;
Procedure MakeStaticLibrary(const path:string);
Procedure MakeStaticLibrary(const path:string;filescnt:longint);
Procedure MakeSharedLibrary;
end;
PLinker=^TLinker;
@ -227,7 +227,7 @@ begin
if useshell then
shell(command+' '+para)
else
exec(command,para);
exec(command,para);
swapvectors;
if (dosexitcode<>0) then
begin
@ -403,13 +403,13 @@ begin
end;
Procedure TLinker.MakeStaticLibrary(const path:string);
Procedure TLinker.MakeStaticLibrary(const path:string;filescnt:longint);
var
arbin : string;
arfound : boolean;
cnt : longint;
i : word;
f : file;
Dir : searchrec;
begin
arbin:=FindExe('ar',arfound);
if (not arfound) and (not externlink) then
@ -421,15 +421,13 @@ begin
{ Clean up }
if (not writeasmfile) and (not externlink) then
begin
findfirst(FixPath(path)+'*'+target_info.objext,$20,Dir);
while doserror=0 do
for cnt:=1to filescnt do
begin
assign(f,FixPath(path)+dir.name);
assign(f,FixPath(path)+'as'+tostr(cnt)+target_info.objext);
{$I-}
erase(f);
erase(f);
{$I+}
i:=ioresult;
findnext(dir);
end;
{$I-}
rmdir(path);
@ -448,7 +446,13 @@ end;
end.
{
$Log$
Revision 1.7 1998-05-08 09:21:20 michael
Revision 1.8 1998-05-11 13:07:54 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.7 1998/05/08 09:21:20 michael
* Added missing -Fl message to messages file.
* Corrected mangling of file names when doing Linklib
* -Fl now actually WORKS.

101
compiler/m68k.pas
View File

@ -903,10 +903,10 @@ type
{$ifdef EXTDEBUG}
lab2str:='ILLEGAL'
else
lab2str:=target_info.labelprefix+tostr(l^.nb);
lab2str:=target_asm.labelprefix+tostr(l^.nb);
{$else EXTDEBUG}
internalerror(2000);
lab2str:=target_info.labelprefix+tostr(l^.nb);
lab2str:=target_asm.labelprefix+tostr(l^.nb);
{$endif EXTDEBUG}
l^.is_used:=true;
@ -1642,100 +1642,17 @@ type
end.
{
$Log$
Revision 1.2 1998-04-29 10:33:54 pierre
Revision 1.3 1998-05-11 13:07:54 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.2 1998/04/29 10:33:54 pierre
+ added some code for ansistring (not complete nor working yet)
* corrected operator overloading
* corrected nasm output
+ started inline procedures
+ added starstarn : use ** for exponentiation (^ gave problems)
+ started UseTokenInfo cond to get accurate positions
Revision 1.1.1.1 1998/03/25 11:18:13 root
* Restored version
Revision 1.13 1998/03/10 01:17:20 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.12 1998/03/09 12:58:11 peter
* FWait warning is only showed for Go32V2 and $E+
* opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
for m68k the same tables are removed)
+ $E for i386
Revision 1.11 1998/03/06 00:52:24 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.10 1998/03/02 01:48:43 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.9 1998/02/13 10:35:09 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.8 1998/02/12 11:50:13 daniel
Yes! Finally! After three retries, my patch!
Changes:
Complete rewrite of psub.pas.
Added support for DLL's.
Compiler requires less memory.
Platform units for each platform.
Revision 1.7 1998/01/11 03:38:05 carl
* bugfix op_reg_const , op3t was never initialized
Revision 1.3 1997/12/09 13:46:42 carl
+ renamed pai_labeled68k --> pai_labeled
+ added extended size constant
Revision 1.2 1997/11/28 18:14:37 pierre
working version with several bug fixes
Revision 1.1.1.1 1997/11/27 08:32:57 michael
FPC Compiler CVS start
Pre-CVS log:
History:
30th september 1996:
+ unit started
15th october 1996:
+ tai386 added
+ some code from asmgen moved to this unit
26th november 1996:
+ tai386_labeled
---------------------
3rd september 1997:
+ unit started
5th september 1997:
+ first version completed
24 september 1997:
+ minor fixes regarding register conventions (CEC)
26 september 1997:
+ added divs/muls tai68k constructor (CEC)
+ added mc68020 instruction types (CEC)
+ converted to work with v093 (CEC)
4th october 1997:
+ version v95 (CEC)
+ added floating point flags (CEC)
+ added op_reg_const opcode for LINK instruction. (CEC)
+ added floating point branch / flags (CEC)
2nd november 1997:
+ instruction set for the 68000/68020/common FPU/common MMU is
now supposedely complete. (CEC).
20th november 1997:
* changed LOC_FPUREGISTER to LOC_FPU same as in i386.pas (PM)
What is left to do:
o Create an opcode table to use in direct object output.
o Create an instruction template for MOVEM instruction.
}

10
compiler/parser.pas
View File

@ -405,7 +405,7 @@ unit parser;
if smartlink then
begin
Linker.SetLibName(FileName);
Linker.MakeStaticLibrary(SmartLinkPath(FileName));
Linker.MakeStaticLibrary(SmartLinkPath(FileName),SmartLinkFilesCnt);
end;
{ add the files for the linker from current_module, this must be
@ -536,7 +536,13 @@ done:
end.
{
$Log$
Revision 1.14 1998-05-06 18:36:53 peter
Revision 1.15 1998-05-11 13:07:54 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.14 1998/05/06 18:36:53 peter
* tai_section extended with code,data,bss sections and enumerated type
* ident 'compiled by FPC' moved to pmodules
* small fix for smartlink

267
compiler/pass_1.pas
View File

@ -1438,14 +1438,10 @@ unit pass_1;
procedure firststringconst(var p : ptree);
begin
{$ifdef GDB}
{why this !!! lost of dummy type definitions
one per const string !!!
p^.resulttype:=new(pstringdef,init(length(p^.values^)));}
p^.resulttype:=cstringdef;
{$Else GDB}
p^.resulttype:=new(pstringdef,init(length(p^.values^)));
{$endif * GDB *}
p^.location.loc:=LOC_MEM;
end;
@ -1626,10 +1622,6 @@ unit pass_1;
procedure firstdoubleaddr(var p : ptree);
var
hp : ptree;
hp2 : pdefcoll;
begin
make_not_regable(p^.left);
firstpass(p^.left);
@ -1949,7 +1941,7 @@ unit pass_1;
parraydef(harr)^.definition:=ppointerdef(p^.left^.resulttype)^.definition;
p^.left:=gentypeconvnode(p^.left,harr);
firstpass(p^.left);
if codegenerror then
exit;
p^.resulttype:=parraydef(harr)^.definition
@ -2198,10 +2190,6 @@ unit pass_1;
procedure first_proc_to_procvar(var p : ptree);
var
hp : ptree;
hp2 : pdefcoll;
begin
firstpass(p^.left);
if codegenerror then
@ -2261,7 +2249,6 @@ unit pass_1;
var
hp : ptree;
hp2,hp3:Pdefcoll;
aprocdef : pprocdef;
proctype : tdeftype;
@ -2668,7 +2655,6 @@ unit pass_1;
var
hp,procs,hp2 : pprocdefcoll;
pd : pprocdef;
st : psymtable;
actprocsym : pprocsym;
def_from,def_to,conv_to : pdef;
pt : ptree;
@ -3293,23 +3279,19 @@ unit pass_1;
if ret_in_param(p^.retdef) or
(@procinfo<>pprocinfo(p^.funcretprocinfo)) then
p^.registers32:=1;
{$ifdef GDB}
if must_be_valid and not pprocinfo(p^.funcretprocinfo)^.funcret_is_valid then
note(uninitialized_function_return);
if count_ref then pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true;
{$endif * GDB *}
{$else TEST_FUNCRET}
p^.resulttype:=procinfo.retdef;
p^.location.loc:=LOC_REFERENCE;
if ret_in_param(procinfo.retdef) then
p^.registers32:=1;
{$ifdef GDB}
if must_be_valid and
not(procinfo.funcret_is_valid) {and
((procinfo.flags and pi_uses_asm)=0)} then
Message(sym_w_function_result_not_set);
if count_ref then procinfo.funcret_is_valid:=true;
{$endif * GDB *}
{$endif TEST_FUNCRET}
end;
@ -3320,7 +3302,6 @@ unit pass_1;
var
hp,hpp : ptree;
isreal,store_valid,file_is_typed : boolean;
convtyp : tconverttype;
procedure do_lowhigh(adef : pdef);
@ -4891,7 +4872,13 @@ unit pass_1;
end.
{
$Log$
Revision 1.17 1998-05-06 08:38:43 pierre
Revision 1.18 1998-05-11 13:07:55 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.17 1998/05/06 08:38:43 pierre
* better position info with UseTokenInfo
UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass
@ -4966,242 +4953,4 @@ end.
Revision 1.4 1998/04/07 22:45:04 florian
* bug0092, bug0115 and bug0121 fixed
+ packed object/class/array
Revision 1.3 1998/03/28 23:09:56 florian
* secondin bugfix (m68k and i386)
* overflow checking bugfix (m68k and i386) -- pretty useless in
secondadd, since everything is done using 32-bit
* loading pointer to routines hopefully fixed (m68k)
* flags problem with calls to RTL internal routines fixed (still strcmp
to fix) (m68k)
* #ELSE was still incorrect (didn't take care of the previous level)
* problem with filenames in the command line solved
* problem with mangledname solved
* linking name problem solved (was case insensitive)
* double id problem and potential crash solved
* stop after first error
* and=>test problem removed
* correct read for all float types
* 2 sigsegv fixes and a cosmetic fix for Internal Error
* push/pop is now correct optimized (=> mov (%esp),reg)
Revision 1.2 1998/03/26 11:18:31 florian
- switch -Sa removed
- support of a:=b:=0 removed
Revision 1.1.1.1 1998/03/25 11:18:14 root
* Restored version
Revision 1.41 1998/03/13 22:45:59 florian
* small bug fixes applied
Revision 1.40 1998/03/10 23:48:36 florian
* a couple of bug fixes to get the compiler with -OGaxz compiler, sadly
enough, it doesn't run
Revision 1.39 1998/03/10 16:27:41 pierre
* better line info in stabs debug
* symtabletype and lexlevel separated into two fields of tsymtable
+ ifdef MAKELIB for direct library output, not complete
+ ifdef CHAINPROCSYMS for overloaded seach across units, not fully
working
+ ifdef TESTFUNCRET for setting func result in underfunction, not
working
Revision 1.38 1998/03/10 01:11:11 peter
* removed one of my previous optimizations with string+char, which
generated wrong code
Revision 1.37 1998/03/09 10:44:38 peter
+ string='', string<>'', string:='', string:=char optimizes (the first 2
were already in cg68k2)
Revision 1.36 1998/03/06 00:52:38 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.35 1998/03/04 08:38:19 florian
* problem with unary minus fixed
Revision 1.34 1998/03/03 01:08:31 florian
* bug0105 and bug0106 problem solved
Revision 1.33 1998/03/02 01:48:56 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.32 1998/03/01 22:46:14 florian
+ some win95 linking stuff
* a couple of bugs fixed:
bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
Revision 1.31 1998/02/28 17:26:46 carl
* bugfix #47 and more checking for aprocdef
Revision 1.30 1998/02/13 10:35:20 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.29 1998/02/12 17:19:16 florian
* fixed to get remake3 work, but needs additional fixes (output, I don't like
also that aktswitches isn't a pointer)
Revision 1.28 1998/02/12 11:50:23 daniel
Yes! Finally! After three retries, my patch!
Changes:
Complete rewrite of psub.pas.
Added support for DLL's.
Compiler requires less memory.
Platform units for each platform.
Revision 1.27 1998/02/11 21:56:34 florian
* bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
Revision 1.26 1998/02/07 23:05:03 florian
* once more MMX
Revision 1.25 1998/02/07 09:39:24 florian
* correct handling of in_main
+ $D,$T,$X,$V like tp
Revision 1.24 1998/02/06 10:34:21 florian
* bug0082 and bug0084 fixed
Revision 1.23 1998/02/05 21:54:34 florian
+ more MMX
Revision 1.22 1998/02/05 20:54:30 peter
* fixed a Sigsegv
Revision 1.21 1998/02/04 23:04:21 florian
+ unary minus for mmx data types added
Revision 1.20 1998/02/04 22:00:56 florian
+ NOT operator for mmx arrays
Revision 1.19 1998/02/04 14:38:49 florian
* clean up
* a lot of potential bugs removed adding some neccessary register allocations
(FPU!)
+ allocation of MMX registers
Revision 1.18 1998/02/03 23:07:34 florian
* AS and IS do now a correct type checking
+ is_convertable handles now also instances of classes
Revision 1.17 1998/02/01 19:40:51 florian
* clean up
* bug0029 fixed
Revision 1.16 1998/02/01 17:14:04 florian
+ comparsion of class references
Revision 1.15 1998/01/30 21:23:59 carl
* bugfix of compiler crash with new/dispose (fourth crash of new bug)
* bugfix of write/read compiler crash
Revision 1.14 1998/01/25 22:29:00 florian
* a lot bug fixes on the DOM
Revision 1.13 1998/01/21 22:34:25 florian
+ comparsion of Delphi classes
Revision 1.12 1998/01/21 21:29:55 florian
* some fixes for Delphi classes
Revision 1.11 1998/01/16 23:34:13 florian
+ nil is compatible with class variable (tobject(x):=nil)
Revision 1.10 1998/01/16 22:34:40 michael
* Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
in this compiler :)
Revision 1.9 1998/01/13 23:11:10 florian
+ class methods
Revision 1.8 1998/01/07 00:17:01 michael
Restored released version (plus fixes) as current
Revision 1.7 1997/12/10 23:07:26 florian
* bugs fixed: 12,38 (also m68k),39,40,41
+ warning if a system unit is without -Us compiled
+ warning if a method is virtual and private (was an error)
* some indentions changed
+ factor does a better error recovering (omit some crashes)
+ problem with @type(x) removed (crashed the compiler)
Revision 1.6 1997/12/09 13:54:26 carl
+ renamed some stuff (real types mostly)
Revision 1.5 1997/12/04 12:02:19 pierre
+ added a counter of max firstpass's for a ptree
for debugging only in ifdef extdebug
Revision 1.4 1997/12/03 13:53:01 carl
+ ifdef i386.
Revision 1.3 1997/11/29 15:38:43 florian
* bug0033 fixed
* duplicate strings are now really once generated (there was a bug)
Revision 1.2 1997/11/28 11:11:43 pierre
negativ real constants are not supported by nasm assembler
Revision 1.1.1.1 1997/11/27 08:32:59 michael
FPC Compiler CVS start
Pre-CVS log:
CEC Carl-Eric Codere
FK Florian Klaempfl
PM Pierre Muller
+ feature added
- removed
* bug fixed or changed
History:
6th september 1997:
+ added basic support for MC68000 (CEC)
(lines: 189,1860,1884 + ifdef m68k)
19th september 1997:
+ added evalution of constant sets (FK)
+ empty and constant sets are now compatible with all other
set types (FK)
20th september 1997:
* p^.register32 bug in firstcalln (max with register32 of p^.left i.e. args) (PM)
24th september 1997:
* line_no and inputfile are now in firstpass saved (FK)
25th september 1997:
+ support of high for open arrays (FK)
+ the high parameter is now pushed for open arrays (FK)
1th october 1997:
+ added support for unary minus operator and for:=overloading (PM)
2nd october 1997:
+ added handling of in_ord_x (PM)
boolean to byte with ord is special because the location may be different
3rd october 1997:
+ renamed ret_in_eax to ret_in_acc (CEC)
+ find ifdef m68k to find other changes (CEC)
* bugfix or calc correct val for regs. for m68k in firstcalln (CEC)
4th october 1997:
+ added code for in_pred_x in_succ_x
fails for enums with jumps (PM)
25th october 1997:
+ direct evalution of pred and succ with const parameter (FK)
6th november 1997:
* added typeconversion for floatdef in write(ln) for text to s64real (PM)
+ code for str with length arg rewritten (PM)
13th november 1997:
* floatdef in write(ln) for text for different types in RTL (PM)
* bug causing convertability from floatdef to orddef removed (PM)
* typecasting from voiddef to any type not allowed anymore (PM)
+ handling of different real const to diff realtype (PM)
18th november 1997:
* changed first_type_conv function arg as var p : ptree
to be able to change the tree (PM)
}

179
compiler/pdecl.pas
View File

@ -200,9 +200,9 @@ unit pdecl;
d:=new(pstringdef,init(p^.value))
{$ifndef GDB}
else d:=new(pstringdef,init(255));
{$else * GDB *}
{$else GDB}
else d:=globaldef('SYSTEM.STRING');
{$endif * GDB *}
{$endif GDB}
{$else UseAnsiString}
if p^.value>255 then
d:=new(pstringdef,ansiinit(p^.value))
@ -210,9 +210,9 @@ unit pdecl;
d:=new(pstringdef,init(p^.value))
{$ifndef GDB}
else d:=new(pstringdef,init(255));
{$else * GDB *}
{$else GDB}
else d:=globaldef('SYSTEM.STRING');
{$endif * GDB *}
{$endif GDB}
consume(RECKKLAMMER);
{$endif UseAnsiString}
disposetree(p);
@ -221,9 +221,9 @@ unit pdecl;
in ansistring mode ?? (PM) }
{$ifndef GDB}
else d:=new(pstringdef,init(255));
{$else * GDB *}
{$else GDB}
else d:=globaldef('SYSTEM.STRING');
{$endif * GDB *}
{$endif GDB}
stringtype:=d;
end;
@ -339,11 +339,11 @@ unit pdecl;
{GDB doesn't like unnamed types !}
aktprocsym^.definition^.retdef:=
globaldef('boolean');
{$Else * GDB *}
{$Else GDB}
aktprocsym^.definition^.retdef:=
new(porddef,init(bool8bit,0,1));
{$Endif * GDB *}
{$Endif GDB}
end;
end;
end;
@ -1008,7 +1008,7 @@ unit pdecl;
datasegment^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
end;
{$endif * GDB *}
{$endif GDB}
datasegment^.concat(new(pai_symbol,init_global(aktclass^.vmt_mangledname)));
{ determine the size with publicsyms^.datasize, because }
@ -1370,10 +1370,6 @@ unit pdecl;
forwardsallowed:=true;
hp1:=single_type(hs);
p:=new(ppointerdef,init(hp1));
{$ifndef GDB}
if lasttypesym<>nil then
save_forward(ppointerdef(p),lasttypesym);
{$else * GDB *}
{I add big troubles here
with var p : ^byte in graph.putimage
because a save_forward was called and
@ -1387,7 +1383,6 @@ unit pdecl;
if (lasttypesym<>nil)
and ((lasttypesym^.properties and sp_forwarddef)<>0) then
lasttypesym^.forwardpointer:=ppointerdef(p);
{$endif * GDB *}
forwardsallowed:=false;
end;
_RECORD:
@ -1792,7 +1787,13 @@ unit pdecl;
end.
{
$Log$
Revision 1.16 1998-05-05 12:05:42 florian
Revision 1.17 1998-05-11 13:07:55 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.16 1998/05/05 12:05:42 florian
* problems with properties fixed
* crash fixed: i:=l when i and l are undefined, was a problem with
implementation of private/protected
@ -1861,152 +1862,4 @@ end.
* fixed the -Ss bug
+ warning for Virtual constructors
* helppages updated with -TGO32V1
Revision 1.1.1.1 1998/03/25 11:18:14 root
* Restored version
Revision 1.31 1998/03/24 21:48:33 florian
* just a couple of fixes applied:
- problem with fixed16 solved
- internalerror 10005 problem fixed
- patch for assembler reading
- small optimizer fix
- mem is now supported
Revision 1.30 1998/03/21 23:59:39 florian
* indexed properties fixed
* ppu i/o of properties fixed
* field can be also used for write access
* overriding of properties
Revision 1.29 1998/03/18 22:50:11 florian
+ fstp/fld optimization
* routines which contains asm aren't longer optimzed
* wrong ifdef TEST_FUNCRET corrected
* wrong data generation for array[0..n] of char = '01234'; fixed
* bug0097 is fixed partial
* bug0116 fixed (-Og doesn't use enter of the stack frame is greater than
65535)
Revision 1.28 1998/03/10 16:27:41 pierre
* better line info in stabs debug
* symtabletype and lexlevel separated into two fields of tsymtable
+ ifdef MAKELIB for direct library output, not complete
+ ifdef CHAINPROCSYMS for overloaded seach across units, not fully
working
+ ifdef TESTFUNCRET for setting func result in underfunction, not
working
Revision 1.27 1998/03/10 01:17:23 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.26 1998/03/06 00:52:41 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.25 1998/03/05 22:43:49 florian
* some win32 support stuff added
Revision 1.24 1998/03/04 17:33:49 michael
+ Changed ifdef FPK to ifdef FPC
Revision 1.23 1998/03/04 01:35:06 peter
* messages for unit-handling and assembler/linker
* the compiler compiles without -dGDB, but doesn't work yet
+ -vh for Hint
Revision 1.22 1998/03/02 01:49:00 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.21 1998/02/28 14:43:47 florian
* final implemenation of win32 imports
* extended tai_align to allow 8 and 16 byte aligns
Revision 1.20 1998/02/19 00:11:07 peter
* fixed -g to work again
* fixed some typos with the scriptobject
Revision 1.19 1998/02/13 10:35:23 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.18 1998/02/12 17:19:19 florian
* fixed to get remake3 work, but needs additional fixes (output, I don't like
also that aktswitches isn't a pointer)
Revision 1.17 1998/02/12 11:50:25 daniel
Yes! Finally! After three retries, my patch!
Changes:
Complete rewrite of psub.pas.
Added support for DLL's.
Compiler requires less memory.
Platform units for each platform.
Revision 1.16 1998/02/11 21:56:36 florian
* bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
Revision 1.15 1998/02/06 10:34:25 florian
* bug0082 and bug0084 fixed
Revision 1.14 1998/02/02 11:56:49 pierre
* better line info for var statement
Revision 1.13 1998/01/30 21:25:31 carl
* bugfix #86 + checking of all other macros for crashes, fixed typeof
partly among others.
Revision 1.12 1998/01/23 17:12:19 pierre
* added some improvements for as and ld :
- doserror and dosexitcode treated separately
- PATH searched if doserror=2
+ start of long and ansi string (far from complete)
in conditionnal UseLongString and UseAnsiString
* options.pas cleaned (some variables shifted to globals)gl
Revision 1.11 1998/01/21 21:25:46 florian
* small problem with variante records fixed:
case a : (x,y,z) of
...
is now allowed
Revision 1.10 1998/01/13 23:11:13 florian
+ class methods
Revision 1.9 1998/01/12 13:03:31 florian
+ parsing of class methods implemented
Revision 1.8 1998/01/11 10:54:23 florian
+ generic library support
Revision 1.7 1998/01/09 23:08:32 florian
+ C++/Delphi styled //-comments
* some bugs in Delphi object model fixed
+ override directive
Revision 1.6 1998/01/09 18:01:16 florian
* VIRTUAL isn't anymore a common keyword
+ DYNAMIC is equal to VIRTUAL
Revision 1.5 1998/01/09 16:08:23 florian
* abstract methods call now abstracterrorproc if they are called
a class with an abstract method can be create with a class reference else
the compiler forbides this
Revision 1.4 1998/01/09 13:39:55 florian
* public, protected and private aren't anymore key words
+ published is equal to public
Revision 1.3 1998/01/09 13:18:12 florian
+ "forward" class declarations (type tclass = class; )
Revision 1.2 1998/01/09 09:09:58 michael
+ Initial implementation, second try
}

136
compiler/pexpr.pas
View File

@ -449,7 +449,6 @@ unit pexpr;
var
paras : ptree;
oldafterassignment : boolean;
p2 : ptree;
begin
@ -929,8 +928,6 @@ unit pexpr;
var
possible_error : boolean;
storesymtablestack : psymtable;
actprocsym : pprocsym;
begin
{$ifdef UseTokenInfo}
@ -1735,7 +1732,13 @@ unit pexpr;
end.
{
$Log$
Revision 1.13 1998-05-06 08:38:45 pierre
Revision 1.14 1998-05-11 13:07:56 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.13 1998/05/06 08:38:45 pierre
* better position info with UseTokenInfo
UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass
@ -1789,129 +1792,4 @@ end.
in MEM parsing for go32v2
better external symbol creation
support for rhgdb.exe (lowercase file names)
Revision 1.2 1998/03/26 11:18:31 florian
- switch -Sa removed
- support of a:=b:=0 removed
Revision 1.1.1.1 1998/03/25 11:18:14 root
* Restored version
Revision 1.26 1998/03/24 21:48:33 florian
* just a couple of fixes applied:
- problem with fixed16 solved
- internalerror 10005 problem fixed
- patch for assembler reading
- small optimizer fix
- mem is now supported
Revision 1.25 1998/03/21 23:59:39 florian
* indexed properties fixed
* ppu i/o of properties fixed
* field can be also used for write access
* overriding of properties
Revision 1.24 1998/03/16 22:42:21 florian
* some fixes of Peter applied:
ofs problem, profiler support
Revision 1.23 1998/03/11 11:23:57 florian
* bug0081 and bug0109 fixed
Revision 1.22 1998/03/10 16:27:42 pierre
* better line info in stabs debug
* symtabletype and lexlevel separated into two fields of tsymtable
+ ifdef MAKELIB for direct library output, not complete
+ ifdef CHAINPROCSYMS for overloaded seach across units, not fully
working
+ ifdef TESTFUNCRET for setting func result in underfunction, not
working
Revision 1.21 1998/03/10 01:17:24 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.20 1998/03/06 00:52:44 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.19 1998/03/02 01:49:02 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.18 1998/03/01 22:46:18 florian
+ some win95 linking stuff
* a couple of bugs fixed:
bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
Revision 1.17 1998/02/27 21:24:06 florian
* dll support changed (dll name can be also a string contants)
Revision 1.16 1998/02/24 00:19:17 peter
* makefile works again (btw. linux does like any char after a \ )
* removed circular unit with assemble and files
* fixed a sigsegv in pexpr
* pmodule init unit/program is the almost the same, merged them
Revision 1.15 1998/02/13 10:35:24 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.14 1998/02/12 17:19:20 florian
* fixed to get remake3 work, but needs additional fixes (output, I don't like
also that aktswitches isn't a pointer)
Revision 1.13 1998/02/12 11:50:26 daniel
Yes! Finally! After three retries, my patch!
Changes:
Complete rewrite of psub.pas.
Added support for DLL's.
Compiler requires less memory.
Platform units for each platform.
Revision 1.12 1998/02/11 21:56:37 florian
* bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
Revision 1.11 1998/02/01 22:41:11 florian
* clean up
+ system.assigned([class])
+ system.assigned([class of xxxx])
* first fixes of as and is-operator
Revision 1.10 1998/02/01 15:04:15 florian
* better error recovering
* some clean up
Revision 1.9 1998/01/30 21:27:05 carl
* partial bugfix #88, #89 and typeof and other inline functions
(these bugs have a deeper nesting level, and therefore i only fixed
the parser crashes - there is also a tree crash).
Revision 1.8 1998/01/26 17:31:01 florian
* stupid bug with self in class methods fixed
Revision 1.7 1998/01/25 22:29:02 florian
* a lot bug fixes on the DOM
Revision 1.6 1998/01/23 10:46:41 florian
* small problems with FCL object model fixed, objpas?.inc is compilable
Revision 1.5 1998/01/16 22:34:42 michael
* Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
in this compiler :)
Revision 1.4 1998/01/16 18:03:15 florian
* small bug fixes, some stuff of delphi styled constructores added
Revision 1.3 1998/01/13 23:11:14 florian
+ class methods
Revision 1.2 1998/01/09 09:09:59 michael
+ Initial implementation, second try
}

90
compiler/pmodules.pas
View File

@ -31,6 +31,9 @@ unit pmodules;
{$ifdef GDB}
,gdb
{$endif GDB}
{$ifdef NEWPPU}
,ppu
{$endif}
{ parser specific stuff }
,pbase,pdecl,pstatmnt,psub
{ processor specific stuff }
@ -270,7 +273,10 @@ unit pmodules;
loaded_unit : pmodule;
b : byte;
checksum,
{$ifndef NEWPPU}
count,
{$endif NEWPPU}
nextmapentry : longint;
hs : string;
begin
@ -278,6 +284,76 @@ unit pmodules;
new(hp^.map);
nextmapentry:=1;
{$ifdef NEWPPU}
{ load the used units from interface }
b:=hp^.ppufile^.readentry;
if b=ibloadunit_int then
begin
while not hp^.ppufile^.endofentry do
begin
hs:=hp^.ppufile^.getstring;
checksum:=hp^.ppufile^.getlongint;
loaded_unit:=loadunit(hs,false,false);
if hp^.compiled then
exit;
{ if the crc of a used unit is the same as written to the
PPU file, we needn't to recompile the current unit }
if (loaded_unit^.crc<>checksum) then
begin
{ we have to compile the current unit remove stuff which isn't
needed }
{ forget the map }
dispose(hp^.map);
hp^.map:=nil;
{ remove the ppufile }
dispose(hp^.ppufile,done);
hp^.ppufile:=nil;
{ recompile or give an fatal error }
if not(hp^.sources_avail) then
Message1(unit_f_cant_compile_unit,hp^.unitname^)
else
compile(hp^.mainsource^,compile_system);
exit;
end;
{ setup the map entry for deref }
hp^.map^[nextmapentry]:=loaded_unit^.symtable;
inc(nextmapentry);
if nextmapentry>maxunits then
Message(unit_f_too_much_units);
end;
{ ok, now load the unit }
hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
{ if this is the system unit insert the intern symbols }
if compile_system then
insertinternsyms(psymtable(hp^.symtable));
end;
{ now only read the implementation part }
hp^.in_implementation:=true;
{ load the used units from implementation }
b:=hp^.ppufile^.readentry;
if b=ibloadunit_imp then
begin
while not hp^.ppufile^.endofentry do
begin
hs:=hp^.ppufile^.getstring;
checksum:=hp^.ppufile^.getlongint;
loaded_unit:=loadunit(hs,false,false);
if hp^.compiled then
exit;
end;
end;
hp^.ppufile^.close;
{! dispose(hp^.ppufile,done);}
{$else}
{ load the used units from interface }
hp^.ppufile^.read_data(b,1,count);
while (b=ibloadunit) do
@ -318,7 +394,6 @@ unit pmodules;
{ read until ibend }
hp^.ppufile^.read_data(b,1,count);
end;
{ ok, now load the unit }
hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
@ -367,6 +442,7 @@ unit pmodules;
hp^.ppufile^.read_data(b,1,count);
end;
hp^.ppufile^.close;
{$endif}
dispose(hp^.map);
hp^.map:=nil;
end;
@ -439,7 +515,11 @@ unit pmodules;
OnlyAsm(hp^.asmfilename^);
{ we should know there the PPU file else it's an error and
we can't load the unit }
{$ifdef NEWPPU}
{ if hp^.ppufile^.name^<>'' then}
{$else}
if hp^.ppufile^.name^<>'' then
{$endif}
load_ppu(hp,compile_system);
{ add the files for the linker }
addlinkerfiles(hp);
@ -1010,7 +1090,13 @@ unit pmodules;
end.
{
$Log$
Revision 1.11 1998-05-06 18:36:53 peter
Revision 1.12 1998-05-11 13:07:56 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.11 1998/05/06 18:36:53 peter
* tai_section extended with code,data,bss sections and enumerated type
* ident 'compiled by FPC' moved to pmodules
* small fix for smartlink

10
compiler/pp.pas
View File

@ -51,7 +51,7 @@
{$ifdef FPC}
{$ifndef GDB}
{ people can try to compile without GDB }
{$error The compiler switch GDB must be defined}
{ $error The compiler switch GDB must be defined}
{$endif GDB}
{ but I386 or M68K must be defined }
{ and only one of the two }
@ -379,7 +379,13 @@ begin
end.
{
$Log$
Revision 1.8 1998-05-08 09:21:57 michael
Revision 1.9 1998-05-11 13:07:56 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.8 1998/05/08 09:21:57 michael
+ Librarysearchpath is now a linker object field;
Revision 1.7 1998/05/04 17:54:28 peter

137
compiler/pstatmnt.pas
View File

@ -41,6 +41,9 @@ unit pstatmnt;
uses
cobjects,scanner,globals,symtable,aasm,pass_1,
types,hcodegen,files,verbose
{$ifdef NEWPPU}
,ppu
{$endif}
{ processor specific stuff }
{$ifdef i386}
,i386
@ -128,7 +131,7 @@ unit pstatmnt;
var
{ contains the label number of currently parsed case block }
aktcaselabel : plabel;
wurzel : pcaserecord;
root : pcaserecord;
{ the typ of the case expression }
casedef : pdef;
@ -160,7 +163,7 @@ unit pstatmnt;
getlabel(hcaselabel^._at);
hcaselabel^._low:=l;
hcaselabel^._high:=h;
insertlabel(wurzel);
insertlabel(root);
end;
var
@ -181,7 +184,7 @@ unit pstatmnt;
consume(_OF);
inc(statement_level);
wurzel:=nil;
root:=nil;
ranges:=false;
instruc:=nil;
repeat
@ -248,7 +251,7 @@ unit pstatmnt;
end;
dec(statement_level);
code:=gencasenode(caseexpr,instruc,wurzel);
code:=gencasenode(caseexpr,instruc,root);
code^.elseblock:=elseblock;
@ -353,7 +356,7 @@ unit pstatmnt;
begin
symtab:=obj^.publicsyms;
withsymtable:=new(psymtable,init(symtable.withsymtable));
withsymtable^.wurzel:=symtab^.wurzel;
withsymtable^.root:=symtab^.root;
withsymtable^.next:=symtablestack;
symtablestack:=withsymtable;
obj:=obj^.childof;
@ -364,7 +367,7 @@ unit pstatmnt;
symtab:=precdef(p^.resulttype)^.symtable;
levelcount:=1;
withsymtable:=new(psymtable,init(symtable.withsymtable));
withsymtable^.wurzel:=symtab^.wurzel;
withsymtable^.root:=symtab^.root;
withsymtable^.next:=symtablestack;
symtablestack:=withsymtable;
end;
@ -1049,8 +1052,7 @@ unit pstatmnt;
end
else
begin
current_module^.flags:=current_module^.flags or
uf_init;
current_module^.flags:=current_module^.flags or uf_init;
block:=statement_block;
end
else
@ -1108,7 +1110,13 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.9 1998-05-06 08:38:46 pierre
Revision 1.10 1998-05-11 13:07:56 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.9 1998/05/06 08:38:46 pierre
* better position info with UseTokenInfo
UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass
@ -1149,115 +1157,4 @@ end.
nasm output OK (program still crashes at end
and creates wrong assembler files !!)
procsym types sym in tdef removed !!
Revision 1.3 1998/03/28 23:09:56 florian
* secondin bugfix (m68k and i386)
* overflow checking bugfix (m68k and i386) -- pretty useless in
secondadd, since everything is done using 32-bit
* loading pointer to routines hopefully fixed (m68k)
* flags problem with calls to RTL internal routines fixed (still strcmp
to fix) (m68k)
* #ELSE was still incorrect (didn't take care of the previous level)
* problem with filenames in the command line solved
* problem with mangledname solved
* linking name problem solved (was case insensitive)
* double id problem and potential crash solved
* stop after first error
* and=>test problem removed
* correct read for all float types
* 2 sigsegv fixes and a cosmetic fix for Internal Error
* push/pop is now correct optimized (=> mov (%esp),reg)
Revision 1.2 1998/03/26 11:18:31 florian
- switch -Sa removed
- support of a:=b:=0 removed
Revision 1.1.1.1 1998/03/25 11:18:15 root
* Restored version
Revision 1.21 1998/03/10 16:27:42 pierre
* better line info in stabs debug
* symtabletype and lexlevel separated into two fields of tsymtable
+ ifdef MAKELIB for direct library output, not complete
+ ifdef CHAINPROCSYMS for overloaded seach across units, not fully
working
+ ifdef TESTFUNCRET for setting func result in underfunction, not
working
Revision 1.20 1998/03/10 04:18:26 carl
* wrong units were being used with m68k target
Revision 1.19 1998/03/10 01:17:25 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.18 1998/03/06 00:52:46 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.17 1998/03/02 01:49:07 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.16 1998/02/22 23:03:30 peter
* renamed msource->mainsource and name->unitname
* optimized filename handling, filename is not seperate anymore with
path+name+ext, this saves stackspace and a lot of fsplit()'s
* recompiling of some units in libraries fixed
* shared libraries are working again
+ $LINKLIB <lib> to support automatic linking to libraries
+ libraries are saved/read from the ppufile, also allows more libraries
per ppufile
Revision 1.15 1998/02/21 03:33:54 carl
+ mit assembler syntax support
Revision 1.14 1998/02/13 10:35:29 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.13 1998/02/12 11:50:30 daniel
Yes! Finally! After three retries, my patch!
Changes:
Complete rewrite of psub.pas.
Added support for DLL's.
Compiler requires less memory.
Platform units for each platform.
Revision 1.12 1998/02/11 21:56:39 florian
* bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
Revision 1.11 1998/02/07 09:39:26 florian
* correct handling of in_main
+ $D,$T,$X,$V like tp
Revision 1.10 1998/01/31 00:42:26 carl
+* Final bugfix #60 (working!) Type checking in case statements
Revision 1.7 1998/01/21 02:18:28 carl
* bugfix 79 (assembler_block now chooses the correct framepointer and
offset).
Revision 1.6 1998/01/16 22:34:43 michael
* Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
in this compiler :)
Revision 1.5 1998/01/12 14:51:18 carl
- temporariliy removed case type checking until i know where the bug
comes from!
Revision 1.4 1998/01/11 19:23:49 carl
* bug fix number 60 (case statements type checking)
Revision 1.3 1998/01/11 10:54:25 florian
+ generic library support
Revision 1.2 1998/01/09 09:10:02 michael
+ Initial implementation, second try
}

19
compiler/scandir.inc
View File

@ -622,23 +622,16 @@ const
procedure dir_linkobject(t:tdirectivetoken);
var
path,hs : string;
found : boolean;
begin
skipspace;
hs:=FixFileName(readstring);
current_module^.linkofiles.insert(hs);
current_module^.linkofiles.insert(FixFileName(readstring));
end;
procedure dir_linklib(t:tdirectivetoken);
var
hs : string;
begin
skipspace;
hs:=readstring;
current_module^.linkSharedLibs.insert(hs);
current_module^.linkSharedLibs.insert(readstring);
end;
@ -821,7 +814,13 @@ const
{
$Log$
Revision 1.7 1998-05-08 09:21:20 michael
Revision 1.8 1998-05-11 13:07:57 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.7 1998/05/08 09:21:20 michael
* Added missing -Fl message to messages file.
* Corrected mangling of file names when doing Linklib
* -Fl now actually WORKS.

14
compiler/systems.pas
View File

@ -291,7 +291,7 @@ unit systems;
linkcmd : '-oformat coff-go32 $OPT -o $EXE @$RES';
stripopt : '-s';
groupstart : '-(';
groupend : ')-';
groupend : '-)';
inputstart : '';
inputend : '';
libprefix : '-l'
@ -301,7 +301,7 @@ unit systems;
linkcmd : '-oformat coff-go32-exe $OPT -o $EXE @$RES';
stripopt : '-s';
groupstart : '-(';
groupend : ')-';
groupend : '-)';
inputstart : '';
inputend : '';
libprefix : '-l'
@ -321,7 +321,7 @@ unit systems;
linkcmd : '-o $EXE @$RES';
stripopt : '-s';
groupstart : '-(';
groupend : ')-';
groupend : '-)';
inputstart : '';
inputend : '';
libprefix : ''
@ -519,7 +519,13 @@ begin
end.
{
$Log$
Revision 1.9 1998-05-06 08:38:49 pierre
Revision 1.10 1998-05-11 13:07:58 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.9 1998/05/06 08:38:49 pierre
* better position info with UseTokenInfo
UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass

71
compiler/tgeni386.pas
View File

@ -93,7 +93,9 @@ unit tgeni386;
var
r : tregister;
{$ifdef SUPPORT_MMX}
hr : preference;
{$endif SUPPORT_MMX}
begin
usedinproc:=usedinproc or b;
@ -146,8 +148,9 @@ unit tgeni386;
var
r : tregister;
{$ifdef SUPPORT_MMX}
hr : preference;
{$endif SUPPORT_MMX}
begin
{ restore in reverse order: }
{$ifdef SUPPORT_MMX}
@ -595,7 +598,13 @@ begin
end.
{
$Log$
Revision 1.4 1998-04-29 10:34:08 pierre
Revision 1.5 1998-05-11 13:07:58 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.4 1998/04/29 10:34:08 pierre
+ added some code for ansistring (not complete nor working yet)
* corrected operator overloading
* corrected nasm output
@ -609,63 +618,5 @@ end.
Revision 1.2 1998/04/09 15:46:39 florian
+ register allocation tracing stuff added
Revision 1.1.1.1 1998/03/25 11:18:15 root
* Restored version
Revision 1.9 2036/02/07 09:26:57 florian
* more fixes to get -Ox work
Revision 1.8 1998/03/10 01:17:30 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.7 1998/03/02 01:49:36 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.6 1998/02/13 10:35:52 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.5 1998/02/12 17:19:32 florian
* fixed to get remake3 work, but needs additional fixes (output, I don't like
also that aktswitches isn't a pointer)
Revision 1.4 1998/02/12 11:50:50 daniel
Yes! Finally! After three retries, my patch!
Changes:
Complete rewrite of psub.pas.
Added support for DLL's.
Compiler requires less memory.
Platform units for each platform.
Revision 1.3 1998/02/04 22:02:46 florian
+ complete handling of MMX registers
Revision 1.2 1998/01/07 00:13:44 michael
Restored released version (plus fixes) as current
Revision 1.1.1.1 1997/11/27 08:33:03 michael
FPC Compiler CVS start
Pre-CVS log:
FK Florian Klaempfl
PM Pierre Muller
+ feature added
- removed
* bug fixed or changed
History (started with version 0.9.0):
7th december 1996:
* some code from Pierre Muller inserted
makes the use of the stack more efficient
20th november 1997:
* tempsize is multiple of 4 for alignment (PM), buggy commented (PM)
}

69
compiler/verb_def.pas
View File

@ -99,7 +99,6 @@ end;
Procedure _comment(Level:Longint;const s:string);
var
hs : string;
i : longint;
begin
if (verbosity and Level)=Level then
begin
@ -131,19 +130,12 @@ begin
if (verbosity and Level)=V_Fatal then
hs:=rh_errorstr;
end;
if (Level<$100) and Assigned(current_module) and
Assigned(current_module^.current_inputfile) then
hs:=current_module^.current_inputfile^.get_file_line+' '+hs;
(* {$ifdef USE_RHIDE}
What was this ??? I did not code that (PM)
if (Level<$100) then
begin
i:=length(hs)+1;
hs:=hs+lowercase(Copy(s,1,5))+Copy(s,6,255);
end
else
{$endif USE_RHIDE} *)
hs:=hs+s;
if (Level<$100) and Assigned(current_module) and Assigned(current_module^.current_inputfile) then
hs:=current_module^.current_inputfile^.get_file_line+' '+hs;
{ add the message to the text }
hs:=hs+s;
{$ifdef FPC}
if UseStdErr and (Level<$100) then
begin
@ -249,7 +241,13 @@ begin
end.
{
$Log$
Revision 1.5 1998-04-30 15:59:43 pierre
Revision 1.6 1998-05-11 13:07:58 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.5 1998/04/30 15:59:43 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
@ -263,45 +261,4 @@ end.
+ started inline procedures
+ added starstarn : use ** for exponentiation (^ gave problems)
+ started UseTokenInfo cond to get accurate positions
Revision 1.2 1998/03/28 23:09:57 florian
* secondin bugfix (m68k and i386)
* overflow checking bugfix (m68k and i386) -- pretty useless in
secondadd, since everything is done using 32-bit
* loading pointer to routines hopefully fixed (m68k)
* flags problem with calls to RTL internal routines fixed (still strcmp
to fix) (m68k)
* #ELSE was still incorrect (didn't take care of the previous level)
* problem with filenames in the command line solved
* problem with mangledname solved
* linking name problem solved (was case insensitive)
* double id problem and potential crash solved
* stop after first error
* and=>test problem removed
* correct read for all float types
* 2 sigsegv fixes and a cosmetic fix for Internal Error
* push/pop is now correct optimized (=> mov (%esp),reg)
Revision 1.1.1.1 1998/03/25 11:18:15 root
* Restored version
Revision 1.6 1998/03/10 16:43:34 peter
* fixed Fatal error writting
Revision 1.5 1998/03/10 01:17:30 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.4 1998/03/06 00:53:02 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.3 1998/03/04 17:34:15 michael
+ Changed ifdef FPK to ifdef FPC
Revision 1.2 1998/03/03 16:45:25 peter
+ message support for assembler parsers
}