paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-30 08:11:42 +01: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, objfile,
srcfile, srcfile,
as_bin : string; as_bin : string;
smartcnt : longint;
{outfile} {outfile}
outcnt : longint; outcnt : longint;
outbuf : array[0..AsmOutSize-1] of char; outbuf : array[0..AsmOutSize-1] of char;
@ -70,6 +69,9 @@ type
Procedure GenerateAsm(const fn:string); Procedure GenerateAsm(const fn:string);
Procedure OnlyAsm(const fn:string); Procedure OnlyAsm(const fn:string);
var
SmartLinkFilesCnt : longint;
Function SmartLinkPath(const s:string):string;
Implementation 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; Function DoPipe:boolean;
begin begin
DoPipe:=use_pipe and (not WriteAsmFile) and (current_module^.output_format=of_o); DoPipe:=use_pipe and (not WriteAsmFile) and (current_module^.output_format=of_o);
end; end;
{*****************************************************************************
TAsmList Calling and Name
*****************************************************************************}
const const
lastas : byte=255; lastas : byte=255;
var var
@ -175,7 +191,7 @@ begin
DoAssemble:=true; DoAssemble:=true;
if DoPipe then if DoPipe then
exit; exit;
if (smartcnt<=1) and (not externasm) then if (SmartLinkFilesCnt<=1) and (not externasm) then
Message1(exec_i_assembling,name); Message1(exec_i_assembling,name);
s:=target_asm.asmcmd; s:=target_asm.asmcmd;
Replace(s,'$ASM',AsmFile); Replace(s,'$ASM',AsmFile);
@ -187,11 +203,11 @@ end;
procedure TAsmList.NextSmartName; procedure TAsmList.NextSmartName;
begin begin
inc(smartcnt); inc(SmartLinkFilesCnt);
if smartcnt>999999 then if SmartLinkFilesCnt>999999 then
Comment(V_Fatal,'Too many assembler files'); Comment(V_Fatal,'Too many assembler files');
AsmFile:=Path+FixFileName('as'+tostr(smartcnt)+target_info.asmext); AsmFile:=Path+FixFileName('as'+tostr(SmartLinkFilesCnt)+target_info.asmext);
ObjFile:=Path+FixFileName('as'+tostr(smartcnt)+target_info.objext); ObjFile:=Path+FixFileName('as'+tostr(SmartLinkFilesCnt)+target_info.objext);
end; end;
@ -336,7 +352,7 @@ begin
objfile:=path+name+target_info.objext; objfile:=path+name+target_info.objext;
OutCnt:=0; OutCnt:=0;
{Smartlinking} {Smartlinking}
smartcnt:=0; SmartLinkFilesCnt:=0;
if smartlink then if smartlink then
begin begin
path:=SmartLinkPath(name); path:=SmartLinkPath(name);
@ -397,10 +413,17 @@ begin
dispose(a,Done); dispose(a,Done);
end; end;
end. end.
{ {
$Log$ $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 * smartlinking for sets
+ consts labels are now concated/generated in hcodegen + consts labels are now concated/generated in hcodegen
* moved some cpu code to cga and some none cpu depended code from cga * 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 } { true, if for sets subtractions the extra not should generated }
extra_not : boolean; extra_not : boolean;
{$ifdef SUPPORT_MMX}
mmxbase : tmmxtype; mmxbase : tmmxtype;
{$endif SUPPORT_MMX}
begin begin
if (p^.left^.resulttype^.deftype=stringdef) then if (p^.left^.resulttype^.deftype=stringdef) then
@ -1271,7 +1273,13 @@
{ {
$Log$ $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 * handling of private and protected fixed
+ change_keywords_to_tp implemented to remove + change_keywords_to_tp implemented to remove
keywords which aren't supported by tp keywords which aren't supported by tp
@ -1295,51 +1303,4 @@
Revision 1.3 1998/04/08 11:34:22 peter Revision 1.3 1998/04/08 11:34:22 peter
* nasm works (linux only tested) * 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 interface
uses uses
cobjects,globals; cobjects,globals
{$ifdef NEWPPU}
,ppu
{$endif}
;
const const
{$ifdef FPC} {$ifdef FPC}
@ -80,10 +84,13 @@ unit files;
pmodule = ^tmodule; pmodule = ^tmodule;
tmodule = object(tlinkedlist_item) tmodule = object(tlinkedlist_item)
{$ifdef NEWPPU}
ppufile : pppufile; { the PPU file }
{$else}
ppufile : pextfile; { the PPU file } ppufile : pextfile; { the PPU file }
ppuversion, { PPU version, handle different versions } {$endif}
crc, { check sum written to the file } crc,
flags : longint; { flags } flags : longint; { the PPU flags }
compiled, { unit is already compiled } compiled, { unit is already compiled }
do_assemble, { only assemble the object, don't recompile } 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 } destructor special_done;virtual; { this is to be called only when compiling again }
procedure setfilename(const path,name:string); 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; function load_ppu(const unit_path,n,ext:string):boolean;
{$endif}
procedure search_unit(const n : string); procedure search_unit(const n : string);
end; end;
@ -135,8 +146,9 @@ unit files;
destructor done;virtual; destructor done;virtual;
end; end;
{$ifndef NEWPPU}
type
tunitheader = array[0..19] of char; tunitheader = array[0..19] of char;
const const
{ compiler version } { compiler version }
{ format | } { format | }
@ -167,7 +179,7 @@ unit files;
ibvarsym = 10; ibvarsym = 10;
ibconstsym = 11; ibconstsym = 11;
ibinitunit = 12; ibinitunit = 12;
ibaufzaehlsym = 13; ibenumsym = 13;
ibtypedconstsym = 14; ibtypedconstsym = 14;
ibrecorddef = 15; ibrecorddef = 15;
ibfiledef = 16; ibfiledef = 16;
@ -201,12 +213,11 @@ unit files;
uf_shared_library = $10; uf_shared_library = $10;
uf_big_endian = $20; uf_big_endian = $20;
uf_smartlink = $40; uf_smartlink = $40;
{$endif}
const
main_module : pmodule = nil;
current_module : pmodule = nil;
var var
main_module : pmodule;
current_module : pmodule;
loaded_units : tlinkedlist; loaded_units : tlinkedlist;
@ -314,6 +325,7 @@ unit files;
ff:=ff^._next; ff:=ff^._next;
get_file:=ff; get_file:=ff;
end; end;
{**************************************************************************** {****************************************************************************
TMODULE TMODULE
****************************************************************************} ****************************************************************************}
@ -333,6 +345,238 @@ unit files;
arfilename:=stringdup(s+target_os.staticlibext); arfilename:=stringdup(s+target_os.staticlibext);
end; 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; function tmodule.load_ppu(const unit_path,n,ext : string):boolean;
var var
header : tunitheader; header : tunitheader;
@ -341,6 +585,7 @@ unit files;
b : byte; b : byte;
incfile_found : boolean; incfile_found : boolean;
code : word; code : word;
ppuversion,
objfiletime, objfiletime,
ppufiletime, ppufiletime,
asmfiletime, asmfiletime,
@ -354,16 +599,15 @@ unit files;
begin begin
load_ppu:=false; 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^); Message1(unit_u_ppu_loading,ppufilename^);
ppufile:=new(pextfile,init(unit_path,n,ext)); ppufile:=new(pextfile,init(unit_path,n,ext));
ppufile^.reset; ppufile^.reset;
ppufile^.flush; ppufile^.flush;
{Get ppufile time}
ppufiletime:=getnamedfiletime(ppufilename^);
Message1(unit_d_ppu_time,filetimestring(ppufiletime));
{ load the header } { load the header }
ppufile^.read_data(header,sizeof(header),count); ppufile^.read_data(header,sizeof(header),count);
if count<>sizeof(header) then if count<>sizeof(header) then
@ -372,7 +616,6 @@ unit files;
Message(unit_d_ppu_file_too_short); Message(unit_d_ppu_file_too_short);
exit; exit;
end; end;
{ check for a valid PPU file } { check for a valid PPU file }
if (header[0]<>'P') or (header[1]<>'P') or (header[2]<>'U') then if (header[0]<>'P') or (header[1]<>'P') or (header[2]<>'U') then
begin begin
@ -380,7 +623,6 @@ unit files;
Message(unit_d_ppu_invalid_header); Message(unit_d_ppu_invalid_header);
exit; exit;
end; end;
{ load ppu version } { load ppu version }
val(header[3]+header[4]+header[5],ppuversion,code); val(header[3]+header[4]+header[5],ppuversion,code);
if not(ppuversion in [13..14]) then if not(ppuversion in [13..14]) then
@ -389,11 +631,13 @@ unit files;
Message1(unit_d_ppu_invalid_version,tostr(ppuversion)); Message1(unit_d_ppu_invalid_version,tostr(ppuversion));
exit; exit;
end; end;
flags:=byte(header[9]); flags:=byte(header[9]);
Message1(unit_d_ppu_flags,tostr(flags));
crc:=plongint(@header[10])^; 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)); Message1(unit_d_ppu_crc,tostr(crc));
{ read name if its there } { read name if its there }
@ -574,6 +818,9 @@ unit files;
until Found or (path=''); until Found or (path='');
end; end;
{$endif NEWPPU}
constructor tmodule.init(const s:string;is_unit:boolean); constructor tmodule.init(const s:string;is_unit:boolean);
var var
@ -660,7 +907,13 @@ unit files;
end. end.
{ {
$Log$ $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 + when trying to find source files of a ppufile
check the includepathlist for included files check the includepathlist for included files
the main file must still be in the same directory 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 DoExec(const command,para:string;info,useshell:boolean):boolean;
Function WriteResponseFile:Boolean; Function WriteResponseFile:Boolean;
Function MakeExecutable:boolean; Function MakeExecutable:boolean;
Procedure MakeStaticLibrary(const path:string); Procedure MakeStaticLibrary(const path:string;filescnt:longint);
Procedure MakeSharedLibrary; Procedure MakeSharedLibrary;
end; end;
PLinker=^TLinker; PLinker=^TLinker;
@ -227,7 +227,7 @@ begin
if useshell then if useshell then
shell(command+' '+para) shell(command+' '+para)
else else
exec(command,para); exec(command,para);
swapvectors; swapvectors;
if (dosexitcode<>0) then if (dosexitcode<>0) then
begin begin
@ -403,13 +403,13 @@ begin
end; end;
Procedure TLinker.MakeStaticLibrary(const path:string); Procedure TLinker.MakeStaticLibrary(const path:string;filescnt:longint);
var var
arbin : string; arbin : string;
arfound : boolean; arfound : boolean;
cnt : longint;
i : word; i : word;
f : file; f : file;
Dir : searchrec;
begin begin
arbin:=FindExe('ar',arfound); arbin:=FindExe('ar',arfound);
if (not arfound) and (not externlink) then if (not arfound) and (not externlink) then
@ -421,15 +421,13 @@ begin
{ Clean up } { Clean up }
if (not writeasmfile) and (not externlink) then if (not writeasmfile) and (not externlink) then
begin begin
findfirst(FixPath(path)+'*'+target_info.objext,$20,Dir); for cnt:=1to filescnt do
while doserror=0 do
begin begin
assign(f,FixPath(path)+dir.name); assign(f,FixPath(path)+'as'+tostr(cnt)+target_info.objext);
{$I-} {$I-}
erase(f); erase(f);
{$I+} {$I+}
i:=ioresult; i:=ioresult;
findnext(dir);
end; end;
{$I-} {$I-}
rmdir(path); rmdir(path);
@ -448,7 +446,13 @@ end;
end. end.
{ {
$Log$ $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. * Added missing -Fl message to messages file.
* Corrected mangling of file names when doing Linklib * Corrected mangling of file names when doing Linklib
* -Fl now actually WORKS. * -Fl now actually WORKS.

101
compiler/m68k.pas
View File

@ -903,10 +903,10 @@ type
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
lab2str:='ILLEGAL' lab2str:='ILLEGAL'
else else
lab2str:=target_info.labelprefix+tostr(l^.nb); lab2str:=target_asm.labelprefix+tostr(l^.nb);
{$else EXTDEBUG} {$else EXTDEBUG}
internalerror(2000); internalerror(2000);
lab2str:=target_info.labelprefix+tostr(l^.nb); lab2str:=target_asm.labelprefix+tostr(l^.nb);
{$endif EXTDEBUG} {$endif EXTDEBUG}
l^.is_used:=true; l^.is_used:=true;
@ -1642,100 +1642,17 @@ type
end. end.
{ {
$Log$ $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) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output
+ started inline procedures + started inline procedures
+ added starstarn : use ** for exponentiation (^ gave problems) + added starstarn : use ** for exponentiation (^ gave problems)
+ started UseTokenInfo cond to get accurate positions + 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 if smartlink then
begin begin
Linker.SetLibName(FileName); Linker.SetLibName(FileName);
Linker.MakeStaticLibrary(SmartLinkPath(FileName)); Linker.MakeStaticLibrary(SmartLinkPath(FileName),SmartLinkFilesCnt);
end; end;
{ add the files for the linker from current_module, this must be { add the files for the linker from current_module, this must be
@ -536,7 +536,13 @@ done:
end. end.
{ {
$Log$ $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 * tai_section extended with code,data,bss sections and enumerated type
* ident 'compiled by FPC' moved to pmodules * ident 'compiled by FPC' moved to pmodules
* small fix for smartlink * small fix for smartlink

267
compiler/pass_1.pas
View File

@ -1438,14 +1438,10 @@ unit pass_1;
procedure firststringconst(var p : ptree); procedure firststringconst(var p : ptree);
begin begin
{$ifdef GDB}
{why this !!! lost of dummy type definitions {why this !!! lost of dummy type definitions
one per const string !!! one per const string !!!
p^.resulttype:=new(pstringdef,init(length(p^.values^)));} p^.resulttype:=new(pstringdef,init(length(p^.values^)));}
p^.resulttype:=cstringdef; p^.resulttype:=cstringdef;
{$Else GDB}
p^.resulttype:=new(pstringdef,init(length(p^.values^)));
{$endif * GDB *}
p^.location.loc:=LOC_MEM; p^.location.loc:=LOC_MEM;
end; end;
@ -1626,10 +1622,6 @@ unit pass_1;
procedure firstdoubleaddr(var p : ptree); procedure firstdoubleaddr(var p : ptree);
var
hp : ptree;
hp2 : pdefcoll;
begin begin
make_not_regable(p^.left); make_not_regable(p^.left);
firstpass(p^.left); firstpass(p^.left);
@ -1949,7 +1941,7 @@ unit pass_1;
parraydef(harr)^.definition:=ppointerdef(p^.left^.resulttype)^.definition; parraydef(harr)^.definition:=ppointerdef(p^.left^.resulttype)^.definition;
p^.left:=gentypeconvnode(p^.left,harr); p^.left:=gentypeconvnode(p^.left,harr);
firstpass(p^.left); firstpass(p^.left);
if codegenerror then if codegenerror then
exit; exit;
p^.resulttype:=parraydef(harr)^.definition p^.resulttype:=parraydef(harr)^.definition
@ -2198,10 +2190,6 @@ unit pass_1;
procedure first_proc_to_procvar(var p : ptree); procedure first_proc_to_procvar(var p : ptree);
var
hp : ptree;
hp2 : pdefcoll;
begin begin
firstpass(p^.left); firstpass(p^.left);
if codegenerror then if codegenerror then
@ -2261,7 +2249,6 @@ unit pass_1;
var var
hp : ptree; hp : ptree;
hp2,hp3:Pdefcoll;
aprocdef : pprocdef; aprocdef : pprocdef;
proctype : tdeftype; proctype : tdeftype;
@ -2668,7 +2655,6 @@ unit pass_1;
var var
hp,procs,hp2 : pprocdefcoll; hp,procs,hp2 : pprocdefcoll;
pd : pprocdef; pd : pprocdef;
st : psymtable;
actprocsym : pprocsym; actprocsym : pprocsym;
def_from,def_to,conv_to : pdef; def_from,def_to,conv_to : pdef;
pt : ptree; pt : ptree;
@ -3293,23 +3279,19 @@ unit pass_1;
if ret_in_param(p^.retdef) or if ret_in_param(p^.retdef) or
(@procinfo<>pprocinfo(p^.funcretprocinfo)) then (@procinfo<>pprocinfo(p^.funcretprocinfo)) then
p^.registers32:=1; p^.registers32:=1;
{$ifdef GDB}
if must_be_valid and not pprocinfo(p^.funcretprocinfo)^.funcret_is_valid then if must_be_valid and not pprocinfo(p^.funcretprocinfo)^.funcret_is_valid then
note(uninitialized_function_return); note(uninitialized_function_return);
if count_ref then pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true; if count_ref then pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true;
{$endif * GDB *}
{$else TEST_FUNCRET} {$else TEST_FUNCRET}
p^.resulttype:=procinfo.retdef; p^.resulttype:=procinfo.retdef;
p^.location.loc:=LOC_REFERENCE; p^.location.loc:=LOC_REFERENCE;
if ret_in_param(procinfo.retdef) then if ret_in_param(procinfo.retdef) then
p^.registers32:=1; p^.registers32:=1;
{$ifdef GDB}
if must_be_valid and if must_be_valid and
not(procinfo.funcret_is_valid) {and not(procinfo.funcret_is_valid) {and
((procinfo.flags and pi_uses_asm)=0)} then ((procinfo.flags and pi_uses_asm)=0)} then
Message(sym_w_function_result_not_set); Message(sym_w_function_result_not_set);
if count_ref then procinfo.funcret_is_valid:=true; if count_ref then procinfo.funcret_is_valid:=true;
{$endif * GDB *}
{$endif TEST_FUNCRET} {$endif TEST_FUNCRET}
end; end;
@ -3320,7 +3302,6 @@ unit pass_1;
var var
hp,hpp : ptree; hp,hpp : ptree;
isreal,store_valid,file_is_typed : boolean; isreal,store_valid,file_is_typed : boolean;
convtyp : tconverttype;
procedure do_lowhigh(adef : pdef); procedure do_lowhigh(adef : pdef);
@ -4891,7 +4872,13 @@ unit pass_1;
end. end.
{ {
$Log$ $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 * better position info with UseTokenInfo
UseTokenInfo greatly simplified UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass + added check for changed tree after first time firstpass
@ -4966,242 +4953,4 @@ end.
Revision 1.4 1998/04/07 22:45:04 florian Revision 1.4 1998/04/07 22:45:04 florian
* bug0092, bug0115 and bug0121 fixed * bug0092, bug0115 and bug0121 fixed
+ packed object/class/array + 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)) d:=new(pstringdef,init(p^.value))
{$ifndef GDB} {$ifndef GDB}
else d:=new(pstringdef,init(255)); else d:=new(pstringdef,init(255));
{$else * GDB *} {$else GDB}
else d:=globaldef('SYSTEM.STRING'); else d:=globaldef('SYSTEM.STRING');
{$endif * GDB *} {$endif GDB}
{$else UseAnsiString} {$else UseAnsiString}
if p^.value>255 then if p^.value>255 then
d:=new(pstringdef,ansiinit(p^.value)) d:=new(pstringdef,ansiinit(p^.value))
@ -210,9 +210,9 @@ unit pdecl;
d:=new(pstringdef,init(p^.value)) d:=new(pstringdef,init(p^.value))
{$ifndef GDB} {$ifndef GDB}
else d:=new(pstringdef,init(255)); else d:=new(pstringdef,init(255));
{$else * GDB *} {$else GDB}
else d:=globaldef('SYSTEM.STRING'); else d:=globaldef('SYSTEM.STRING');
{$endif * GDB *} {$endif GDB}
consume(RECKKLAMMER); consume(RECKKLAMMER);
{$endif UseAnsiString} {$endif UseAnsiString}
disposetree(p); disposetree(p);
@ -221,9 +221,9 @@ unit pdecl;
in ansistring mode ?? (PM) } in ansistring mode ?? (PM) }
{$ifndef GDB} {$ifndef GDB}
else d:=new(pstringdef,init(255)); else d:=new(pstringdef,init(255));
{$else * GDB *} {$else GDB}
else d:=globaldef('SYSTEM.STRING'); else d:=globaldef('SYSTEM.STRING');
{$endif * GDB *} {$endif GDB}
stringtype:=d; stringtype:=d;
end; end;
@ -339,11 +339,11 @@ unit pdecl;
{GDB doesn't like unnamed types !} {GDB doesn't like unnamed types !}
aktprocsym^.definition^.retdef:= aktprocsym^.definition^.retdef:=
globaldef('boolean'); globaldef('boolean');
{$Else * GDB *} {$Else GDB}
aktprocsym^.definition^.retdef:= aktprocsym^.definition^.retdef:=
new(porddef,init(bool8bit,0,1)); new(porddef,init(bool8bit,0,1));
{$Endif * GDB *} {$Endif GDB}
end; end;
end; end;
end; end;
@ -1008,7 +1008,7 @@ unit pdecl;
datasegment^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+ 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)))); typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
end; end;
{$endif * GDB *} {$endif GDB}
datasegment^.concat(new(pai_symbol,init_global(aktclass^.vmt_mangledname))); datasegment^.concat(new(pai_symbol,init_global(aktclass^.vmt_mangledname)));
{ determine the size with publicsyms^.datasize, because } { determine the size with publicsyms^.datasize, because }
@ -1370,10 +1370,6 @@ unit pdecl;
forwardsallowed:=true; forwardsallowed:=true;
hp1:=single_type(hs); hp1:=single_type(hs);
p:=new(ppointerdef,init(hp1)); p:=new(ppointerdef,init(hp1));
{$ifndef GDB}
if lasttypesym<>nil then
save_forward(ppointerdef(p),lasttypesym);
{$else * GDB *}
{I add big troubles here {I add big troubles here
with var p : ^byte in graph.putimage with var p : ^byte in graph.putimage
because a save_forward was called and because a save_forward was called and
@ -1387,7 +1383,6 @@ unit pdecl;
if (lasttypesym<>nil) if (lasttypesym<>nil)
and ((lasttypesym^.properties and sp_forwarddef)<>0) then and ((lasttypesym^.properties and sp_forwarddef)<>0) then
lasttypesym^.forwardpointer:=ppointerdef(p); lasttypesym^.forwardpointer:=ppointerdef(p);
{$endif * GDB *}
forwardsallowed:=false; forwardsallowed:=false;
end; end;
_RECORD: _RECORD:
@ -1792,7 +1787,13 @@ unit pdecl;
end. end.
{ {
$Log$ $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 * problems with properties fixed
* crash fixed: i:=l when i and l are undefined, was a problem with * crash fixed: i:=l when i and l are undefined, was a problem with
implementation of private/protected implementation of private/protected
@ -1861,152 +1862,4 @@ end.
* fixed the -Ss bug * fixed the -Ss bug
+ warning for Virtual constructors + warning for Virtual constructors
* helppages updated with -TGO32V1 * 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 var
paras : ptree; paras : ptree;
oldafterassignment : boolean;
p2 : ptree; p2 : ptree;
begin begin
@ -929,8 +928,6 @@ unit pexpr;
var var
possible_error : boolean; possible_error : boolean;
storesymtablestack : psymtable;
actprocsym : pprocsym;
begin begin
{$ifdef UseTokenInfo} {$ifdef UseTokenInfo}
@ -1735,7 +1732,13 @@ unit pexpr;
end. end.
{ {
$Log$ $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 * better position info with UseTokenInfo
UseTokenInfo greatly simplified UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass + added check for changed tree after first time firstpass
@ -1789,129 +1792,4 @@ end.
in MEM parsing for go32v2 in MEM parsing for go32v2
better external symbol creation better external symbol creation
support for rhgdb.exe (lowercase file names) 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} {$ifdef GDB}
,gdb ,gdb
{$endif GDB} {$endif GDB}
{$ifdef NEWPPU}
,ppu
{$endif}
{ parser specific stuff } { parser specific stuff }
,pbase,pdecl,pstatmnt,psub ,pbase,pdecl,pstatmnt,psub
{ processor specific stuff } { processor specific stuff }
@ -270,7 +273,10 @@ unit pmodules;
loaded_unit : pmodule; loaded_unit : pmodule;
b : byte; b : byte;
checksum, checksum,
{$ifndef NEWPPU}
count, count,
{$endif NEWPPU}
nextmapentry : longint; nextmapentry : longint;
hs : string; hs : string;
begin begin
@ -278,6 +284,76 @@ unit pmodules;
new(hp^.map); new(hp^.map);
nextmapentry:=1; 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 } { load the used units from interface }
hp^.ppufile^.read_data(b,1,count); hp^.ppufile^.read_data(b,1,count);
while (b=ibloadunit) do while (b=ibloadunit) do
@ -318,7 +394,6 @@ unit pmodules;
{ read until ibend } { read until ibend }
hp^.ppufile^.read_data(b,1,count); hp^.ppufile^.read_data(b,1,count);
end; end;
{ ok, now load the unit } { ok, now load the unit }
hp^.symtable:=new(punitsymtable,load(hp^.unitname^)); hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
@ -367,6 +442,7 @@ unit pmodules;
hp^.ppufile^.read_data(b,1,count); hp^.ppufile^.read_data(b,1,count);
end; end;
hp^.ppufile^.close; hp^.ppufile^.close;
{$endif}
dispose(hp^.map); dispose(hp^.map);
hp^.map:=nil; hp^.map:=nil;
end; end;
@ -439,7 +515,11 @@ unit pmodules;
OnlyAsm(hp^.asmfilename^); OnlyAsm(hp^.asmfilename^);
{ we should know there the PPU file else it's an error and { we should know there the PPU file else it's an error and
we can't load the unit } we can't load the unit }
{$ifdef NEWPPU}
{ if hp^.ppufile^.name^<>'' then}
{$else}
if hp^.ppufile^.name^<>'' then if hp^.ppufile^.name^<>'' then
{$endif}
load_ppu(hp,compile_system); load_ppu(hp,compile_system);
{ add the files for the linker } { add the files for the linker }
addlinkerfiles(hp); addlinkerfiles(hp);
@ -1010,7 +1090,13 @@ unit pmodules;
end. end.
{ {
$Log$ $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 * tai_section extended with code,data,bss sections and enumerated type
* ident 'compiled by FPC' moved to pmodules * ident 'compiled by FPC' moved to pmodules
* small fix for smartlink * small fix for smartlink

10
compiler/pp.pas
View File

@ -51,7 +51,7 @@
{$ifdef FPC} {$ifdef FPC}
{$ifndef GDB} {$ifndef GDB}
{ people can try to compile without 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} {$endif GDB}
{ but I386 or M68K must be defined } { but I386 or M68K must be defined }
{ and only one of the two } { and only one of the two }
@ -379,7 +379,13 @@ begin
end. end.
{ {
$Log$ $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; + Librarysearchpath is now a linker object field;
Revision 1.7 1998/05/04 17:54:28 peter Revision 1.7 1998/05/04 17:54:28 peter

137
compiler/pstatmnt.pas
View File

@ -41,6 +41,9 @@ unit pstatmnt;
uses uses
cobjects,scanner,globals,symtable,aasm,pass_1, cobjects,scanner,globals,symtable,aasm,pass_1,
types,hcodegen,files,verbose types,hcodegen,files,verbose
{$ifdef NEWPPU}
,ppu
{$endif}
{ processor specific stuff } { processor specific stuff }
{$ifdef i386} {$ifdef i386}
,i386 ,i386
@ -128,7 +131,7 @@ unit pstatmnt;
var var
{ contains the label number of currently parsed case block } { contains the label number of currently parsed case block }
aktcaselabel : plabel; aktcaselabel : plabel;
wurzel : pcaserecord; root : pcaserecord;
{ the typ of the case expression } { the typ of the case expression }
casedef : pdef; casedef : pdef;
@ -160,7 +163,7 @@ unit pstatmnt;
getlabel(hcaselabel^._at); getlabel(hcaselabel^._at);
hcaselabel^._low:=l; hcaselabel^._low:=l;
hcaselabel^._high:=h; hcaselabel^._high:=h;
insertlabel(wurzel); insertlabel(root);
end; end;
var var
@ -181,7 +184,7 @@ unit pstatmnt;
consume(_OF); consume(_OF);
inc(statement_level); inc(statement_level);
wurzel:=nil; root:=nil;
ranges:=false; ranges:=false;
instruc:=nil; instruc:=nil;
repeat repeat
@ -248,7 +251,7 @@ unit pstatmnt;
end; end;
dec(statement_level); dec(statement_level);
code:=gencasenode(caseexpr,instruc,wurzel); code:=gencasenode(caseexpr,instruc,root);
code^.elseblock:=elseblock; code^.elseblock:=elseblock;
@ -353,7 +356,7 @@ unit pstatmnt;
begin begin
symtab:=obj^.publicsyms; symtab:=obj^.publicsyms;
withsymtable:=new(psymtable,init(symtable.withsymtable)); withsymtable:=new(psymtable,init(symtable.withsymtable));
withsymtable^.wurzel:=symtab^.wurzel; withsymtable^.root:=symtab^.root;
withsymtable^.next:=symtablestack; withsymtable^.next:=symtablestack;
symtablestack:=withsymtable; symtablestack:=withsymtable;
obj:=obj^.childof; obj:=obj^.childof;
@ -364,7 +367,7 @@ unit pstatmnt;
symtab:=precdef(p^.resulttype)^.symtable; symtab:=precdef(p^.resulttype)^.symtable;
levelcount:=1; levelcount:=1;
withsymtable:=new(psymtable,init(symtable.withsymtable)); withsymtable:=new(psymtable,init(symtable.withsymtable));
withsymtable^.wurzel:=symtab^.wurzel; withsymtable^.root:=symtab^.root;
withsymtable^.next:=symtablestack; withsymtable^.next:=symtablestack;
symtablestack:=withsymtable; symtablestack:=withsymtable;
end; end;
@ -1049,8 +1052,7 @@ unit pstatmnt;
end end
else else
begin begin
current_module^.flags:=current_module^.flags or current_module^.flags:=current_module^.flags or uf_init;
uf_init;
block:=statement_block; block:=statement_block;
end end
else else
@ -1108,7 +1110,13 @@ unit pstatmnt;
end. end.
{ {
$Log$ $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 * better position info with UseTokenInfo
UseTokenInfo greatly simplified UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass + added check for changed tree after first time firstpass
@ -1149,115 +1157,4 @@ end.
nasm output OK (program still crashes at end nasm output OK (program still crashes at end
and creates wrong assembler files !!) and creates wrong assembler files !!)
procsym types sym in tdef removed !! 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); procedure dir_linkobject(t:tdirectivetoken);
var
path,hs : string;
found : boolean;
begin begin
skipspace; skipspace;
hs:=FixFileName(readstring); current_module^.linkofiles.insert(FixFileName(readstring));
current_module^.linkofiles.insert(hs);
end; end;
procedure dir_linklib(t:tdirectivetoken); procedure dir_linklib(t:tdirectivetoken);
var
hs : string;
begin begin
skipspace; skipspace;
hs:=readstring; current_module^.linkSharedLibs.insert(readstring);
current_module^.linkSharedLibs.insert(hs);
end; end;
@ -821,7 +814,13 @@ const
{ {
$Log$ $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. * Added missing -Fl message to messages file.
* Corrected mangling of file names when doing Linklib * Corrected mangling of file names when doing Linklib
* -Fl now actually WORKS. * -Fl now actually WORKS.

14
compiler/systems.pas
View File

@ -291,7 +291,7 @@ unit systems;
linkcmd : '-oformat coff-go32 $OPT -o $EXE @$RES'; linkcmd : '-oformat coff-go32 $OPT -o $EXE @$RES';
stripopt : '-s'; stripopt : '-s';
groupstart : '-('; groupstart : '-(';
groupend : ')-'; groupend : '-)';
inputstart : ''; inputstart : '';
inputend : ''; inputend : '';
libprefix : '-l' libprefix : '-l'
@ -301,7 +301,7 @@ unit systems;
linkcmd : '-oformat coff-go32-exe $OPT -o $EXE @$RES'; linkcmd : '-oformat coff-go32-exe $OPT -o $EXE @$RES';
stripopt : '-s'; stripopt : '-s';
groupstart : '-('; groupstart : '-(';
groupend : ')-'; groupend : '-)';
inputstart : ''; inputstart : '';
inputend : ''; inputend : '';
libprefix : '-l' libprefix : '-l'
@ -321,7 +321,7 @@ unit systems;
linkcmd : '-o $EXE @$RES'; linkcmd : '-o $EXE @$RES';
stripopt : '-s'; stripopt : '-s';
groupstart : '-('; groupstart : '-(';
groupend : ')-'; groupend : '-)';
inputstart : ''; inputstart : '';
inputend : ''; inputend : '';
libprefix : '' libprefix : ''
@ -519,7 +519,13 @@ begin
end. end.
{ {
$Log$ $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 * better position info with UseTokenInfo
UseTokenInfo greatly simplified UseTokenInfo greatly simplified
+ added check for changed tree after first time firstpass + added check for changed tree after first time firstpass

71
compiler/tgeni386.pas
View File

@ -93,7 +93,9 @@ unit tgeni386;
var var
r : tregister; r : tregister;
{$ifdef SUPPORT_MMX}
hr : preference; hr : preference;
{$endif SUPPORT_MMX}
begin begin
usedinproc:=usedinproc or b; usedinproc:=usedinproc or b;
@ -146,8 +148,9 @@ unit tgeni386;
var var
r : tregister; r : tregister;
{$ifdef SUPPORT_MMX}
hr : preference; hr : preference;
{$endif SUPPORT_MMX}
begin begin
{ restore in reverse order: } { restore in reverse order: }
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
@ -595,7 +598,13 @@ begin
end. end.
{ {
$Log$ $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) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output
@ -609,63 +618,5 @@ end.
Revision 1.2 1998/04/09 15:46:39 florian Revision 1.2 1998/04/09 15:46:39 florian
+ register allocation tracing stuff added + 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); Procedure _comment(Level:Longint;const s:string);
var var
hs : string; hs : string;
i : longint;
begin begin
if (verbosity and Level)=Level then if (verbosity and Level)=Level then
begin begin
@ -131,19 +130,12 @@ begin
if (verbosity and Level)=V_Fatal then if (verbosity and Level)=V_Fatal then
hs:=rh_errorstr; hs:=rh_errorstr;
end; end;
if (Level<$100) and Assigned(current_module) and if (Level<$100) and Assigned(current_module) and Assigned(current_module^.current_inputfile) then
Assigned(current_module^.current_inputfile) then hs:=current_module^.current_inputfile^.get_file_line+' '+hs;
hs:=current_module^.current_inputfile^.get_file_line+' '+hs; { add the message to the text }
(* {$ifdef USE_RHIDE}
What was this ??? I did not code that (PM) hs:=hs+s;
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;
{$ifdef FPC} {$ifdef FPC}
if UseStdErr and (Level<$100) then if UseStdErr and (Level<$100) then
begin begin
@ -249,7 +241,13 @@ begin
end. end.
{ {
$Log$ $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 : * GDB works again better :
correct type info in one pass correct type info in one pass
+ UseTokenInfo for better source position + UseTokenInfo for better source position
@ -263,45 +261,4 @@ end.
+ started inline procedures + started inline procedures
+ added starstarn : use ** for exponentiation (^ gave problems) + added starstarn : use ** for exponentiation (^ gave problems)
+ started UseTokenInfo cond to get accurate positions + 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
} }