mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-27 12:10:36 +02:00
* smartlinking works for win32
* some defines to exclude some compiler parts
This commit is contained in:
peter
parent
837c1582a3
commit
f98459e1fb
@ -123,6 +123,7 @@ unit aasm;
|
|||||||
plabel = ^tlabel;
|
plabel = ^tlabel;
|
||||||
tlabel = record
|
tlabel = record
|
||||||
nb : longint;
|
nb : longint;
|
||||||
|
is_data : boolean;
|
||||||
is_used : boolean;
|
is_used : boolean;
|
||||||
is_set : boolean;
|
is_set : boolean;
|
||||||
refcount : word;
|
refcount : word;
|
||||||
@ -285,6 +286,8 @@ type
|
|||||||
function lab2str(l : plabel) : string;
|
function lab2str(l : plabel) : string;
|
||||||
{ make l as a new label }
|
{ make l as a new label }
|
||||||
procedure getlabel(var l : plabel);
|
procedure getlabel(var l : plabel);
|
||||||
|
{ make l as a new label and flag is_data }
|
||||||
|
procedure getdatalabel(var l : plabel);
|
||||||
{ frees the label if unused }
|
{ frees the label if unused }
|
||||||
procedure freelabel(var l : plabel);
|
procedure freelabel(var l : plabel);
|
||||||
{ make a new zero label }
|
{ make a new zero label }
|
||||||
@ -585,18 +588,15 @@ uses
|
|||||||
typ:=ait_label;
|
typ:=ait_label;
|
||||||
l:=_l;
|
l:=_l;
|
||||||
l^.is_set:=true;
|
l^.is_set:=true;
|
||||||
{ suggestion of JM:
|
|
||||||
inc(l^.refcount); }
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor tai_label.done;
|
destructor tai_label.done;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{ suggestion of JM:
|
|
||||||
dec(l^.refcount); }
|
|
||||||
if (l^.is_used) then
|
if (l^.is_used) then
|
||||||
l^.is_set:=false
|
l^.is_set:=false
|
||||||
else dispose(l);
|
else
|
||||||
|
dispose(l);
|
||||||
inherited done;
|
inherited done;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -751,15 +751,20 @@ uses
|
|||||||
function lab2str(l : plabel) : string;
|
function lab2str(l : plabel) : string;
|
||||||
begin
|
begin
|
||||||
if (l=nil) or (l^.nb=0) then
|
if (l=nil) or (l^.nb=0) then
|
||||||
|
begin
|
||||||
{$ifdef EXTDEBUG}
|
{$ifdef EXTDEBUG}
|
||||||
lab2str:='ILLEGAL'
|
lab2str:='ILLEGAL'
|
||||||
else
|
|
||||||
lab2str:=target_asm.labelprefix+tostr(l^.nb);
|
|
||||||
{$else EXTDEBUG}
|
{$else EXTDEBUG}
|
||||||
internalerror(2000);
|
internalerror(2000);
|
||||||
lab2str:=target_asm.labelprefix+tostr(l^.nb);
|
|
||||||
{$endif EXTDEBUG}
|
{$endif EXTDEBUG}
|
||||||
{ was missed: }
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (l^.is_data) and (cs_smartlink in aktswitches) then
|
||||||
|
lab2str:='_$'+current_module^.modulename^+'$_L'+tostr(l^.nb)
|
||||||
|
else
|
||||||
|
lab2str:=target_asm.labelprefix+tostr(l^.nb);
|
||||||
|
end;
|
||||||
inc(l^.refcount);
|
inc(l^.refcount);
|
||||||
l^.is_used:=true;
|
l^.is_used:=true;
|
||||||
end;
|
end;
|
||||||
@ -771,6 +776,19 @@ uses
|
|||||||
l^.nb:=nextlabelnr;
|
l^.nb:=nextlabelnr;
|
||||||
l^.is_used:=false;
|
l^.is_used:=false;
|
||||||
l^.is_set:=false;
|
l^.is_set:=false;
|
||||||
|
l^.is_data:=false;
|
||||||
|
l^.refcount:=0;
|
||||||
|
inc(nextlabelnr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure getdatalabel(var l : plabel);
|
||||||
|
begin
|
||||||
|
new(l);
|
||||||
|
l^.nb:=nextlabelnr;
|
||||||
|
l^.is_used:=false;
|
||||||
|
l^.is_set:=false;
|
||||||
|
l^.is_data:=true;
|
||||||
l^.refcount:=0;
|
l^.refcount:=0;
|
||||||
inc(nextlabelnr);
|
inc(nextlabelnr);
|
||||||
end;
|
end;
|
||||||
@ -791,6 +809,7 @@ uses
|
|||||||
nb:=0;
|
nb:=0;
|
||||||
is_used:=false;
|
is_used:=false;
|
||||||
is_set:=false;
|
is_set:=false;
|
||||||
|
is_data:=false;
|
||||||
refcount:=0;
|
refcount:=0;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -802,6 +821,7 @@ uses
|
|||||||
l^.nb:=0;
|
l^.nb:=0;
|
||||||
l^.is_used:=false;
|
l^.is_used:=false;
|
||||||
l^.is_set:=false;
|
l^.is_set:=false;
|
||||||
|
l^.is_data:=false;
|
||||||
l^.refcount:=0;
|
l^.refcount:=0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -817,7 +837,11 @@ uses
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.9 1998-06-04 23:51:26 peter
|
Revision 1.10 1998-06-08 22:59:41 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.9 1998/06/04 23:51:26 peter
|
||||||
* m68k compiles
|
* m68k compiles
|
||||||
+ .def file creation moved to gendef.pas so it could also be used
|
+ .def file creation moved to gendef.pas so it could also be used
|
||||||
for win32
|
for win32
|
||||||
|
|||||||
@ -45,6 +45,7 @@ type
|
|||||||
srcfile,
|
srcfile,
|
||||||
as_bin : string;
|
as_bin : string;
|
||||||
{outfile}
|
{outfile}
|
||||||
|
AsmSize,
|
||||||
outcnt : longint;
|
outcnt : longint;
|
||||||
outbuf : array[0..AsmOutSize-1] of char;
|
outbuf : array[0..AsmOutSize-1] of char;
|
||||||
outfile : file;
|
outfile : file;
|
||||||
@ -82,10 +83,26 @@ uses
|
|||||||
{$endif}
|
{$endif}
|
||||||
,strings
|
,strings
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
,ag386att,ag386int,ag386nsm
|
{$ifndef NoAg386Att}
|
||||||
|
,ag386att
|
||||||
|
{$endif NoAg386Att}
|
||||||
|
{$ifndef NoAg386Nsm}
|
||||||
|
,ag386nsm
|
||||||
|
{$endif NoAg386Nsm}
|
||||||
|
{$ifndef NoAg386Int}
|
||||||
|
,ag386int
|
||||||
|
{$endif NoAg386Int}
|
||||||
{$endif}
|
{$endif}
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
,ag68kmot,ag68kgas,ag68kmit
|
{$ifndef NoAg68kGas}
|
||||||
|
,ag68kgas
|
||||||
|
{$endif NoAg68kGas}
|
||||||
|
{$ifndef NoAg68kMot}
|
||||||
|
,ag68kmot
|
||||||
|
{$endif NoAg68kMot}
|
||||||
|
{$ifndef NoAg68kMit}
|
||||||
|
,ag68kmit
|
||||||
|
{$endif NoAg68kMit}
|
||||||
{$endif}
|
{$endif}
|
||||||
;
|
;
|
||||||
|
|
||||||
@ -231,6 +248,7 @@ begin
|
|||||||
AsmFlush;
|
AsmFlush;
|
||||||
Move(s[1],OutBuf[OutCnt],length(s));
|
Move(s[1],OutBuf[OutCnt],length(s));
|
||||||
inc(OutCnt,length(s));
|
inc(OutCnt,length(s));
|
||||||
|
inc(AsmSize,length(s));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -254,6 +272,7 @@ begin
|
|||||||
AsmFlush;
|
AsmFlush;
|
||||||
Move(p[0],OutBuf[OutCnt],i);
|
Move(p[0],OutBuf[OutCnt],i);
|
||||||
inc(OutCnt,i);
|
inc(OutCnt,i);
|
||||||
|
inc(AsmSize,i);
|
||||||
dec(j,i);
|
dec(j,i);
|
||||||
p:=pchar(@p[i]);
|
p:=pchar(@p[i]);
|
||||||
end;
|
end;
|
||||||
@ -266,10 +285,12 @@ begin
|
|||||||
AsmFlush;
|
AsmFlush;
|
||||||
OutBuf[OutCnt]:=target_os.newline[1];
|
OutBuf[OutCnt]:=target_os.newline[1];
|
||||||
inc(OutCnt);
|
inc(OutCnt);
|
||||||
|
inc(AsmSize);
|
||||||
if length(target_os.newline)>1 then
|
if length(target_os.newline)>1 then
|
||||||
begin
|
begin
|
||||||
OutBuf[OutCnt]:=target_os.newline[2];
|
OutBuf[OutCnt]:=target_os.newline[2];
|
||||||
inc(OutCnt);
|
inc(OutCnt);
|
||||||
|
inc(AsmSize);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -295,6 +316,7 @@ begin
|
|||||||
Message1(exec_d_cant_create_asmfile,asmfile);
|
Message1(exec_d_cant_create_asmfile,asmfile);
|
||||||
end;
|
end;
|
||||||
outcnt:=0;
|
outcnt:=0;
|
||||||
|
AsmSize:=0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -380,20 +402,32 @@ var
|
|||||||
begin
|
begin
|
||||||
case aktoutputformat of
|
case aktoutputformat of
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
|
{$ifndef NoAg386Att}
|
||||||
as_o : a:=new(pi386attasmlist,Init(fn));
|
as_o : a:=new(pi386attasmlist,Init(fn));
|
||||||
|
{$endif NoAg386Att}
|
||||||
|
{$ifndef NoAg386Nsm}
|
||||||
as_nasmcoff,
|
as_nasmcoff,
|
||||||
as_nasmelf,
|
as_nasmelf,
|
||||||
as_nasmobj : a:=new(pi386nasmasmlist,Init(fn));
|
as_nasmobj : a:=new(pi386nasmasmlist,Init(fn));
|
||||||
|
{$endif NoAg386Nsm}
|
||||||
|
{$ifndef NoAg386Int}
|
||||||
as_tasm : a:=new(pi386intasmlist,Init(fn));
|
as_tasm : a:=new(pi386intasmlist,Init(fn));
|
||||||
|
{$endif NoAg386Int}
|
||||||
{$endif}
|
{$endif}
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
|
{$ifndef NoAg68kGas}
|
||||||
as_o,
|
as_o,
|
||||||
as_gas : a:=new(pm68kgasasmlist,Init(fn));
|
as_gas : a:=new(pm68kgasasmlist,Init(fn));
|
||||||
|
{$endif NoAg86KGas}
|
||||||
|
{$ifndef NoAg68kMot}
|
||||||
as_mot : a:=new(pm68kmotasmlist,Init(fn));
|
as_mot : a:=new(pm68kmotasmlist,Init(fn));
|
||||||
|
{$endif NoAg86kMot}
|
||||||
|
{$ifndef NoAg68kMit}
|
||||||
as_mit : a:=new(pm68kmitasmlist,Init(fn));
|
as_mit : a:=new(pm68kmitasmlist,Init(fn));
|
||||||
|
{$endif NoAg86KMot}
|
||||||
{$endif}
|
{$endif}
|
||||||
else
|
else
|
||||||
internalerror(30000);
|
Comment(V_Fatal,'Selected assembler output not supported!');
|
||||||
end;
|
end;
|
||||||
a^.AsmCreate;
|
a^.AsmCreate;
|
||||||
a^.WriteAsmList;
|
a^.WriteAsmList;
|
||||||
@ -416,7 +450,11 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.10 1998-06-04 23:51:33 peter
|
Revision 1.11 1998-06-08 22:59:43 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.10 1998/06/04 23:51:33 peter
|
||||||
* m68k compiles
|
* m68k compiles
|
||||||
+ .def file creation moved to gendef.pas so it could also be used
|
+ .def file creation moved to gendef.pas so it could also be used
|
||||||
for win32
|
for win32
|
||||||
|
|||||||
@ -1,63 +0,0 @@
|
|||||||
{
|
|
||||||
$Id$
|
|
||||||
Copyright (c) 1993-98 by Florian Klaempfl
|
|
||||||
|
|
||||||
This unit generates i386 (or better) assembler from the parse tree
|
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or modify
|
|
||||||
it under the terms of the GNU General Public License as published by
|
|
||||||
the Free Software Foundation; either version 2 of the License, or
|
|
||||||
(at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
GNU General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
|
||||||
along with this program; if not, write to the Free Software
|
|
||||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
||||||
|
|
||||||
****************************************************************************
|
|
||||||
}
|
|
||||||
{$ifdef tp}
|
|
||||||
{$E+,F+,N+,D+,L+,Y+}
|
|
||||||
{$endif}
|
|
||||||
unit cgi3862;
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
verbose,cobjects,systems,globals,tree,
|
|
||||||
symtable,types,strings,pass_1,hcodegen,
|
|
||||||
aasm,i386,tgeni386,files,cgai386;
|
|
||||||
|
|
||||||
procedure secondadd(var p : ptree);
|
|
||||||
procedure secondaddstring(var p : ptree);
|
|
||||||
procedure secondas(var p : ptree);
|
|
||||||
procedure secondis(var p : ptree);
|
|
||||||
procedure secondloadvmt(var p : ptree);
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
uses
|
|
||||||
cgi386;
|
|
||||||
|
|
||||||
{$I cgi386ad.inc}
|
|
||||||
|
|
||||||
end.
|
|
||||||
{
|
|
||||||
$Log$
|
|
||||||
Revision 1.2 1998-04-21 10:16:47 peter
|
|
||||||
* patches from strasbourg
|
|
||||||
* objects is not used anymore in the fpc compiled version
|
|
||||||
|
|
||||||
Revision 1.1.1.1 1998/03/25 11:18:12 root
|
|
||||||
* Restored version
|
|
||||||
|
|
||||||
Revision 1.9 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
|
|
||||||
|
|
||||||
}
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -304,7 +304,7 @@ begin
|
|||||||
AddSharedLibrary('c');
|
AddSharedLibrary('c');
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -434,19 +434,23 @@ end;
|
|||||||
|
|
||||||
Procedure TLinker.MakeStaticLibrary(const path:string;filescnt:longint);
|
Procedure TLinker.MakeStaticLibrary(const path:string;filescnt:longint);
|
||||||
var
|
var
|
||||||
|
s,
|
||||||
arbin : string;
|
arbin : string;
|
||||||
arfound : boolean;
|
arfound : boolean;
|
||||||
cnt : longint;
|
cnt : longint;
|
||||||
i : word;
|
i : word;
|
||||||
f : file;
|
f : file;
|
||||||
begin
|
begin
|
||||||
arbin:=FindExe('ar',arfound);
|
arbin:=FindExe(target_ar.arbin,arfound);
|
||||||
if (not arfound) and (not externlink) then
|
if (not arfound) and (not externlink) then
|
||||||
begin
|
begin
|
||||||
Message(exec_w_ar_not_found);
|
Message(exec_w_ar_not_found);
|
||||||
externlink:=true;
|
externlink:=true;
|
||||||
end;
|
end;
|
||||||
DoExec(arbin,'rs '+staticlibname+' '+FixPath(path)+'*'+target_info.objext,false,true);
|
s:=target_ar.arcmd;
|
||||||
|
Replace(s,'$LIB',staticlibname);
|
||||||
|
Replace(s,'$FILES',FixPath(path)+'*'+target_info.objext);
|
||||||
|
DoExec(arbin,s,false,true);
|
||||||
{ Clean up }
|
{ Clean up }
|
||||||
if (not writeasmfile) and (not externlink) then
|
if (not writeasmfile) and (not externlink) then
|
||||||
begin
|
begin
|
||||||
@ -475,7 +479,11 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.12 1998-06-04 23:51:44 peter
|
Revision 1.13 1998-06-08 22:59:46 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.12 1998/06/04 23:51:44 peter
|
||||||
* m68k compiles
|
* m68k compiles
|
||||||
+ .def file creation moved to gendef.pas so it could also be used
|
+ .def file creation moved to gendef.pas so it could also be used
|
||||||
for win32
|
for win32
|
||||||
|
|||||||
@ -34,7 +34,7 @@ unit parser;
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
systems,cobjects,globals,verbose,
|
systems,cobjects,globals,verbose,
|
||||||
symtable,files,aasm,hcodegen,import,
|
symtable,files,aasm,hcodegen,
|
||||||
assemble,link,script,gendef,
|
assemble,link,script,gendef,
|
||||||
scanner,pbase,pdecl,psystem,pmodules;
|
scanner,pbase,pdecl,psystem,pmodules;
|
||||||
|
|
||||||
@ -312,9 +312,6 @@ unit parser;
|
|||||||
|
|
||||||
if status.errorcount=0 then
|
if status.errorcount=0 then
|
||||||
begin
|
begin
|
||||||
if current_module^.uses_imports then
|
|
||||||
importlib^.generatelib;
|
|
||||||
|
|
||||||
GenerateAsm(filename);
|
GenerateAsm(filename);
|
||||||
|
|
||||||
if (cs_smartlink in aktswitches) then
|
if (cs_smartlink in aktswitches) then
|
||||||
@ -442,7 +439,11 @@ done:
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.22 1998-06-05 17:47:28 peter
|
Revision 1.23 1998-06-08 22:59:48 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.22 1998/06/05 17:47:28 peter
|
||||||
* some better uses clauses
|
* some better uses clauses
|
||||||
|
|
||||||
Revision 1.21 1998/06/04 23:51:49 peter
|
Revision 1.21 1998/06/04 23:51:49 peter
|
||||||
|
|||||||
@ -39,7 +39,7 @@ unit pmodules;
|
|||||||
uses
|
uses
|
||||||
cobjects,verbose,systems,globals,
|
cobjects,verbose,systems,globals,
|
||||||
symtable,aasm,hcodegen,
|
symtable,aasm,hcodegen,
|
||||||
link,assemble
|
link,assemble,import
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
,i386
|
,i386
|
||||||
{$endif}
|
{$endif}
|
||||||
@ -63,6 +63,15 @@ unit pmodules;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure insertsegment;
|
procedure insertsegment;
|
||||||
|
|
||||||
|
procedure fixseg(p:paasmoutput;sec:tsection);
|
||||||
|
begin
|
||||||
|
p^.insert(new(pai_section,init(sec)));
|
||||||
|
if (cs_smartlink in aktswitches) then
|
||||||
|
p^.insert(new(pai_cut,init));
|
||||||
|
p^.concat(new(pai_section,init(sec_none)));
|
||||||
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{Insert Ident of the compiler}
|
{Insert Ident of the compiler}
|
||||||
if (not (cs_smartlink in aktswitches))
|
if (not (cs_smartlink in aktswitches))
|
||||||
@ -75,15 +84,10 @@ unit pmodules;
|
|||||||
datasegment^.insert(new(pai_string,init('FPC '+version_string+' for '+target_string+' - '+target_info.short_name)));
|
datasegment^.insert(new(pai_string,init('FPC '+version_string+' for '+target_string+' - '+target_info.short_name)));
|
||||||
end;
|
end;
|
||||||
{ Insert start and end of sections }
|
{ Insert start and end of sections }
|
||||||
codesegment^.insert(new(pai_section,init(sec_code)));
|
fixseg(codesegment,sec_code);
|
||||||
codesegment^.concat(new(pai_section,init(sec_none)));
|
fixseg(datasegment,sec_data);
|
||||||
datasegment^.insert(new(pai_section,init(sec_data)));
|
fixseg(bsssegment,sec_bss);
|
||||||
datasegment^.concat(new(pai_section,init(sec_none)));
|
fixseg(consts,sec_data);
|
||||||
bsssegment^.insert(new(pai_section,init(sec_bss)));
|
|
||||||
bsssegment^.concat(new(pai_section,init(sec_none)));
|
|
||||||
consts^.insert(new(pai_asm_comment,init('Constants')));
|
|
||||||
consts^.insert(new(pai_section,init(sec_data)));
|
|
||||||
consts^.concat(new(pai_section,init(sec_none)));
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure insertheap;
|
procedure insertheap;
|
||||||
@ -101,14 +105,11 @@ unit pmodules;
|
|||||||
not output a pointer }
|
not output a pointer }
|
||||||
case target_info.target of
|
case target_info.target of
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
|
|
||||||
target_OS2 : ;
|
target_OS2 : ;
|
||||||
{$endif i386}
|
{$endif i386}
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
|
|
||||||
target_Mac68K : bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
|
target_Mac68K : bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
|
||||||
{$endif m68k}
|
{$endif m68k}
|
||||||
|
|
||||||
else
|
else
|
||||||
bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
|
bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
|
||||||
end;
|
end;
|
||||||
@ -122,7 +123,6 @@ unit pmodules;
|
|||||||
i : longint;
|
i : longint;
|
||||||
begin
|
begin
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
|
|
||||||
case target_info.target of
|
case target_info.target of
|
||||||
target_GO32V2 : begin
|
target_GO32V2 : begin
|
||||||
{ stacksize can be specified }
|
{ stacksize can be specified }
|
||||||
@ -130,14 +130,17 @@ unit pmodules;
|
|||||||
datasegment^.concat(new(pai_const,init_32bit(stacksize)));
|
datasegment^.concat(new(pai_const,init_32bit(stacksize)));
|
||||||
end;
|
end;
|
||||||
target_WIN32 : begin
|
target_WIN32 : begin
|
||||||
{ generate the last entry for the imports directory }
|
{ Generate an external entry to be sure that _mainCRTStarup will be
|
||||||
if not(assigned(importssection)) then
|
linked, can't use concat_external because those aren't written for
|
||||||
|
asw (PFV) }
|
||||||
|
datasegment^.concat(new(pai_const,init_symbol('_mainCRTStartup')));
|
||||||
|
{ generate the last entry for the imports directory, is done
|
||||||
|
in the ld script }
|
||||||
|
{ if not(assigned(importssection)) then
|
||||||
importssection:=new(paasmoutput,init);
|
importssection:=new(paasmoutput,init);
|
||||||
{ $3 ensure that it is the last entry, all other entries }
|
|
||||||
{ are written to $2 }
|
|
||||||
importssection^.concat(new(pai_section,init_idata(3)));
|
importssection^.concat(new(pai_section,init_idata(3)));
|
||||||
for i:=1 to 5 do
|
for i:=1 to 5 do
|
||||||
importssection^.concat(new(pai_const,init_32bit(0)));
|
importssection^.concat(new(pai_const,init_32bit(0))); }
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{$endif i386}
|
{$endif i386}
|
||||||
@ -845,6 +848,11 @@ unit pmodules;
|
|||||||
pu:=pused_unit(pu^.next);
|
pu:=pused_unit(pu^.next);
|
||||||
end;
|
end;
|
||||||
inc(datasize,symtablestack^.datasize);
|
inc(datasize,symtablestack^.datasize);
|
||||||
|
|
||||||
|
{ generate imports }
|
||||||
|
if current_module^.uses_imports then
|
||||||
|
importlib^.generatelib;
|
||||||
|
|
||||||
{ finish asmlist by adding segment starts }
|
{ finish asmlist by adding segment starts }
|
||||||
insertsegment;
|
insertsegment;
|
||||||
end;
|
end;
|
||||||
@ -967,7 +975,13 @@ unit pmodules;
|
|||||||
else
|
else
|
||||||
current_module^.linkofiles.insert(current_module^.objfilename^);
|
current_module^.linkofiles.insert(current_module^.objfilename^);
|
||||||
|
|
||||||
|
{ insert heap }
|
||||||
insertheap;
|
insertheap;
|
||||||
|
|
||||||
|
{ generate imports }
|
||||||
|
if current_module^.uses_imports then
|
||||||
|
importlib^.generatelib;
|
||||||
|
|
||||||
inserttargetspecific;
|
inserttargetspecific;
|
||||||
|
|
||||||
datasize:=symtablestack^.datasize;
|
datasize:=symtablestack^.datasize;
|
||||||
@ -979,7 +993,11 @@ unit pmodules;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.24 1998-06-08 13:13:44 pierre
|
Revision 1.25 1998-06-08 22:59:49 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.24 1998/06/08 13:13:44 pierre
|
||||||
+ temporary variables now in temp_gen.pas unit
|
+ temporary variables now in temp_gen.pas unit
|
||||||
because it is processor independent
|
because it is processor independent
|
||||||
* mppc68k.bat modified to undefine i386 and support_mmx
|
* mppc68k.bat modified to undefine i386 and support_mmx
|
||||||
@ -1000,8 +1018,6 @@ end.
|
|||||||
Revision 1.20 1998/06/04 09:55:42 pierre
|
Revision 1.20 1998/06/04 09:55:42 pierre
|
||||||
* demangled name of procsym reworked to become independant of the mangling scheme
|
* demangled name of procsym reworked to become independant of the mangling scheme
|
||||||
|
|
||||||
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
|
|
||||||
|
|
||||||
Revision 1.19 1998/06/03 23:40:38 peter
|
Revision 1.19 1998/06/03 23:40:38 peter
|
||||||
+ unlimited file support, release tempclose
|
+ unlimited file support, release tempclose
|
||||||
|
|
||||||
|
|||||||
@ -39,42 +39,42 @@ unit pstatmnt;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
cobjects,scanner,globals,symtable,aasm,pass_1,
|
cobjects,globals,files,verbose,systems,
|
||||||
types,hcodegen,files,verbose,systems
|
symtable,aasm,pass_1,types,scanner,hcodegen
|
||||||
{$ifdef NEWPPU}
|
{$ifdef NEWPPU}
|
||||||
,ppu
|
,ppu
|
||||||
{$endif}
|
{$endif}
|
||||||
{ processor specific stuff }
|
,pbase,pexpr,pdecl
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
,i386
|
,i386,tgeni386
|
||||||
|
{$ifndef NoRa386Int}
|
||||||
,rai386
|
,rai386
|
||||||
|
{$endif NoRa386Int}
|
||||||
|
{$ifndef NoRa386Att}
|
||||||
,ratti386
|
,ratti386
|
||||||
|
{$endif NoRa386Att}
|
||||||
|
{$ifndef NoRa386Dir}
|
||||||
,radi386
|
,radi386
|
||||||
,tgeni386
|
{$endif NoRa386Dir}
|
||||||
{$endif}
|
{$endif i386}
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
,m68k
|
,m68k,tgen68k
|
||||||
,tgen68k
|
{$ifndef NoRa68kMot}
|
||||||
,ag68kmit
|
|
||||||
,ra68k
|
,ra68k
|
||||||
,ag68kgas
|
{$endif NoRa68kMot}
|
||||||
,ag68kmot
|
{$endif m68k}
|
||||||
{$endif}
|
;
|
||||||
{ parser specific stuff, be careful consume is also defined to }
|
|
||||||
{ read assembler tokens }
|
|
||||||
,pbase,pexpr,pdecl;
|
|
||||||
|
|
||||||
const
|
const
|
||||||
|
|
||||||
statement_level : longint = 0;
|
statement_level : longint = 0;
|
||||||
|
|
||||||
function statement : ptree;forward;
|
function statement : ptree;forward;
|
||||||
|
|
||||||
function if_statement : ptree;
|
|
||||||
|
|
||||||
|
function if_statement : ptree;
|
||||||
var
|
var
|
||||||
ex,if_a,else_a : ptree;
|
ex,if_a,else_a : ptree;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
consume(_IF);
|
consume(_IF);
|
||||||
ex:=comp_expr(true);
|
ex:=comp_expr(true);
|
||||||
@ -257,6 +257,7 @@ unit pstatmnt;
|
|||||||
case_statement:=code;
|
case_statement:=code;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function repeat_statement : ptree;
|
function repeat_statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -293,6 +294,7 @@ unit pstatmnt;
|
|||||||
repeat_statement:=genloopnode(repeatn,p_e,first,nil,false);
|
repeat_statement:=genloopnode(repeatn,p_e,first,nil,false);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function while_statement : ptree;
|
function while_statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -306,6 +308,7 @@ unit pstatmnt;
|
|||||||
while_statement:=genloopnode(whilen,p_e,p_a,nil,false);
|
while_statement:=genloopnode(whilen,p_e,p_a,nil,false);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function for_statement : ptree;
|
function for_statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -334,6 +337,7 @@ unit pstatmnt;
|
|||||||
for_statement:=genloopnode(forn,p_e,tovalue,p_a,backward);
|
for_statement:=genloopnode(forn,p_e,tovalue,p_a,backward);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function _with_statement : ptree;
|
function _with_statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -434,6 +438,7 @@ unit pstatmnt;
|
|||||||
_with_statement:=genwithnode(withsymtable,p,right,levelcount);
|
_with_statement:=genwithnode(withsymtable,p,right,levelcount);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function with_statement : ptree;
|
function with_statement : ptree;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -441,6 +446,7 @@ unit pstatmnt;
|
|||||||
with_statement:=_with_statement;
|
with_statement:=_with_statement;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function raise_statement : ptree;
|
function raise_statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -467,6 +473,7 @@ unit pstatmnt;
|
|||||||
raise_statement:=gennode(raisen,p1,p2);
|
raise_statement:=gennode(raisen,p1,p2);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function try_statement : ptree;
|
function try_statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -558,6 +565,7 @@ unit pstatmnt;
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function exit_statement : ptree;
|
function exit_statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -581,11 +589,9 @@ unit pstatmnt;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{$ifdef i386}
|
|
||||||
function _asm_statement : ptree;
|
function _asm_statement : ptree;
|
||||||
|
var
|
||||||
var asm_stat : ptree;
|
asmstat : ptree;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if (aktprocsym^.definition^.options and poinline)<>0 then
|
if (aktprocsym^.definition^.options and poinline)<>0 then
|
||||||
Begin
|
Begin
|
||||||
@ -594,25 +600,38 @@ unit pstatmnt;
|
|||||||
aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
|
aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
|
||||||
End;
|
End;
|
||||||
case aktasmmode of
|
case aktasmmode of
|
||||||
I386_ATT : asm_stat:=ratti386.assemble;
|
{$ifdef i386}
|
||||||
I386_INTEL : asm_stat:=rai386.assemble;
|
{$ifndef NoRA386Att}
|
||||||
I386_DIRECT : asm_stat:=radi386.assemble;
|
I386_ATT : asmstat:=ratti386.assemble;
|
||||||
else internalerror(30004);
|
{$endif NoRA386Att}
|
||||||
|
{$ifndef NoRA386Int}
|
||||||
|
I386_INTEL : asmstat:=rai386.assemble;
|
||||||
|
{$endif NoRA386Int}
|
||||||
|
{$ifndef NoRA386Dir}
|
||||||
|
I386_DIRECT : asmstat:=radi386.assemble;
|
||||||
|
{$endif NoRA386Dir}
|
||||||
|
{$endif}
|
||||||
|
{$ifdef m68k}
|
||||||
|
{$ifndef NoRA68kMot}
|
||||||
|
M68K_MOT : asmstat:=ra68k.assemble;
|
||||||
|
{$endif NoRA68kMot}
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
Comment(V_Fatal,'Selected assembler reader not supported');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ Erst am Ende _ASM konsumieren, da der Scanner sonst die }
|
{ Read first the _ASM statement }
|
||||||
{ erste Assemblerstatement zu lesen versucht! }
|
|
||||||
consume(_ASM);
|
consume(_ASM);
|
||||||
|
|
||||||
{ (END is read) }
|
{ END is read }
|
||||||
if token=LECKKLAMMER then
|
if token=LECKKLAMMER then
|
||||||
begin
|
begin
|
||||||
{ it's possible to specify the modified registers }
|
{ it's possible to specify the modified registers }
|
||||||
consume(LECKKLAMMER);
|
consume(LECKKLAMMER);
|
||||||
asm_stat^.object_preserved:=true;
|
asmstat^.object_preserved:=true;
|
||||||
if token<>RECKKLAMMER then
|
if token<>RECKKLAMMER then
|
||||||
repeat
|
repeat
|
||||||
pattern:=upper(pattern);
|
{$ifdef i386}
|
||||||
if pattern='EAX' then
|
if pattern='EAX' then
|
||||||
usedinproc:=usedinproc or ($80 shr byte(R_EAX))
|
usedinproc:=usedinproc or ($80 shr byte(R_EAX))
|
||||||
else if pattern='EBX' then
|
else if pattern='EBX' then
|
||||||
@ -624,41 +643,12 @@ unit pstatmnt;
|
|||||||
else if pattern='ESI' then
|
else if pattern='ESI' then
|
||||||
begin
|
begin
|
||||||
usedinproc:=usedinproc or ($80 shr byte(R_ESI));
|
usedinproc:=usedinproc or ($80 shr byte(R_ESI));
|
||||||
asm_stat^.object_preserved:=false;
|
asmstat^.object_preserved:=false;
|
||||||
end
|
end
|
||||||
else if pattern='EDI' then
|
else if pattern='EDI' then
|
||||||
usedinproc:=usedinproc or ($80 shr byte(R_EDI))
|
usedinproc:=usedinproc or ($80 shr byte(R_EDI))
|
||||||
else consume(RECKKLAMMER);
|
{$endif i386}
|
||||||
consume(CSTRING);
|
|
||||||
if token=COMMA then consume(COMMA)
|
|
||||||
else break;
|
|
||||||
until false;
|
|
||||||
consume(RECKKLAMMER);
|
|
||||||
end
|
|
||||||
else usedinproc:=$ff;
|
|
||||||
_asm_statement:=asm_stat;
|
|
||||||
end;
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
function _asm_statement : ptree;
|
|
||||||
begin
|
|
||||||
_asm_statement:= ra68k.assemble;
|
|
||||||
{ Erst am Ende _ASM konsumieren, da der Scanner sonst die }
|
|
||||||
{ erste Assemblerstatement zu lesen versucht! }
|
|
||||||
consume(_ASM);
|
|
||||||
|
|
||||||
{ (END is read) }
|
|
||||||
if token=LECKKLAMMER then
|
|
||||||
begin
|
|
||||||
{ it's possible to specify the modified registers }
|
|
||||||
{ we only check the registers which are not reserved }
|
|
||||||
{ and which can be used. This is done for future }
|
|
||||||
{ optimizations. }
|
|
||||||
consume(LECKKLAMMER);
|
|
||||||
if token<>RECKKLAMMER then
|
|
||||||
repeat
|
|
||||||
pattern:=upper(pattern);
|
|
||||||
if pattern='D0' then
|
if pattern='D0' then
|
||||||
usedinproc:=usedinproc or ($800 shr word(R_D0))
|
usedinproc:=usedinproc or ($800 shr word(R_D0))
|
||||||
else if pattern='D1' then
|
else if pattern='D1' then
|
||||||
@ -669,6 +659,7 @@ unit pstatmnt;
|
|||||||
usedinproc:=usedinproc or ($800 shr word(R_A0))
|
usedinproc:=usedinproc or ($800 shr word(R_A0))
|
||||||
else if pattern='A1' then
|
else if pattern='A1' then
|
||||||
usedinproc:=usedinproc or ($800 shr word(R_A1))
|
usedinproc:=usedinproc or ($800 shr word(R_A1))
|
||||||
|
{$endif m68k}
|
||||||
else consume(RECKKLAMMER);
|
else consume(RECKKLAMMER);
|
||||||
consume(CSTRING);
|
consume(CSTRING);
|
||||||
if token=COMMA then consume(COMMA)
|
if token=COMMA then consume(COMMA)
|
||||||
@ -676,155 +667,153 @@ unit pstatmnt;
|
|||||||
until false;
|
until false;
|
||||||
consume(RECKKLAMMER);
|
consume(RECKKLAMMER);
|
||||||
end
|
end
|
||||||
else usedinproc:=$ffff;
|
else usedinproc:=$ff;
|
||||||
end;
|
_asm_statement:=asmstat;
|
||||||
{$endif}
|
end;
|
||||||
|
|
||||||
|
|
||||||
function new_dispose_statement : ptree;
|
function new_dispose_statement : ptree;
|
||||||
|
var
|
||||||
|
p,p2 : ptree;
|
||||||
|
ht : ttoken;
|
||||||
|
again : boolean; { dummy for do_proc_call }
|
||||||
|
destrukname : stringid;
|
||||||
|
sym : psym;
|
||||||
|
classh : pobjectdef;
|
||||||
|
pd,pd2 : pdef;
|
||||||
|
store_valid : boolean;
|
||||||
|
tt : ttreetyp;
|
||||||
|
begin
|
||||||
|
ht:=token;
|
||||||
|
if token=_NEW then consume(_NEW)
|
||||||
|
else consume(_DISPOSE);
|
||||||
|
if ht=_NEW then
|
||||||
|
tt:=hnewn
|
||||||
|
else
|
||||||
|
tt:=hdisposen;
|
||||||
|
consume(LKLAMMER);
|
||||||
|
p:=comp_expr(true);
|
||||||
|
|
||||||
var
|
{ calc return type }
|
||||||
p,p2 : ptree;
|
cleartempgen;
|
||||||
ht : ttoken;
|
Store_valid := Must_be_valid;
|
||||||
again : boolean; { dummy for do_proc_call }
|
Must_be_valid := False;
|
||||||
destrukname : stringid;
|
do_firstpass(p);
|
||||||
sym : psym;
|
Must_be_valid := Store_valid;
|
||||||
classh : pobjectdef;
|
|
||||||
pd,pd2 : pdef;
|
|
||||||
store_valid : boolean;
|
|
||||||
tt : ttreetyp;
|
|
||||||
|
|
||||||
begin
|
{var o:Pobject;
|
||||||
ht:=token;
|
begin
|
||||||
if token=_NEW then consume(_NEW)
|
new(o,init); (*Also a valid new statement*)
|
||||||
else consume(_DISPOSE);
|
end;}
|
||||||
if ht=_NEW then
|
|
||||||
tt:=hnewn
|
|
||||||
else
|
|
||||||
tt:=hdisposen;
|
|
||||||
consume(LKLAMMER);
|
|
||||||
p:=comp_expr(true);
|
|
||||||
|
|
||||||
{ calc return type }
|
if token=COMMA then
|
||||||
cleartempgen;
|
begin
|
||||||
Store_valid := Must_be_valid;
|
{ extended syntax of new and dispose }
|
||||||
Must_be_valid := False;
|
{ function styled new is handled in factor }
|
||||||
do_firstpass(p);
|
consume(COMMA);
|
||||||
Must_be_valid := Store_valid;
|
{ destructors have no parameters }
|
||||||
|
destrukname:=pattern;
|
||||||
|
consume(ID);
|
||||||
|
|
||||||
{var o:Pobject;
|
pd:=p^.resulttype;
|
||||||
|
pd2:=pd;
|
||||||
|
if (p^.resulttype = nil) or (pd^.deftype<>pointerdef) then
|
||||||
|
begin
|
||||||
|
Message(parser_e_pointer_type_expected);
|
||||||
|
p:=factor(false);
|
||||||
|
consume(RKLAMMER);
|
||||||
|
new_dispose_statement:=genzeronode(errorn);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ first parameter must be an object or class }
|
||||||
|
if ppointerdef(pd)^.definition^.deftype<>objectdef then
|
||||||
|
begin
|
||||||
|
Message(parser_e_pointer_to_class_expected);
|
||||||
|
new_dispose_statement:=factor(false);
|
||||||
|
consume_all_until(RKLAMMER);
|
||||||
|
consume(RKLAMMER);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ check, if the first parameter is a pointer to a _class_ }
|
||||||
|
classh:=pobjectdef(ppointerdef(pd)^.definition);
|
||||||
|
if (classh^.options and oois_class)<>0 then
|
||||||
|
begin
|
||||||
|
Message(parser_e_no_new_or_dispose_for_classes);
|
||||||
|
new_dispose_statement:=factor(false);
|
||||||
|
{ while token<>RKLAMMER do
|
||||||
|
consume(token); }
|
||||||
|
consume_all_until(RKLAMMER);
|
||||||
|
consume(RKLAMMER);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ search cons-/destructor, also in parent classes }
|
||||||
|
sym:=nil;
|
||||||
|
while assigned(classh) do
|
||||||
|
begin
|
||||||
|
sym:=classh^.publicsyms^.search(pattern);
|
||||||
|
srsymtable:=classh^.publicsyms;
|
||||||
|
if assigned(sym) then
|
||||||
|
break;
|
||||||
|
classh:=classh^.childof;
|
||||||
|
end;
|
||||||
|
{ the second parameter of new/dispose must be a call }
|
||||||
|
{ to a cons-/destructor }
|
||||||
|
if (sym^.typ<>procsym) then
|
||||||
|
begin
|
||||||
|
Message(parser_e_expr_have_to_be_destructor_call);
|
||||||
|
new_dispose_statement:=genzeronode(errorn);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
p2:=gensinglenode(tt,p);
|
||||||
|
if ht=_NEW then
|
||||||
|
begin
|
||||||
|
{ Constructors can take parameters.}
|
||||||
|
p2^.resulttype:=ppointerdef(pd)^.definition;
|
||||||
|
do_member_read(sym,p2,pd,again);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{ destructors can't.}
|
||||||
|
p2:=genmethodcallnode(pprocsym(sym),srsymtable,p2);
|
||||||
|
|
||||||
begin
|
{ we need the real called method }
|
||||||
new(o,init); (*Also a valid new statement*)
|
cleartempgen;
|
||||||
end;}
|
do_firstpass(p2);
|
||||||
|
|
||||||
if token=COMMA then
|
if (ht=_NEW) and ((p2^.procdefinition^.options and poconstructor)=0) then
|
||||||
begin
|
Message(parser_e_expr_have_to_be_constructor_call);
|
||||||
{ extended syntax of new and dispose }
|
if (ht=_DISPOSE) and ((p2^.procdefinition^.options and podestructor)=0) then
|
||||||
{ function styled new is handled in factor }
|
Message(parser_e_expr_have_to_be_destructor_call);
|
||||||
consume(COMMA);
|
|
||||||
{ destructors have no parameters }
|
|
||||||
destrukname:=pattern;
|
|
||||||
consume(ID);
|
|
||||||
|
|
||||||
pd:=p^.resulttype;
|
if ht=_NEW then
|
||||||
pd2:=pd;
|
begin
|
||||||
if (p^.resulttype = nil) or (pd^.deftype<>pointerdef) then
|
p2:=gennode(assignn,getcopy(p),gensinglenode(newn,p2));
|
||||||
begin
|
p2^.right^.resulttype:=pd2;
|
||||||
Message(parser_e_pointer_type_expected);
|
end;
|
||||||
p:=factor(false);
|
new_dispose_statement:=p2;
|
||||||
consume(RKLAMMER);
|
end;
|
||||||
new_dispose_statement:=genzeronode(errorn);
|
end
|
||||||
exit;
|
else
|
||||||
end;
|
begin
|
||||||
{ first parameter must be an object or class }
|
if (p^.resulttype=nil) or (p^.resulttype^.deftype<>pointerdef) then
|
||||||
if ppointerdef(pd)^.definition^.deftype<>objectdef then
|
Begin
|
||||||
begin
|
Message(parser_e_pointer_type_expected);
|
||||||
Message(parser_e_pointer_to_class_expected);
|
new_dispose_statement:=genzeronode(errorn);
|
||||||
new_dispose_statement:=factor(false);
|
end
|
||||||
consume_all_until(RKLAMMER);
|
else
|
||||||
consume(RKLAMMER);
|
begin
|
||||||
exit;
|
if (ppointerdef(p^.resulttype)^.definition^.deftype=objectdef) then
|
||||||
end;
|
Message(parser_w_use_extended_syntax_for_objects);
|
||||||
{ check, if the first parameter is a pointer to a _class_ }
|
|
||||||
classh:=pobjectdef(ppointerdef(pd)^.definition);
|
|
||||||
if (classh^.options and oois_class)<>0 then
|
|
||||||
begin
|
|
||||||
Message(parser_e_no_new_or_dispose_for_classes);
|
|
||||||
new_dispose_statement:=factor(false);
|
|
||||||
{ while token<>RKLAMMER do
|
|
||||||
consume(token); }
|
|
||||||
consume_all_until(RKLAMMER);
|
|
||||||
consume(RKLAMMER);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
{ search cons-/destructor, also in parent classes }
|
|
||||||
sym:=nil;
|
|
||||||
while assigned(classh) do
|
|
||||||
begin
|
|
||||||
sym:=classh^.publicsyms^.search(pattern);
|
|
||||||
srsymtable:=classh^.publicsyms;
|
|
||||||
if assigned(sym) then
|
|
||||||
break;
|
|
||||||
classh:=classh^.childof;
|
|
||||||
end;
|
|
||||||
{ the second parameter of new/dispose must be a call }
|
|
||||||
{ to a cons-/destructor }
|
|
||||||
if (sym^.typ<>procsym) then
|
|
||||||
begin
|
|
||||||
Message(parser_e_expr_have_to_be_destructor_call);
|
|
||||||
new_dispose_statement:=genzeronode(errorn);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
p2:=gensinglenode(tt,p);
|
|
||||||
if ht=_NEW then
|
|
||||||
begin
|
|
||||||
{ Constructors can take parameters.}
|
|
||||||
p2^.resulttype:=ppointerdef(pd)^.definition;
|
|
||||||
do_member_read(sym,p2,pd,again);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
{ destructors can't.}
|
|
||||||
p2:=genmethodcallnode(pprocsym(sym),srsymtable,p2);
|
|
||||||
|
|
||||||
{ we need the real called method }
|
case ht of
|
||||||
cleartempgen;
|
_NEW : new_dispose_statement:=gensinglenode(simplenewn,p);
|
||||||
do_firstpass(p2);
|
_DISPOSE : new_dispose_statement:=gensinglenode(simpledisposen,p);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
consume(RKLAMMER);
|
||||||
|
end;
|
||||||
|
|
||||||
if (ht=_NEW) and ((p2^.procdefinition^.options and poconstructor)=0) then
|
|
||||||
Message(parser_e_expr_have_to_be_constructor_call);
|
|
||||||
if (ht=_DISPOSE) and ((p2^.procdefinition^.options and podestructor)=0) then
|
|
||||||
Message(parser_e_expr_have_to_be_destructor_call);
|
|
||||||
|
|
||||||
if ht=_NEW then
|
|
||||||
begin
|
|
||||||
p2:=gennode(assignn,getcopy(p),gensinglenode(newn,p2));
|
|
||||||
p2^.right^.resulttype:=pd2;
|
|
||||||
end;
|
|
||||||
new_dispose_statement:=p2;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if (p^.resulttype=nil) or (p^.resulttype^.deftype<>pointerdef) then
|
|
||||||
Begin
|
|
||||||
Message(parser_e_pointer_type_expected);
|
|
||||||
new_dispose_statement:=genzeronode(errorn);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if (ppointerdef(p^.resulttype)^.definition^.deftype=objectdef) then
|
|
||||||
Message(parser_w_use_extended_syntax_for_objects);
|
|
||||||
|
|
||||||
case ht of
|
|
||||||
_NEW : new_dispose_statement:=gensinglenode(simplenewn,p);
|
|
||||||
_DISPOSE : new_dispose_statement:=gensinglenode(simpledisposen,p);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
consume(RKLAMMER);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function statement_block : ptree;
|
function statement_block : ptree;
|
||||||
|
|
||||||
@ -874,6 +863,7 @@ unit pstatmnt;
|
|||||||
statement_block:=last;
|
statement_block:=last;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function statement : ptree;
|
function statement : ptree;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -1146,15 +1136,17 @@ unit pstatmnt;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.18 1998-06-05 14:37:35 pierre
|
Revision 1.19 1998-06-08 22:59:50 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.18 1998/06/05 14:37:35 pierre
|
||||||
* fixes for inline for operators
|
* fixes for inline for operators
|
||||||
* inline procedure more correctly restricted
|
* inline procedure more correctly restricted
|
||||||
|
|
||||||
Revision 1.17 1998/06/04 09:55:43 pierre
|
Revision 1.17 1998/06/04 09:55:43 pierre
|
||||||
* demangled name of procsym reworked to become independant of the mangling scheme
|
* demangled name of procsym reworked to become independant of the mangling scheme
|
||||||
|
|
||||||
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
|
|
||||||
|
|
||||||
Revision 1.16 1998/06/02 17:03:04 pierre
|
Revision 1.16 1998/06/02 17:03:04 pierre
|
||||||
* with node corrected for objects
|
* with node corrected for objects
|
||||||
* small bugs for SUPPORT_MMX fixed
|
* small bugs for SUPPORT_MMX fixed
|
||||||
|
|||||||
@ -156,52 +156,56 @@ unit ptconst;
|
|||||||
if p^.treetype=niln then
|
if p^.treetype=niln then
|
||||||
datasegment^.concat(new(pai_const,init_32bit(0)))
|
datasegment^.concat(new(pai_const,init_32bit(0)))
|
||||||
{ maybe pchar ? }
|
{ maybe pchar ? }
|
||||||
else if (ppointerdef(def)^.definition^.deftype=orddef) and
|
else
|
||||||
|
if (ppointerdef(def)^.definition^.deftype=orddef) and
|
||||||
(porddef(ppointerdef(def)^.definition)^.typ=uchar) then
|
(porddef(ppointerdef(def)^.definition)^.typ=uchar) then
|
||||||
begin
|
begin
|
||||||
getlabel(ll);
|
getlabel(ll);
|
||||||
{ insert string at the begin }
|
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
|
||||||
if p^.treetype=stringconstn then
|
datasegment^.concat(new(pai_label,init(ll)));
|
||||||
generate_ascii_insert((p^.values^)+#0)
|
{ insert string at the begin }
|
||||||
else if is_constcharnode(p) then
|
if p^.treetype=stringconstn then
|
||||||
datasegment^.insert(new(pai_string,init(char(byte(p^.value))+#0)))
|
datasegment^.concat(new(pai_string,init(p^.values^+#0)))
|
||||||
else Message(cg_e_illegal_expression);
|
else
|
||||||
datasegment^.insert(new(pai_label,init(ll)));
|
if is_constcharnode(p) then
|
||||||
{ insert label }
|
datasegment^.concat(new(pai_string,init(char(byte(p^.value))+#0)))
|
||||||
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
|
else
|
||||||
|
Message(cg_e_illegal_expression);
|
||||||
|
{ insert label }
|
||||||
end
|
end
|
||||||
else if p^.treetype=addrn then
|
else
|
||||||
begin
|
if p^.treetype=addrn then
|
||||||
if (is_equal(ppointerdef(p^.resulttype)^.definition,ppointerdef(def)^.definition) or
|
begin
|
||||||
(is_equal(ppointerdef(p^.resulttype)^.definition,voiddef)) or
|
if (is_equal(ppointerdef(p^.resulttype)^.definition,ppointerdef(def)^.definition) or
|
||||||
(is_equal(ppointerdef(def)^.definition,voiddef))) and
|
(is_equal(ppointerdef(p^.resulttype)^.definition,voiddef)) or
|
||||||
(p^.left^.treetype = loadn) then
|
(is_equal(ppointerdef(def)^.definition,voiddef))) and
|
||||||
begin
|
(p^.left^.treetype = loadn) then
|
||||||
|
begin
|
||||||
datasegment^.concat(new(pai_const,init_symbol(
|
datasegment^.concat(new(pai_const,init_symbol(
|
||||||
strpnew(p^.left^.symtableentry^.mangledname))));
|
strpnew(p^.left^.symtableentry^.mangledname))));
|
||||||
maybe_concat_external(p^.left^.symtableentry^.owner,
|
maybe_concat_external(p^.left^.symtableentry^.owner,
|
||||||
p^.left^.symtableentry^.mangledname);
|
p^.left^.symtableentry^.mangledname);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
Message(cg_e_illegal_expression);
|
Message(cg_e_illegal_expression);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
{ allow typeof(Object type)}
|
{ allow typeof(Object type)}
|
||||||
if (p^.treetype=inlinen) and
|
if (p^.treetype=inlinen) and
|
||||||
(p^.inlinenumber=in_typeof_x) then
|
(p^.inlinenumber=in_typeof_x) then
|
||||||
if (p^.left^.treetype=typen) then
|
begin
|
||||||
begin
|
if (p^.left^.treetype=typen) then
|
||||||
datasegment^.concat(new(pai_const,init_symbol(
|
begin
|
||||||
strpnew(pobjectdef(p^.left^.resulttype)^.vmt_mangledname))));
|
datasegment^.concat(new(pai_const,init_symbol(
|
||||||
if pobjectdef(p^.left^.resulttype)^.owner^.symtabletype=unitsymtable then
|
strpnew(pobjectdef(p^.left^.resulttype)^.vmt_mangledname))));
|
||||||
|
if pobjectdef(p^.left^.resulttype)^.owner^.symtabletype=unitsymtable then
|
||||||
concat_external(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,EXT_NEAR);
|
concat_external(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,EXT_NEAR);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
Message(cg_e_illegal_expression);
|
||||||
Message(cg_e_illegal_expression);
|
end
|
||||||
end
|
else
|
||||||
else
|
Message(cg_e_illegal_expression);
|
||||||
Message(cg_e_illegal_expression);
|
|
||||||
disposetree(p);
|
disposetree(p);
|
||||||
end;
|
end;
|
||||||
setdef:
|
setdef:
|
||||||
@ -215,9 +219,8 @@ unit ptconst;
|
|||||||
Message(cg_e_illegal_expression)
|
Message(cg_e_illegal_expression)
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
for l:=0 to def^.savesize-1 do
|
for l:=0 to def^.savesize-1 do
|
||||||
datasegment^.concat(
|
datasegment^.concat(new(pai_const,init_8bit(p^.constset^[l])));
|
||||||
new(pai_const,init_8bit(p^.constset^[l])));
|
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
@ -225,15 +228,13 @@ unit ptconst;
|
|||||||
disposetree(p);
|
disposetree(p);
|
||||||
end;
|
end;
|
||||||
enumdef:
|
enumdef:
|
||||||
begin
|
begin
|
||||||
p:=comp_expr(true);
|
p:=comp_expr(true);
|
||||||
do_firstpass(p);
|
do_firstpass(p);
|
||||||
if p^.treetype=ordconstn then
|
if p^.treetype=ordconstn then
|
||||||
begin
|
begin
|
||||||
if is_equal(p^.resulttype,def) then
|
if is_equal(p^.resulttype,def) then
|
||||||
begin
|
datasegment^.concat(new(pai_const,init_32bit(p^.value)))
|
||||||
datasegment^.concat(new(pai_const,init_32bit(p^.value)));
|
|
||||||
end
|
|
||||||
else
|
else
|
||||||
Message(cg_e_illegal_expression);
|
Message(cg_e_illegal_expression);
|
||||||
end
|
end
|
||||||
@ -450,7 +451,11 @@ unit ptconst;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.5 1998-06-03 22:49:01 peter
|
Revision 1.6 1998-06-08 22:59:52 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.5 1998/06/03 22:49:01 peter
|
||||||
+ wordbool,longbool
|
+ wordbool,longbool
|
||||||
* rename bis,von -> high,low
|
* rename bis,von -> high,low
|
||||||
* moved some systemunit loading/creating to psystem.pas
|
* moved some systemunit loading/creating to psystem.pas
|
||||||
@ -467,77 +472,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/04/07 13:19:48 pierre
|
|
||||||
* bugfixes for reset_gdb_info
|
|
||||||
in MEM parsing for go32v2
|
|
||||||
better external symbol creation
|
|
||||||
support for rhgdb.exe (lowercase file names)
|
|
||||||
|
|
||||||
Revision 1.1.1.1 1998/03/25 11:18:15 root
|
|
||||||
* Restored version
|
|
||||||
|
|
||||||
Revision 1.13 1998/03/20 23:31:35 florian
|
|
||||||
* bug0113 fixed
|
|
||||||
* problem with interdepened units fixed ("options.pas problem")
|
|
||||||
* two small extensions for future AMD 3D support
|
|
||||||
|
|
||||||
Revision 1.12 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.11 1998/03/13 22:45:59 florian
|
|
||||||
* small bug fixes applied
|
|
||||||
|
|
||||||
Revision 1.10 1998/03/11 11:23:57 florian
|
|
||||||
* bug0081 and bug0109 fixed
|
|
||||||
|
|
||||||
Revision 1.9 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.8 1998/03/06 00:52:50 peter
|
|
||||||
* replaced all old messages from errore.msg, only ExtDebug and some
|
|
||||||
Comment() calls are left
|
|
||||||
* fixed options.pas
|
|
||||||
|
|
||||||
Revision 1.7 1998/03/02 01:49:10 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:33 daniel
|
|
||||||
* Made Motorola version compilable.
|
|
||||||
* Fixed optimizer
|
|
||||||
|
|
||||||
Revision 1.5 1998/02/12 11:50:32 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.4 1998/01/24 23:08:19 carl
|
|
||||||
+ compile time range checking should logically always be on!
|
|
||||||
|
|
||||||
Revision 1.3 1998/01/23 17:12:20 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.2 1998/01/09 09:10:03 michael
|
|
||||||
+ Initial implementation, second try
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
@ -1269,10 +1269,10 @@
|
|||||||
|
|
||||||
procedure ttypedconstsym.really_insert_in_data;
|
procedure ttypedconstsym.really_insert_in_data;
|
||||||
begin
|
begin
|
||||||
if (cs_smartlink in aktswitches) then
|
|
||||||
datasegment^.concat(new(pai_cut,init));
|
|
||||||
if owner^.symtabletype=globalsymtable then
|
if owner^.symtabletype=globalsymtable then
|
||||||
begin
|
begin
|
||||||
|
if (cs_smartlink in aktswitches) then
|
||||||
|
datasegment^.concat(new(pai_cut,init));
|
||||||
{$ifdef GDB}
|
{$ifdef GDB}
|
||||||
if cs_debuginfo in aktswitches then
|
if cs_debuginfo in aktswitches then
|
||||||
concatstabto(datasegment);
|
concatstabto(datasegment);
|
||||||
@ -1282,6 +1282,8 @@
|
|||||||
else
|
else
|
||||||
if owner^.symtabletype<>unitsymtable then
|
if owner^.symtabletype<>unitsymtable then
|
||||||
begin
|
begin
|
||||||
|
if (cs_smartlink in aktswitches) then
|
||||||
|
datasegment^.concat(new(pai_cut,init));
|
||||||
{$ifdef GDB}
|
{$ifdef GDB}
|
||||||
if cs_debuginfo in aktswitches then
|
if cs_debuginfo in aktswitches then
|
||||||
concatstabto(datasegment);
|
concatstabto(datasegment);
|
||||||
@ -1692,7 +1694,11 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.5 1998-06-04 23:52:02 peter
|
Revision 1.6 1998-06-08 22:59:53 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.5 1998/06/04 23:52:02 peter
|
||||||
* m68k compiles
|
* m68k compiles
|
||||||
+ .def file creation moved to gendef.pas so it could also be used
|
+ .def file creation moved to gendef.pas so it could also be used
|
||||||
for win32
|
for win32
|
||||||
@ -1700,8 +1706,6 @@
|
|||||||
Revision 1.4 1998/06/04 09:55:46 pierre
|
Revision 1.4 1998/06/04 09:55:46 pierre
|
||||||
* demangled name of procsym reworked to become independant of the mangling scheme
|
* demangled name of procsym reworked to become independant of the mangling scheme
|
||||||
|
|
||||||
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
|
|
||||||
|
|
||||||
Revision 1.3 1998/06/03 22:14:20 florian
|
Revision 1.3 1998/06/03 22:14:20 florian
|
||||||
* problem with sizes of classes fixed (if the anchestor was declared
|
* problem with sizes of classes fixed (if the anchestor was declared
|
||||||
forward, the compiler doesn't update the child classes size)
|
forward, the compiler doesn't update the child classes size)
|
||||||
|
|||||||
@ -76,6 +76,15 @@ unit systems;
|
|||||||
{$endif}
|
{$endif}
|
||||||
);
|
);
|
||||||
|
|
||||||
|
tar = (
|
||||||
|
{$ifdef i386}
|
||||||
|
ar_ar,ar_arw
|
||||||
|
{$endif}
|
||||||
|
{$ifdef m68k}
|
||||||
|
ar_ar
|
||||||
|
{$endif}
|
||||||
|
);
|
||||||
|
|
||||||
|
|
||||||
tos = (
|
tos = (
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
@ -127,6 +136,11 @@ unit systems;
|
|||||||
libprefix : string[2];
|
libprefix : string[2];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
tarinfo = record
|
||||||
|
arbin : string[8];
|
||||||
|
arcmd : string[50];
|
||||||
|
end;
|
||||||
|
|
||||||
ttargetinfo = record
|
ttargetinfo = record
|
||||||
target : ttarget;
|
target : ttarget;
|
||||||
short_name : string[8];
|
short_name : string[8];
|
||||||
@ -141,6 +155,7 @@ unit systems;
|
|||||||
os : tos;
|
os : tos;
|
||||||
link : tlink;
|
link : tlink;
|
||||||
assem : tasm;
|
assem : tasm;
|
||||||
|
ar : tar;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
tasmmodeinfo=record
|
tasmmodeinfo=record
|
||||||
@ -153,6 +168,7 @@ unit systems;
|
|||||||
target_os : tosinfo;
|
target_os : tosinfo;
|
||||||
target_asm : tasminfo;
|
target_asm : tasminfo;
|
||||||
target_link : tlinkinfo;
|
target_link : tlinkinfo;
|
||||||
|
target_ar : tarinfo;
|
||||||
source_os : tosinfo;
|
source_os : tosinfo;
|
||||||
|
|
||||||
function set_string_target(const s : string) : boolean;
|
function set_string_target(const s : string) : boolean;
|
||||||
@ -168,7 +184,6 @@ implementation
|
|||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
os_infos : array[tos] of tosinfo = (
|
os_infos : array[tos] of tosinfo = (
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
|
|
||||||
(
|
(
|
||||||
name : 'GO32 V1 DOS extender';
|
name : 'GO32 V1 DOS extender';
|
||||||
sharedlibext : '.DLL';
|
sharedlibext : '.DLL';
|
||||||
@ -234,8 +249,7 @@ implementation
|
|||||||
endian : endian_little;
|
endian : endian_little;
|
||||||
use_function_relative_addresses : true
|
use_function_relative_addresses : true
|
||||||
)
|
)
|
||||||
{$endif i386}
|
{$endif i386}
|
||||||
|
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
(
|
(
|
||||||
name : 'Commodore Amiga';
|
name : 'Commodore Amiga';
|
||||||
@ -291,7 +305,7 @@ implementation
|
|||||||
)
|
)
|
||||||
{$endif m68k}
|
{$endif m68k}
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
Assembler Info
|
Assembler Info
|
||||||
@ -493,8 +507,29 @@ implementation
|
|||||||
inputend : ')';
|
inputend : ')';
|
||||||
libprefix : '-l'
|
libprefix : '-l'
|
||||||
)
|
)
|
||||||
{$endif m68k}
|
{$endif m68k}
|
||||||
|
);
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Ar Info
|
||||||
|
****************************************************************************}
|
||||||
|
ar_infos : array[tar] of tarinfo = (
|
||||||
|
{$ifdef i386}
|
||||||
|
(
|
||||||
|
arbin : 'ar';
|
||||||
|
arcmd : 'rs $LIB $FILES'
|
||||||
|
),
|
||||||
|
(
|
||||||
|
arbin : 'arw';
|
||||||
|
arcmd : 'rs $LIB $FILES'
|
||||||
|
)
|
||||||
|
{$endif i386}
|
||||||
|
{$ifdef m68k}
|
||||||
|
(
|
||||||
|
arbin : 'ar';
|
||||||
|
arcmd : 'rs $LIB $FILES'
|
||||||
|
)
|
||||||
|
{$endif m68k}
|
||||||
);
|
);
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
@ -502,7 +537,6 @@ implementation
|
|||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
target_infos : array[ttarget] of ttargetinfo = (
|
target_infos : array[ttarget] of ttargetinfo = (
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
|
|
||||||
(
|
(
|
||||||
target : target_GO32V1;
|
target : target_GO32V1;
|
||||||
short_name : 'GO32V1';
|
short_name : 'GO32V1';
|
||||||
@ -516,7 +550,8 @@ implementation
|
|||||||
exeext : ''; { The linker procedures a.out }
|
exeext : ''; { The linker procedures a.out }
|
||||||
os : os_GO32V1;
|
os : os_GO32V1;
|
||||||
link : link_ldgo32v1;
|
link : link_ldgo32v1;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
),
|
),
|
||||||
(
|
(
|
||||||
target : target_GO32V2;
|
target : target_GO32V2;
|
||||||
@ -540,7 +575,8 @@ implementation
|
|||||||
{$endif UseAnsiString}
|
{$endif UseAnsiString}
|
||||||
os : os_GO32V2;
|
os : os_GO32V2;
|
||||||
link : link_ldgo32v2;
|
link : link_ldgo32v2;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
),
|
),
|
||||||
(
|
(
|
||||||
target : target_LINUX;
|
target : target_LINUX;
|
||||||
@ -555,7 +591,8 @@ implementation
|
|||||||
exeext : '';
|
exeext : '';
|
||||||
os : os_Linux;
|
os : os_Linux;
|
||||||
link : link_ld;
|
link : link_ld;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
),
|
),
|
||||||
(
|
(
|
||||||
target : target_OS2;
|
target : target_OS2;
|
||||||
@ -570,7 +607,8 @@ implementation
|
|||||||
exeext : ''; { The linker procedures a.out }
|
exeext : ''; { The linker procedures a.out }
|
||||||
os : os_OS2;
|
os : os_OS2;
|
||||||
link : link_ldos2;
|
link : link_ldos2;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
),
|
),
|
||||||
(
|
(
|
||||||
target : target_WIN32;
|
target : target_WIN32;
|
||||||
@ -585,10 +623,10 @@ implementation
|
|||||||
exeext : '.exe';
|
exeext : '.exe';
|
||||||
os : os_Win32;
|
os : os_Win32;
|
||||||
link : link_ldw;
|
link : link_ldw;
|
||||||
assem : as_asw
|
assem : as_asw;
|
||||||
|
ar : ar_arw
|
||||||
)
|
)
|
||||||
{$endif i386}
|
{$endif i386}
|
||||||
|
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
(
|
(
|
||||||
target : target_Amiga;
|
target : target_Amiga;
|
||||||
@ -603,7 +641,8 @@ implementation
|
|||||||
exeext : '';
|
exeext : '';
|
||||||
os : os_Amiga;
|
os : os_Amiga;
|
||||||
link : link_ld;
|
link : link_ld;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
),
|
),
|
||||||
(
|
(
|
||||||
target : target_Atari;
|
target : target_Atari;
|
||||||
@ -618,7 +657,8 @@ implementation
|
|||||||
exeext : '';
|
exeext : '';
|
||||||
os : os_Atari;
|
os : os_Atari;
|
||||||
link : link_ld;
|
link : link_ld;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
),
|
),
|
||||||
(
|
(
|
||||||
target : target_Mac68k;
|
target : target_Mac68k;
|
||||||
@ -633,7 +673,8 @@ implementation
|
|||||||
exeext : '';
|
exeext : '';
|
||||||
os : os_Mac68k;
|
os : os_Mac68k;
|
||||||
link : link_ld;
|
link : link_ld;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
),
|
),
|
||||||
(
|
(
|
||||||
target : target_Linux;
|
target : target_Linux;
|
||||||
@ -648,7 +689,8 @@ implementation
|
|||||||
exeext : '';
|
exeext : '';
|
||||||
os : os_Linux;
|
os : os_Linux;
|
||||||
link : link_ld;
|
link : link_ld;
|
||||||
assem : as_o
|
assem : as_o;
|
||||||
|
ar : ar_ar
|
||||||
)
|
)
|
||||||
{$endif m68k}
|
{$endif m68k}
|
||||||
);
|
);
|
||||||
@ -689,6 +731,7 @@ begin
|
|||||||
target_os:=os_infos[target_info.os];
|
target_os:=os_infos[target_info.os];
|
||||||
target_asm:=as_infos[target_info.assem];
|
target_asm:=as_infos[target_info.assem];
|
||||||
target_link:=link_infos[target_info.link];
|
target_link:=link_infos[target_info.link];
|
||||||
|
target_ar:=ar_infos[target_info.ar];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -757,19 +800,15 @@ begin
|
|||||||
{$ifdef GO32V2}
|
{$ifdef GO32V2}
|
||||||
default_os(target_GO32V2);
|
default_os(target_GO32V2);
|
||||||
{$else}
|
{$else}
|
||||||
|
|
||||||
{$ifdef OS2}
|
{$ifdef OS2}
|
||||||
default_os(target_OS2);
|
default_os(target_OS2);
|
||||||
{$else}
|
{$else}
|
||||||
|
|
||||||
{$ifdef LINUX}
|
{$ifdef LINUX}
|
||||||
default_os(target_LINUX);
|
default_os(target_LINUX);
|
||||||
{$else}
|
{$else}
|
||||||
|
|
||||||
{$ifdef WIN32}
|
{$ifdef WIN32}
|
||||||
default_os(target_WIN32);
|
default_os(target_WIN32);
|
||||||
{$else}
|
{$else}
|
||||||
|
|
||||||
default_os(target_GO32V2);
|
default_os(target_GO32V2);
|
||||||
{$endif win32}
|
{$endif win32}
|
||||||
{$endif linux}
|
{$endif linux}
|
||||||
@ -781,14 +820,12 @@ begin
|
|||||||
{$ifdef AMIGA}
|
{$ifdef AMIGA}
|
||||||
default_os(target_Amiga);
|
default_os(target_Amiga);
|
||||||
{$else}
|
{$else}
|
||||||
|
|
||||||
{$ifdef ATARI}
|
{$ifdef ATARI}
|
||||||
default_os(target_Atari);
|
default_os(target_Atari);
|
||||||
{$else}
|
{$else}
|
||||||
{$ifdef MACOS}
|
{$ifdef MACOS}
|
||||||
default_os(target_MAC68k);
|
default_os(target_MAC68k);
|
||||||
{$else}
|
{$else}
|
||||||
|
|
||||||
default_os(target_Amiga);
|
default_os(target_Amiga);
|
||||||
{$endif macos}
|
{$endif macos}
|
||||||
{$endif atari}
|
{$endif atari}
|
||||||
@ -797,7 +834,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.17 1998-06-04 23:52:04 peter
|
Revision 1.18 1998-06-08 22:59:54 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.17 1998/06/04 23:52:04 peter
|
||||||
* m68k compiles
|
* m68k compiles
|
||||||
+ .def file creation moved to gendef.pas so it could also be used
|
+ .def file creation moved to gendef.pas so it could also be used
|
||||||
for win32
|
for win32
|
||||||
|
|||||||
@ -39,6 +39,9 @@ unit win_targ;
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
aasm,files,strings,globals,cobjects
|
aasm,files,strings,globals,cobjects
|
||||||
|
{$ifdef GDB}
|
||||||
|
,gdb
|
||||||
|
{$endif}
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
,i386
|
,i386
|
||||||
{$endif}
|
{$endif}
|
||||||
@ -83,42 +86,48 @@ unit win_targ;
|
|||||||
hp2 : pimported_procedure;
|
hp2 : pimported_procedure;
|
||||||
l1,l2,l3,l4 : plabel;
|
l1,l2,l3,l4 : plabel;
|
||||||
r : preference;
|
r : preference;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
hp1:=pimportlist(current_module^.imports^.first);
|
hp1:=pimportlist(current_module^.imports^.first);
|
||||||
while assigned(hp1) do
|
while assigned(hp1) do
|
||||||
begin
|
begin
|
||||||
|
{ Insert cuts for smartlinking }
|
||||||
|
if (cs_smartlink in aktswitches) then
|
||||||
|
begin
|
||||||
|
importssection^.concat(new(pai_cut,init));
|
||||||
|
codesegment^.concat(new(pai_cut,init));
|
||||||
|
end;
|
||||||
|
{$IfDef GDB}
|
||||||
|
if (cs_debuginfo in aktswitches) then
|
||||||
|
codesegment^.concat(new(pai_stab_function_name,init(nil)));
|
||||||
|
{$EndIf GDB}
|
||||||
|
|
||||||
|
{ Get labels for the sections }
|
||||||
getlabel(l1);
|
getlabel(l1);
|
||||||
getlabel(l2);
|
getlabel(l2);
|
||||||
getlabel(l3);
|
getlabel(l3);
|
||||||
{ create import directory entry }
|
|
||||||
importssection^.concat(new(pai_section,init_idata(2)));
|
importssection^.concat(new(pai_section,init_idata(2)));
|
||||||
{ pointer to procedure names }
|
{ pointer to procedure names }
|
||||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str
|
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l2)))));
|
||||||
(l2)))));
|
|
||||||
{ two empty entries follow }
|
{ two empty entries follow }
|
||||||
importssection^.concat(new(pai_const,init_32bit(0)));
|
importssection^.concat(new(pai_const,init_32bit(0)));
|
||||||
importssection^.concat(new(pai_const,init_32bit(0)));
|
importssection^.concat(new(pai_const,init_32bit(0)));
|
||||||
{ pointer to dll name }
|
{ pointer to dll name }
|
||||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str
|
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l1)))));
|
||||||
(l1)))));
|
|
||||||
{ pointer to fixups }
|
{ pointer to fixups }
|
||||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str
|
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l3)))));
|
||||||
(l3)))));
|
|
||||||
|
|
||||||
{ now walk through all imported procedures }
|
{ only create one section for each else it will
|
||||||
{ we could that do in one while loop, but }
|
create a lot of idata* }
|
||||||
{ this would give too much idata* entries }
|
|
||||||
|
|
||||||
{ first write the name references }
|
{ first write the name references }
|
||||||
importssection^.concat(new(pai_section,init_idata(4)));
|
importssection^.concat(new(pai_section,init_idata(4)));
|
||||||
importssection^.concat(new(pai_label,init(l2)));
|
importssection^.concat(new(pai_label,init(l2)));
|
||||||
|
|
||||||
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
||||||
while assigned(hp2) do
|
while assigned(hp2) do
|
||||||
begin
|
begin
|
||||||
getlabel(plabel(hp2^.lab));
|
getlabel(plabel(hp2^.lab));
|
||||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str
|
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
|
||||||
(hp2^.lab)))));
|
|
||||||
hp2:=pimported_procedure(hp2^.next);
|
hp2:=pimported_procedure(hp2^.next);
|
||||||
end;
|
end;
|
||||||
{ finalize the names ... }
|
{ finalize the names ... }
|
||||||
@ -130,20 +139,18 @@ unit win_targ;
|
|||||||
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
||||||
while assigned(hp2) do
|
while assigned(hp2) do
|
||||||
begin
|
begin
|
||||||
getlabel(l4);
|
getdatalabel(l4);
|
||||||
{ text segment should be aligned }
|
{ create indirect jump }
|
||||||
codesegment^.concat(new(pai_align,init_op(4,$90)));
|
|
||||||
codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
|
|
||||||
{ the indirect jump }
|
|
||||||
new(r);
|
new(r);
|
||||||
reset_reference(r^);
|
reset_reference(r^);
|
||||||
r^.symbol:=stringdup(lab2str(l4));
|
r^.symbol:=stringdup(lab2str(l4));
|
||||||
{$ifdef i386}
|
{ place jump in codesegment }
|
||||||
|
codesegment^.concat(new(pai_align,init_op(4,$90)));
|
||||||
|
codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
|
||||||
codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
|
codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
|
||||||
{$endif}
|
{ add jump field to importsection }
|
||||||
importssection^.concat(new(pai_label,init(l4)));
|
importssection^.concat(new(pai_label,init(l4)));
|
||||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str
|
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
|
||||||
(hp2^.lab)))));
|
|
||||||
hp2:=pimported_procedure(hp2^.next);
|
hp2:=pimported_procedure(hp2^.next);
|
||||||
end;
|
end;
|
||||||
{ finalize the addresses }
|
{ finalize the addresses }
|
||||||
@ -172,7 +179,11 @@ unit win_targ;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.3 1998-06-04 23:52:06 peter
|
Revision 1.4 1998-06-08 22:59:56 peter
|
||||||
|
* smartlinking works for win32
|
||||||
|
* some defines to exclude some compiler parts
|
||||||
|
|
||||||
|
Revision 1.3 1998/06/04 23:52:06 peter
|
||||||
* m68k compiles
|
* m68k compiles
|
||||||
+ .def file creation moved to gendef.pas so it could also be used
|
+ .def file creation moved to gendef.pas so it could also be used
|
||||||
for win32
|
for win32
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user