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

+ new scanner

Browse Source 
* $makelib -> if smartlink
  * small filename fixes pmodule.setfilename
  * moved import from files.pas -> import.pas
This commit is contained in:
peter 1998-04-27 23:10:27 +00:00
parent 7a9c205693
commit 6fd535b87d
10 changed files with 1518 additions and 2756 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
compiler/aasm.pas
View File

@ -48,26 +48,21 @@ unit aasm;
ait_comp,
ait_external,
ait_align,
{ the following is only used by the win32 version of the compiler }
{ and only the GNU AS Win32 is able to write it }
ait_section,
ait_const_rva,
{ the following must is system depended }
{$ifdef GDB}
ait_stabn,
ait_stabs,
ait_stab_function_name,
{$endif GDB}
{$ifdef MAKELIB}
{ used to split unit into tiny assembler files }
ait_cut,
{$endif MAKELIB}
{ never used, makes insertation of new ait_ easier to type }
ait_cut, { used to split into tiny assembler files }
{$ifdef REGALLOC}
ait_regalloc,
ait_regdealloc,
{$endif REGALLOC}
{ never used, makes insertation of new ait_ easier to type }
ait_dummy);
type
@ -215,13 +210,11 @@ unit aasm;
value : bestreal;
constructor init(_value : bestreal);
end;
{$ifdef MAKELIB}
pai_cut = ^tai_cut;
pai_cut = ^tai_cut;
tai_cut = object(tai)
constructor init;
end;
{$endif MAKELIB}
{ for each processor define the best precision }
{ bestreal is defined in globals }
@ -661,23 +654,26 @@ type
inherited done;
end;
{$ifdef MAKELIB}
{****************************************************************************
TAI_CUT
****************************************************************************}
constructor tai_cut.init;
begin
inherited init;
typ:=ait_cut;
end;
{$endif MAKELIB}
end.
{
$Log$
Revision 1.2 1998-04-09 15:46:37 florian
Revision 1.3 1998-04-27 23:10:27 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.2 1998/04/09 15:46:37 florian
+ register allocation tracing stuff added
Revision 1.1.1.1 1998/03/25 11:18:16 root

442
compiler/assemble.pas
View File

@ -33,7 +33,7 @@ const
{$else}
AsmOutSize=10000;
{$endif}
SmartExt='.sl';
{$ifdef i386}
{ tof = (of_none,of_o,of_obj,of_masm,of_att,of_nasm,of_win32) }
@ -48,38 +48,39 @@ const
type
PAsmList=^TAsmList;
TAsmList=object
outcnt : longint;
outbuf : array[0..AsmOutSize-1] of char;
outfile : file;
constructor Init;
destructor Done;
{filenames}
path : dirstr;
name : namestr;
asmfile,
objfile,
srcfile,
as_bin : string;
smartcnt : longint;
{outfile}
outcnt : longint;
outbuf : array[0..AsmOutSize-1] of char;
outfile : file;
Constructor Init(const fn:string);
Destructor Done;
Function FindAssembler(curr_of:tof):string;
Function CallAssembler(const command,para:string):Boolean;
Function DoAssemble:boolean;
Procedure RemoveAsm;
procedure NextSmartName;
Procedure AsmFlush;
Procedure AsmWrite(const s:string);
Procedure AsmWritePChar(p:pchar);
Procedure AsmWriteLn(const s:string);
Procedure AsmLn;
procedure OpenAsmList(const fn,fn2:string);
procedure CloseAsmList;
procedure AsmCreate;
procedure AsmClose;
procedure WriteTree(p:paasmoutput);virtual;
procedure WriteAsmList;virtual;
end;
PAsmFile=^TAsmFile;
TAsmFile=object
asmlist : pasmlist;
path:dirstr;
asmfile,
objfile,
srcfile,
as_bin : string;
Constructor Init(const fn:string);
Destructor Done;
Function FindAssembler(curr_of:tof):string;
Procedure WriteAsmSource;
Function CallAssembler(const command,para:string):Boolean;
Procedure RemoveAsm;
Function DoAssemble:boolean;
end;
Procedure GenerateAsm(const fn:string);
Procedure OnlyAsm(const fn:string);
Implementation
@ -100,12 +101,149 @@ uses
Function DoPipe:boolean;
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;
{*****************************************************************************
TASMLIST
TAsmList Calling and Name
*****************************************************************************}
const
last_of : tof=of_none;
var
LastASBin : string;
Function TAsmList.FindAssembler(curr_of:tof):string;
var
asfound : boolean;
begin
if last_of<>curr_of then
begin
last_of:=curr_of;
LastASBin:=FindExe(asbin[curr_of],asfound);
if (not asfound) and (not externasm) then
begin
Message1(exec_w_assembler_not_found,LastASBin);
externasm:=true;
end;
if asfound then
Message1(exec_u_using_assembler,LastASBin);
end;
FindAssembler:=LastASBin;
end;
Function TAsmList.CallAssembler(const command,para:string):Boolean;
begin
if not externasm then
begin
swapvectors;
exec(command,para);
swapvectors;
if (dosexitcode<>0) then
begin
Message(exec_w_error_while_assembling);
callassembler:=false;
exit;
end
else
if (doserror<>0) then
begin
Message(exec_w_cant_call_assembler);
externasm:=true;
end;
end;
if externasm then
AsmRes.AddAsmCommand(command,para,asmfile);
callassembler:=true;
end;
procedure TAsmList.RemoveAsm;
var
g : file;
i : word;
begin
if writeasmfile then
exit;
if ExternAsm then
AsmRes.AddDeleteCommand(asmfile)
else
begin
assign(g,asmfile);
{$I-}
erase(g);
{$I+}
i:=ioresult;
end;
end;
Function TAsmList.DoAssemble:boolean;
begin
if DoPipe then
exit;
if not externasm then
Message1(exec_i_assembling,asmfile);
case current_module^.output_format of
{$ifdef i386}
of_att : begin
externasm:=true; {Force Extern Asm}
if CallAssembler(FindAssembler(of_att),' -D -o '+objfile+' '+AsmFile) then
RemoveAsm;
end;
of_o : begin
if CallAssembler(FindAssembler(of_o),'-D -o '+objfile+' '+AsmFile) then
RemoveAsm;
end;
of_win32 : begin
if CallAssembler(FindAssembler(of_win32),'-D -o '+objfile+' '+AsmFile) then
RemoveAsm;
end;
of_nasm : begin
{$ifdef linux}
if CallAssembler(FindAssembler(of_nasm),' -f elf -o '+objfile+' '+AsmFile) then
RemoveAsm;
{$else}
if CallAssembler(FindAssembler(of_nasm),' -f coff -o '+objfile+' '+AsmFile) then
RemoveAsm;
{$endif}
end;
of_obj : begin
if CallAssembler(FindAssembler(of_nasm),' -f obj -o '+objfile+' '+AsmFile) then
RemoveAsm;
end;
of_masm : begin
{ !! Nothing yet !! }
end;
{$endif}
{$ifdef m68k}
of_o,
of_mot,
of_mit,
of_gas : begin
{ !! Nothing yet !! }
end;
{$endif}
else
internalerror(30000);
end;
DoAssemble:=true;
end;
procedure TAsmList.NextSmartName;
begin
inc(smartcnt);
if smartcnt>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);
end;
{*****************************************************************************
TAsmList AsmFile Writing
*****************************************************************************}
Procedure TAsmList.AsmFlush;
@ -153,45 +291,45 @@ begin
end;
Procedure TAsmList.AsmLn;
begin
if OutCnt>=AsmOutSize-2 then
AsmFlush;
OutBuf[OutCnt]:=target_info.newline[1];
inc(OutCnt);
inc(OutCnt);
if length(target_info.newline)>1 then
begin
OutBuf[OutCnt]:=target_info.newline[2];
inc(OutCnt);
inc(OutCnt);
end;
end;
procedure TAsmList.OpenAsmList(const fn,fn2:string);
procedure TAsmList.AsmCreate;
begin
if SmartLink then
NextSmartName;
{$ifdef linux}
if DoPipe then
begin
Message1(exec_i_assembling_pipe,fn);
POpen(outfile,'as -o '+fn2,'W');
Message1(exec_i_assembling_pipe,asmfile);
POpen(outfile,'as -o '+objfile,'W');
end
else
{$endif}
begin
Assign(outfile,fn);
Assign(outfile,asmfile);
{$I-}
Rewrite(outfile,1);
{$I+}
if ioresult<>0 then
Message1(exec_d_cant_create_asmfile,fn);
Message1(exec_d_cant_create_asmfile,asmfile);
end;
outcnt:=0;
end;
procedure TAsmList.CloseAsmList;
procedure TAsmList.AsmClose;
var
f : file;
l : longint;
@ -207,7 +345,9 @@ begin
if Assigned(current_module^.ppufilename) then
begin
Assign(f,current_module^.ppufilename^);
reset(f,1);
{$I-}
reset(f,1);
{$I+}
if ioresult=0 then
begin
getftime(f,l);
@ -231,194 +371,106 @@ begin
end;
constructor TAsmList.Init;
begin
OutCnt:=0;
end;
destructor TAsmList.Done;
begin
end;
{*****************************************************************************
TASMFILE
*****************************************************************************}
Constructor TAsmFile.Init(const fn:string);
Constructor TAsmList.Init(const fn:string);
var
name:namestr;
ext:extstr;
ext : extstr;
i : word;
begin
{Create filenames for easier access}
fsplit(fn,path,name,ext);
srcfile:=fn;
asmfile:=path+name+target_info.asmext;
objfile:=path+name+target_info.objext;
{Init output format}
case current_module^.output_format of
{$ifdef i386}
of_o,
of_win32,
of_att:
asmlist:=new(pi386attasmlist,Init);
of_obj,
of_masm,
of_nasm:
asmlist:=new(pi386intasmlist,Init);
{$endif}
{$ifdef m68k}
of_o,
of_gas : asmlist:=new(pm68kgasasmlist,Init);
of_mot : asmlist:=new(pm68kmotasmlist,Init);
of_mit : asmlist:=new(pm68kmitasmlist,Init);
{$endif}
else
internalerror(30000);
end;
end;
Destructor TAsmFile.Done;
begin
end;
Procedure TAsmFile.WriteAsmSource;
begin
asmlist^.OpenAsmList(asmfile,objfile);
asmlist^.WriteAsmList;
asmlist^.CloseAsmList;
end;
const
last_of : tof=of_none;
var
LastASBin : string;
Function TAsmFile.FindAssembler(curr_of:tof):string;
var
asfound : boolean;
begin
if last_of<>curr_of then
OutCnt:=0;
{Smartlinking}
smartcnt:=0;
if smartlink then
begin
last_of:=curr_of;
LastASBin:=FindExe(asbin[curr_of],asfound);
if (not asfound) and (not externasm) then
begin
Message1(exec_w_assembler_not_found,LastASBin);
externasm:=true;
end;
if asfound then
Message1(exec_u_using_assembler,LastASBin);
end;
FindAssembler:=LastASBin;
end;
Function TAsmFile.CallAssembler(const command,para:string):Boolean;
begin
if not externasm then
begin
swapvectors;
exec(command,para);
swapvectors;
if (dosexitcode<>0) then
begin
Message(exec_w_error_while_assembling);
callassembler:=false;
exit;
end
else
if (doserror<>0) then
begin
Message(exec_w_cant_call_assembler);
externasm:=true;
end;
end;
if externasm then
AsmRes.AddAsmCommand(command,para,asmfile);
callassembler:=true;
end;
procedure TAsmFile.RemoveAsm;
var
g : file;
i : word;
begin
if writeasmfile then
exit;
if ExternAsm then
AsmRes.AddDeleteCommand (AsmFile)
else
begin
assign(g,asmfile);
path:=FixPath(path)+FixFileName(name+smartext);
{$I-}
erase(g);
mkdir(path);
{$I+}
i:=ioresult;
end;
path:=FixPath(path);
end;
Function TAsmFile.DoAssemble:boolean;
Destructor TAsmList.Done;
begin
end;
{*****************************************************************************
Generate Assembler Files Main Procedure
*****************************************************************************}
Procedure GenerateAsm(const fn:string);
var
a : PAsmList;
begin
if DoPipe then
exit;
if not externasm then
Message1(exec_i_assembling,asmfile);
case current_module^.output_format of
{$ifdef i386}
of_att : begin
externasm:=true; {Force Extern Asm}
if CallAssembler(FindAssembler(of_att),' -D -o '+objfile+' '+asmfile) then
RemoveAsm;
end;
of_o : begin
if CallAssembler(FindAssembler(of_o),'-D -o '+objfile+' '+asmfile) then
RemoveAsm;
end;
of_win32 : begin
if CallAssembler(FindAssembler(of_win32),'-D -o '+objfile+' '+asmfile) then
RemoveAsm;
end;
of_nasm : begin
{$ifdef linux}
if CallAssembler(FindAssembler(of_nasm),' -f elf -o '+objfile+' '+asmfile) then
RemoveAsm;
{$else}
if CallAssembler(FindAssembler(of_nasm),' -f coff -o '+objfile+' '+asmfile) then
RemoveAsm;
{$endif}
end;
of_obj : begin
if CallAssembler(FindAssembler(of_nasm),' -f obj -o '+objfile+' '+asmfile) then
RemoveAsm;
end;
of_masm : begin
{ !! Nothing yet !! }
end;
of_o,
of_win32,
of_att : a:=new(pi386attasmlist,Init(fn));
of_obj,
of_masm,
of_nasm : a:=new(pi386intasmlist,Init(fn));
{$endif}
{$ifdef m68k}
of_o,
of_mot,
of_mit,
of_gas : begin
{ !! Nothing yet !! }
end;
of_gas : a:=new(pm68kgasasmlist,Init(fn));
of_mot : a:=new(pm68kmotasmlist,Init(fn));
of_mit : a:=new(pm68kmitasmlist,Init(fn));
{$endif}
else
internalerror(30000);
end;
DoAssemble:=true;
a^.AsmCreate;
a^.WriteAsmList;
a^.AsmClose;
a^.DoAssemble;
dispose(a,Done);
end;
Procedure OnlyAsm(const fn:string);
var
a : PAsmList;
begin
case current_module^.output_format of
{$ifdef i386}
of_o,
of_win32,
of_att : a:=new(pi386attasmlist,Init(fn));
of_obj,
of_masm,
of_nasm : a:=new(pi386intasmlist,Init(fn));
{$endif}
{$ifdef m68k}
of_o,
of_gas : a:=new(pm68kgasasmlist,Init(fn));
of_mot : a:=new(pm68kmotasmlist,Init(fn));
of_mit : a:=new(pm68kmitasmlist,Init(fn));
{$endif}
else
internalerror(30000);
end;
a^.DoAssemble;
dispose(a,Done);
end;
end.
{
$Log$
Revision 1.3 1998-04-10 14:41:43 peter
Revision 1.4 1998-04-27 23:10:27 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.3 1998/04/10 14:41:43 peter
* removed some Hints
* small speed optimization for AsmLn

70
compiler/cgi386.pas
View File

@ -22,7 +22,7 @@
}
{$ifdef tp}
{$E+,F+,N+,D-,L+,Y+}
{$E+,F+,N+,D+,L-,Y+}
{$endif}
unit cgi386;
@ -647,23 +647,25 @@ implementation
ait_real_extended : consts^.insert(new(pai_extended,init(p^.valued)));
else
internalerror(10120);
end;
{$ifndef MAKELIB}
consts^.insert(new(pai_label,init(lastlabel)));
{$else MAKELIB}
consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
+'$real_const'+tostr(p^.labnumber))));
consts^.insert(new(pai_cut,init));
{$endif MAKELIB}
end;
end;
if smartlink then
begin
consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
+'$real_const'+tostr(p^.labnumber))));
consts^.insert(new(pai_cut,init));
end
else
consts^.insert(new(pai_label,init(lastlabel)));
end;
end;
stringdispose(p^.location.reference.symbol);
{$ifndef MAKELIB}
p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
{$else MAKELIB}
p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
+'$real_const'+tostr(p^.labnumber));
{$endif MAKELIB}
if smartlink then
begin
p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
+'$real_const'+tostr(p^.labnumber));
end
else
p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
end;
procedure secondfixconst(var p : ptree);
@ -749,22 +751,22 @@ implementation
{ to overcome this problem we set the length explicitly }
{ with the ending null char }
pai_string(consts^.first)^.len:=length(p^.values^)+2;
{$ifndef MAKELIB}
consts^.insert(new(pai_label,init(lastlabel)));
{$else MAKELIB}
consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
+'$string_const'+tostr(p^.labstrnumber))));
consts^.insert(new(pai_cut,init));
{$endif MAKELIB}
end;
if smartlink then
begin
consts^.insert(new(pai_symbol,init_global('_$'+current_module^.unitname^
+'$string_const'+tostr(p^.labstrnumber))));
consts^.insert(new(pai_cut,init));
end
else
consts^.insert(new(pai_label,init(lastlabel)));
end;
end;
stringdispose(p^.location.reference.symbol);
{$ifndef MAKELIB}
p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
{$else MAKELIB}
p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
+'$string_const'+tostr(p^.labstrnumber));
{$endif MAKELIB}
if smartlink then
p^.location.reference.symbol:=stringdup('_$'+current_module^.unitname^
+'$string_const'+tostr(p^.labstrnumber))
else
p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
p^.location.loc := LOC_MEM;
end;
@ -5875,7 +5877,13 @@ do_jmp:
end.
{
$Log$
Revision 1.16 1998-04-23 21:52:08 florian
Revision 1.17 1998-04-27 23:10:27 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.16 1998/04/23 21:52:08 florian
* fixes of Jonas applied
Revision 1.15 1998/04/22 21:06:49 florian

20
compiler/cobjects.pas
View File

@ -193,11 +193,6 @@ unit cobjects;
{ closes the file and releases the buffer }
procedure close;
{$ifdef MAKELIB}
{ used for making tiny files for libs }
procedure changename(filename : string);
{$endif MAKELIB}
{ goto the given position }
procedure seek(l : longint);
@ -986,18 +981,17 @@ end;
iomode:=0;
end;
end;
{$ifdef MAKELIB}
procedure tbufferedfile.changename(filename : string);
begin
close;
assign(f,filename);
end;
{$endif MAKELIB}
end.
{
$Log$
Revision 1.2 1998-04-07 11:09:04 peter
Revision 1.3 1998-04-27 23:10:28 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.2 1998/04/07 11:09:04 peter
+ filemode is set correct in tbufferedfile.reset
Revision 1.1.1.1 1998/03/25 11:18:15 root

334
compiler/files.pas
View File

@ -31,50 +31,39 @@ unit files;
const
{$ifdef FPC}
maxunits = 1024;
extbufsize = 65535;
{$else}
maxunits = 128;
extbufsize = 2000;
{$endif}
type
pextfile = ^textfile;
{ this isn't a text file, this is t-ext-file }
{ which means a extended file }
{ this files can be handled by a file }
{ manager }
{ which means a extended file this files can }
{ be handled by a file manager }
pextfile = ^textfile;
textfile = object(tbufferedfile)
path,name,ext : pstring;
{ this is because there is a name conflict }
{ with the older next from tinputstack }
_next : pextfile;
{ 65000 input files for a unit should be enough !! }
ref_index : word;
_next : pextfile; { else conflicts with tinputstack }
ref_index : word; { 65000 input files for a unit should be enough !! }
{ p must be the complete path (with ending \ (or / for unix ...) }
constructor init(const p,n,e : string);
destructor done;virtual;
end;
pinputfile = ^tinputfile;
tinputfile = object(textfile)
filenotatend : boolean;
line_no : longint;
{ second counter for unimportant tokens }
line_count : longint;
{ next input file in the stack of input files }
next : pinputfile;
{ to handle the browser refs }
ref_count : longint;
line_no : longint;
line_count : longint; { second counter for unimportant tokens }
next : pinputfile; { next input file in the stack of input files }
ref_count : longint; { to handle the browser refs }
constructor init(const p,n,e : string);
{ writes the file name and line number to t }
procedure write_file_line(var t : text);
function get_file_line : string;
procedure write_file_line(var t : text); { writes the file name and line number to t }
function get_file_line : string;
end;
pfilemanager = ^tfilemanager;
tfilemanager = object
files : pextfile;
last_ref_index : word;
@ -84,109 +73,64 @@ unit files;
procedure register_file(f : pextfile);
end;
pimported_procedure = ^timported_procedure;
timported_procedure = object(tlinkedlist_item)
ordnr : word;
name,func : pstring;
{ should be plabel, but this gaves problems with circular units }
lab : pointer;
constructor init(const n,s : string;o : word);
destructor done;virtual;
end;
pimportlist = ^timportlist;
timportlist = object(tlinkedlist_item)
dllname : pstring;
imported_procedures : plinkedlist;
constructor init(const n : string);
destructor done;virtual;
end;
type
pmodule = ^tmodule;
pused_unit = ^tused_unit;
tunitmap = array[0..maxunits-1] of pointer;
punitmap = ^tunitmap;
pmodule = ^tmodule;
tmodule = object(tlinkedlist_item)
ppufile : pextfile; { the PPU file }
ppuversion, { PPU version, handle different versions }
crc, { check sum written to the file }
flags : longint; { flags }
compiled, { unit is already compiled }
do_assemble, { only assemble the object, don't recompile }
do_compile, { need to compile the sources }
sources_avail, { if all sources are reachable }
in_implementation, { processing the implementation part? }
in_main : boolean; { global, after uses else false }
map : punitmap; { mapping of all used units }
unitcount : word; { local unit counter }
symtable : pointer; { pointer to the psymtable of this unit }
output_format : tof; { how to write this file }
uses_imports : boolean; { Set if the module imports from DLL's.}
imports : plinkedlist;
sourcefiles : tfilemanager;
linklibfiles,
linkofiles : tstringcontainer;
used_units : tlinkedlist;
current_inputfile : pinputfile;
unitname, { name of the (unit) module in uppercase }
objfilename, { fullname of the objectfile }
asmfilename, { fullname of the assemblerfile }
ppufilename, { fullname of the ppufile }
arfilename, { fullname of the archivefile }
mainsource : pstring; { name of the main sourcefile }
constructor init(const s:string;is_unit:boolean);
destructor special_done;virtual; { this is to be called only when compiling again }
procedure setfilename(const path,name:string);
function load_ppu(const unit_path,n,ext:string):boolean;
procedure search_unit(const n : string);
end;
pused_unit = ^tused_unit;
tused_unit = object(tlinkedlist_item)
u : pmodule;
in_uses, in_interface, is_stab_written : boolean;
unitid : word;
u : pmodule;
in_uses,
in_interface,
is_stab_written : boolean;
unitid : word;
constructor init(_u : pmodule;f : byte);
destructor done;virtual;
end;
tunitmap = array[0..maxunits-1] of pointer;
punitmap = ^tunitmap;
tmodule = object(tlinkedlist_item)
{ the PPU file }
ppufile : pextfile;
{ used for global switches - in_main section after uses clause }
{ then TRUE else false. }
in_main : boolean;
{ mapping of all used units }
map : punitmap;
{ local unit counter }
unitcount : word;
{ this is a pointer because symtable uses this unit }
{ it should be psymtable }
symtable : pointer;
{ PPU version, handle different versions }
ppuversion : longint;
{ check sum written to the file }
crc : longint;
{ flags }
flags : byte;
{Set if the module imports from DLL's.}
uses_imports:boolean;
imports : plinkedlist;
{ how to write this file }
output_format : tof;
{ for interpenetrated units }
in_implementation,
compiled,
do_assemble,
do_compile, { true, if it's needed to compile the sources }
sources_avail : boolean; { true, if all sources are reachable }
{ only used, if the module is compiled by this compiler call }
sourcefiles : tfilemanager;
linklibfiles,
linkofiles : tstringcontainer;
used_units : tlinkedlist;
current_inputfile : pinputfile;
unitname, { name of the (unit) module }
objfilename, { fullname of the objectfile }
asmfilename, { fullname of the assemblerfile }
ppufilename, { fullname of the ppufile }
mainsource : pstring; { name of the main sourcefile }
constructor init(const s:string;is_unit:boolean);
{ this is to be called only when compiling again }
destructor special_done;virtual;
function load_ppu(const unit_path,n,ext : string):boolean;
procedure search_unit(const n : string);
end;
const
main_module : pmodule = nil;
current_module : pmodule = nil;
var
loaded_units : tlinkedlist;
type
tunitheader = array[0..19] of char;
const
@ -207,7 +151,6 @@ unit files;
{ | }
{ start of machine language }
const
ibloadunit = 1;
iborddef = 2;
ibpointerdef = 3;
@ -253,6 +196,14 @@ unit files;
uf_big_endian = $20;
uf_smartlink = $40;
const
main_module : pmodule = nil;
current_module : pmodule = nil;
var
loaded_units : tlinkedlist;
implementation
uses
@ -266,11 +217,7 @@ unit files;
constructor textfile.init(const p,n,e : string);
begin
{$ifdef FPC}
inherited init(p+n+e,65536);
{$else}
inherited init(p+n+e,10000);
{$endif}
inherited init(p+n+e,extbufsize);
path:=stringdup(p);
name:=stringdup(n);
ext:=stringdup(e);
@ -352,51 +299,27 @@ unit files;
files:=f;
end;
{****************************************************************************
Imports stuff
****************************************************************************}
constructor timported_procedure.init(const n,s : string;o : word);
begin
inherited init;
func:=stringdup(n);
name:=stringdup(s);
ordnr:=o;
lab:=nil;
end;
destructor timported_procedure.done;
begin
stringdispose(name);
inherited done;
end;
constructor timportlist.init(const n : string);
begin
inherited init;
dllname:=stringdup(n);
imported_procedures:=new(plinkedlist,init);
end;
destructor timportlist.done;
begin
dispose(imported_procedures,done);
stringdispose(dllname);
end;
{****************************************************************************
TMODULE
****************************************************************************}
{$I-}
procedure tmodule.setfilename(const path,name:string);
var
s : string;
begin
stringdispose(objfilename);
stringdispose(asmfilename);
stringdispose(ppufilename);
stringdispose(arfilename);
s:=FixFileName(FixPath(path)+name);
objfilename:=stringdup(s+target_info.objext);
asmfilename:=stringdup(s+target_info.asmext);
ppufilename:=stringdup(s+target_info.unitext);
arfilename:=stringdup(s+target_info.arext);
end;
function tmodule.load_ppu(const unit_path,n,ext : string):boolean;
var
var
header : tunitheader;
count : longint;
temp,hs : string;
@ -457,10 +380,22 @@ unit files;
crc:=plongint(@header[10])^;
Message1(unit_d_ppu_crc,tostr(crc));
{ read name if its there }
ppufile^.read_data(b,1,count);
{$IFDEF UNITNAME}
if b=ibunitname then
begin
ppufile^.read_data(hs[0],1,count);
ppufile^.read_data(hs[1],ord(hs[0]),count);
stringdispose(unitname);
unitname:=stringdup(hs);
ppufile^.read_data(b,1,count);
end;
{$ENDIF UNITNAME}
{ search source files there is at least one source file }
do_compile:=false;
sources_avail:=true;
ppufile^.read_data(b,1,count);
while b<>ibend do
begin
ppufile^.read_data(hs[0],1,count);
@ -533,7 +468,7 @@ unit files;
Path,
filename : string;
found : boolean;
start,pos : longint;
start,i : longint;
Function UnitExists(const ext:string):boolean;
begin
@ -541,19 +476,6 @@ unit files;
UnitExists:=FileExists(Singlepathstring+FileName+ext);
end;
Procedure SetFileNames;
begin
stringdispose(mainsource);
stringdispose(objfilename);
stringdispose(asmfilename);
stringdispose(ppufilename);
mainsource:=stringdup(SinglePathString+FileName+ext);
objfilename:=stringdup(SinglePathString+FileName+target_info.objext);
asmfilename:=stringdup(SinglePathString+FileName+target_info.asmext);
ppufilename:=stringdup(SinglePathString+FileName+target_info.unitext);
end;
begin
start:=1;
filename:=FixFileName(n);
@ -561,21 +483,20 @@ unit files;
Found:=false;
repeat
{Create current path to check}
pos:=system.pos(';',path);
if pos=0 then
pos:=length(path)+1;
singlepathstring:=FixPath(copy(path,start,pos-start));
delete(path,start,pos-start+1);
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.libext);
if Found then
Begin
SetFileNames;
SetFileName(SinglePathString,FileName);
Found:=Load_PPU(singlepathstring,filename,target_info.libext);
End;
end;
{ Check for PPU file }
if not (cs_link_dynamic in aktswitches) and not Found then
@ -583,10 +504,9 @@ unit files;
Found:=UnitExists(target_info.unitext);
if Found then
Begin
SetFileNames;
SetFileName(SinglePathString,FileName);
Found:=Load_PPU(singlepathstring,filename,target_info.unitext);
End;
end;
{ Check for Sources }
if not Found then
@ -604,34 +524,35 @@ unit files;
if Found then
Ext:=target_info.pasext;
end;
stringdispose(mainsource);
if Found then
begin
sources_avail:=true;
{Load Filenames when found}
SetFilenames;
mainsource:=StringDup(SinglePathString+FileName+Ext);
SetFileName(SinglePathString,FileName);
end
else
begin
sources_avail:=false;
stringdispose(mainsource);
end;
sources_avail:=false;
end;
until Found or (path='');
end;
constructor tmodule.init(const s:string;is_unit:boolean);
var
p:dirstr;
n:namestr;
e:extstr;
p : dirstr;
n : namestr;
e : extstr;
begin
FSplit(s,p,n,e);
n:=Upper(n);
unitname:=stringdup(n);
unitname:=stringdup(Upper(n));
mainsource:=stringdup(s);
objfilename:=nil;
asmfilename:=nil;
arfilename:=nil;
ppufilename:=nil;
mainsource:=stringdup(s);
setfilename(p,n);
used_units.init;
sourcefiles.init;
linkofiles.init;
@ -659,7 +580,8 @@ unit files;
destructor tmodule.special_done;
begin
if assigned(map) then dispose(map);
if assigned(map) then
dispose(map);
{ cannot remove that because it is linked
in the global chain of used_objects
used_units.done; }
@ -689,16 +611,20 @@ unit files;
end;
destructor tused_unit.done;
begin
inherited done;
end;
{$I+}
end.
{
$Log$
Revision 1.2 1998-04-21 10:16:47 peter
Revision 1.3 1998-04-27 23:10:28 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.2 1998/04/21 10:16:47 peter
* patches from strasbourg
* objects is not used anymore in the fpc compiled version

89
compiler/import.pas
View File

@ -22,15 +22,36 @@
unit import;
interface
uses
cobjects;
type
pimportlib=^timportlib;
timportlib=object
constructor Init;
destructor Done;
procedure preparelib(const s:string);virtual;
procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
procedure generatelib;virtual;
end;
pimported_procedure = ^timported_procedure;
timported_procedure = object(tlinkedlist_item)
ordnr : word;
name,func : pstring;
lab : pointer; { should be plabel, but this gaves problems with circular units }
constructor init(const n,s : string;o : word);
destructor done;virtual;
end;
pimportlist = ^timportlist;
timportlist = object(tlinkedlist_item)
dllname : pstring;
imported_procedures : plinkedlist;
constructor init(const n : string);
destructor done;virtual;
end;
pimportlib=^timportlib;
timportlib=object
constructor Init;
destructor Done;
procedure preparelib(const s:string);virtual;
procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
procedure generatelib;virtual;
end;
var
importlib : pimportlib;
@ -42,6 +63,48 @@ uses
systems,verbose,
os2_targ,win_targ;
{****************************************************************************
TImported_procedure
****************************************************************************}
constructor timported_procedure.init(const n,s : string;o : word);
begin
inherited init;
func:=stringdup(n);
name:=stringdup(s);
ordnr:=o;
lab:=nil;
end;
destructor timported_procedure.done;
begin
stringdispose(name);
inherited done;
end;
{****************************************************************************
TImportlist
****************************************************************************}
constructor timportlist.init(const n : string);
begin
inherited init;
dllname:=stringdup(n);
imported_procedures:=new(plinkedlist,init);
end;
destructor timportlist.done;
begin
dispose(imported_procedures,done);
stringdispose(dllname);
end;
{****************************************************************************
TImportLib
****************************************************************************}
constructor timportlib.Init;
begin
end;
@ -83,8 +146,14 @@ end;
end.
{
$Log$
Revision 1.1 1998-03-25 11:18:12 root
Initial revision
Revision 1.2 1998-04-27 23:10:28 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.1.1.1 1998/03/25 11:18:12 root
* Restored version
Revision 1.3 1998/03/10 01:17:19 peter
* all files have the same header

21
compiler/parser.pas
View File

@ -132,8 +132,8 @@ unit parser;
oldpreprocstack : ppreprocstack;
oldorgpattern,oldprocprefix : string;
old_block_type : tblock_type;
oldinputbuffer : pchar;
oldinputpointer : longint;
oldinputbuffer,
oldinputpointer : pchar;
olds_point,oldparse_only : boolean;
oldc : char;
oldcomment_level : word;
@ -209,8 +209,6 @@ unit parser;
set_macro('FPC_PATCH',patch_nr);
end;
var
a : PAsmFile;
label
done;
@ -403,15 +401,12 @@ unit parser;
if current_module^.uses_imports then
importlib^.generatelib;
a:=new(PAsmFile,Init(filename));
a^.WriteAsmSource;
a^.DoAssemble;
dispose(a,Done);
GenerateAsm(filename);
{ Check linking => we are at first level in compile }
if (compile_level=1) then
begin
if Linker.ExeName='' then
if Linker.ExeName='' then
Linker.SetFileName(FileName);
if (comp_unit) then
begin
@ -530,7 +525,13 @@ done:
end.
{
$Log$
Revision 1.6 1998-04-21 10:16:48 peter
Revision 1.7 1998-04-27 23:10:28 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.6 1998/04/21 10:16:48 peter
* patches from strasbourg
* objects is not used anymore in the fpc compiled version

13
compiler/pdecl.pas
View File

@ -963,9 +963,8 @@ unit pdecl;
testcurobject:=0;
curobjectname:='';
{$ifdef MAKELIB}
datasegment^.concat(new(pai_cut,init));
{$endif MAKELIB}
if smartlink then
datasegment^.concat(new(pai_cut,init));
{$ifdef GDB}
{ generate the VMT }
if cs_debuginfo in aktswitches then
@ -1736,7 +1735,13 @@ unit pdecl;
end.
{
$Log$
Revision 1.9 1998-04-10 21:36:56 florian
Revision 1.10 1998-04-27 23:10:28 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.9 1998/04/10 21:36:56 florian
+ some stuff to support method pointers (procedure of object) added
(declaration, parameter handling)

163
compiler/pmodules.pas
View File

@ -196,7 +196,6 @@ unit pmodules;
st : punitsymtable;
old_current_module,hp,nextmodule : pmodule;
pu : pused_unit;
a : pasmfile;
hs : pstring;
begin
old_current_module:=current_module;
@ -255,11 +254,7 @@ unit pmodules;
begin
{ only reassemble ? }
if (hp^.do_assemble) then
begin
a:=new(PAsmFile,Init(hp^.asmfilename^));
a^.DoAssemble;
dispose(a,Done);
end;
OnlyAsm(hp^.asmfilename^);
{ we should know there the PPU file else it's an error and
we can't load the unit }
if hp^.ppufile^.name^<>'' then
@ -416,71 +411,66 @@ unit pmodules;
procedure proc_unit;
var
unitname : stringid;
{$ifdef GDB}
{ several defs to simulate more or less C++ objects for GDB }
vmtdef : precdef;
pvmtdef : ppointerdef;
vmtdef : precdef;
pvmtdef : ppointerdef;
vmtarraydef : parraydef;
vmtsymtable : psymtable;
{$endif GDB}
names:Tstringcontainer;
p : psymtable;
names : Tstringcontainer;
p : psymtable;
unitst : punitsymtable;
pu : pused_unit;
{ the output ppufile is written to this path }
s1,s2,s3:^string; {Saves stack space, but only eats heap
space when there is a lot of heap free.}
pu : pused_unit;
s1,s2 : ^string; {Saves stack space}
begin
consume(_UNIT);
stringdispose(current_module^.objfilename);
stringdispose(current_module^.ppufilename);
{ create filenames and check unit name }
new(s1);
new(s2);
new(s3);
s1^:=FixFileName(current_module^.current_inputfile^.path^+current_module^.current_inputfile^.name^);
current_module^.objfilename:=stringdup(s1^+target_info.objext);
current_module^.ppufilename:=stringdup(s1^+target_info.unitext);
s1^:=upper(pattern);
s2^:=upper(target_info.system_unit);
s3^:=upper(current_module^.current_inputfile^.name^);
if (cs_compilesystem in aktswitches) then
if token=ID then
begin
if (cs_check_unit_name in aktswitches) and
((length(pattern)>8) or (s1^<>s2^) or (s1^<>s3^)) then
Message1(unit_e_illegal_unit_name,s1^);
end
else
if (s1^=s2^) then
Message(unit_w_switch_us_missed);
dispose(s3);
dispose(s2);
dispose(s1);
{ add object }
Linker.AddObjectFile(current_module^.objfilename^);
unitname:=pattern;
{ create filenames and unit name }
current_module^.SetFileName(current_module^.current_inputfile^.path^,current_module^.current_inputfile^.name^);
current_module^.unitname:=stringdup(upper(pattern));
{ check for system unit }
new(s1);
new(s2);
s1^:=upper(target_info.system_unit);
s2^:=upper(current_module^.current_inputfile^.name^);
if (cs_compilesystem in aktswitches) then
begin
if (cs_check_unit_name in aktswitches) and
((length(current_module^.unitname^)>8) or
(current_module^.unitname^<>s1^) or
(current_module^.unitname^<>s2^)) then
Message1(unit_e_illegal_unit_name,s1^);
end
else
if (current_module^.unitname^=s1^) then
Message(unit_w_switch_us_missed);
dispose(s2);
dispose(s1);
{ Add Object File }
Linker.AddObjectFile(current_module^.objfilename^);
current_module^.linkofiles.insert(current_module^.objfilename^);
end;
consume(ID);
consume(SEMICOLON);
consume(_INTERFACE);
{ this should be placed after uses !!}
{$ifndef UseNiceNames}
procprefix:='_'+unitname+'$$';
procprefix:='_'+current_module^.unitname^+'$$';
{$else UseNiceNames}
procprefix:='_'+tostr(length(unitname))+lowercase(unitname)+'_';
procprefix:='_'+tostr(length(current_module^.unitname^))+lowercase(current_module^.unitname^)+'_';
{$endif UseNiceNames}
parse_only:=true;
{ generate now the global symboltable }
p:=new(punitsymtable,init(globalsymtable,unitname));
p:=new(punitsymtable,init(globalsymtable,current_module^.unitname^));
refsymtable:=p;
unitst:=punitsymtable(p);
@ -491,7 +481,6 @@ unit pmodules;
{ a unit compiled at command line must be inside the loaded_unit list }
if (compile_level=1) then
begin
current_module^.unitname:=stringdup(unitname);
loaded_units.insert(current_module);
if cs_unit_to_lib in initswitches then
begin
@ -646,14 +635,14 @@ unit pmodules;
only_calculate_crc:=false;
}
{ generates static symbol table }
p:=new(punitsymtable,init(staticsymtable,unitname));
p:=new(punitsymtable,init(staticsymtable,current_module^.unitname^));
refsymtable:=p;
{Generate a procsym.}
aktprocsym:=new(Pprocsym,init(unitname+'_init'));
aktprocsym:=new(Pprocsym,init(current_module^.unitname^+'_init'));
aktprocsym^.definition:=new(Pprocdef,init);
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
aktprocsym^.definition^.setmangledname(unitname+'_init');
aktprocsym^.definition^.setmangledname(current_module^.unitname^+'_init');
{The generated procsym has a local symtable. Discard it and turn
it into the static one.}
@ -661,7 +650,8 @@ unit pmodules;
aktprocsym^.definition^.localst:=p;
names.init;
names.insert(unitname+'_init');
names.insert(current_module^.unitname^+'_init');
names.insert('INIT$$'+current_module^.unitname^);
{ testing !!!!!!!!! }
{ we set the interface part as a unitsymtable }
@ -673,13 +663,6 @@ unit pmodules;
parse_uses(unitst);
{ duplicated here to be sure }
{$ifndef UseNiceNames}
procprefix:='_'+unitname+'$$';
{$else UseNiceNames}
procprefix:='_'+tostr(length(unitname))+lowercase(unitname)+'_';
{$endif UseNiceNames}
{ but reinsert the global symtable as lasts }
unitst^.next:=symtablestack;
symtablestack:=unitst;
@ -696,28 +679,22 @@ unit pmodules;
allow_special:=true;
Switch_to_temp_heap;
end;
{$endif Splitheap}
{$ifdef Splitheap}
{ it will report all crossings }
allow_special:=false;
{$endif Splitheap}
{ set some informations }
procinfo.retdef:=voiddef;
procinfo._class:=nil;
procinfo.call_offset:=8;
{ for temporary values }
procinfo.framepointer:=frame_pointer;
{ clear flags }
procinfo.flags:=0;
{Reset the codegenerator.}
codegen_newprocedure;
names.insert('INIT$$'+unitname);
compile_proc_body(names,true,false);
codegen_doneprocedure;
@ -779,12 +756,14 @@ unit pmodules;
{ fatal error (avoids pointer problems)}
{ when referencing the non-existant }
{ system unit. }
if (cs_compilesystem in aktswitches) then
{ System Unit should be compiled using proc_unit !! (PFV) }
{ if (cs_compilesystem in aktswitches) then
Begin
if token<>_UNIT then
Message1(scan_f_syn_expected,'UNIT');
consume(_UNIT);
end;
end;}
parse_only:=false;
programname:='';
@ -799,7 +778,7 @@ unit pmodules;
else
{ is there an program head ? }
if token=_PROGRAM then
begin
begin
consume(_PROGRAM);
programname:=pattern;
consume(ID);
@ -810,7 +789,7 @@ unit pmodules;
consume(RKLAMMER);
end;
consume(SEMICOLON);
end;
end;
{ insert after the unit symbol tables the static symbol table }
{ of the program }
@ -826,9 +805,6 @@ unit pmodules;
dispose(aktprocsym^.definition^.localst,done);
aktprocsym^.definition^.localst:=st;
names.init;
names.insert('program_init');
refsymtable:=st;
{Insert the symbols of the system unit into the stack of symbol
@ -838,7 +814,8 @@ unit pmodules;
refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
{Load the units used by the program we compile.}
if token=_USES then loadunits;
if token=_USES then
loadunits;
{Insert the name of the main program into the symbol table.}
if programname<>'' then
@ -865,27 +842,31 @@ unit pmodules;
procprefix:='';
in_except_block:=false;
{The program intialization needs an alias, so it can be called
from the bootstrap code.}
case target_info.target of
target_GO32V1,
target_GO32V2,
target_OS2,
target_WIN32:
names.insert('_main');
target_LINUX:
names.insert('main');
end;
names.init;
names.insert('program_init');
names.insert('PASCALMAIN');
case target_info.target of
target_GO32V1,
target_GO32V2,
target_OS2,
target_WIN32 : names.insert('_main');
target_LINUX : names.insert('main');
end;
compile_proc_body(names,true,false);
codegen_doneprocedure;
Linker.AddObjectFile(current_module^.unitname^);
current_module^.linkofiles.insert(current_module^.unitname^);
Linker.AddObjectFile(current_module^.objfilename^);
current_module^.linkofiles.insert(current_module^.objfilename^);
if smartlink then
begin
bsssegment^.concat(new(pai_cut,init));
datasegment^.concat(new(pai_cut,init));
end;
{ On the Macintosh Classic M68k Architecture }
{ The Heap variable is simply a POINTER to the }
{ real HEAP. The HEAP must be set up by the RTL }
@ -936,7 +917,13 @@ unit pmodules;
end.
{
$Log$
Revision 1.5 1998-04-14 23:27:03 florian
Revision 1.6 1998-04-27 23:10:28 peter
+ new scanner
* $makelib -> if smartlink
* small filename fixes pmodule.setfilename
* moved import from files.pas -> import.pas
Revision 1.5 1998/04/14 23:27:03 florian
+ exclude/include with constant second parameter added
Revision 1.4 1998/04/10 14:41:43 peter

3098
compiler/scanner.pas
View File

File diff suppressed because it is too large Load Diff