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

* os2 fixes for import

Browse Source 
* asmsymtype support for intel reader
This commit is contained in:
peter 2004-11-29 18:50:15 +00:00
parent 05127d887d
commit 06cfe01791
6 changed files with 75 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
compiler/i386/ra386int.pas
View File

@ -30,6 +30,7 @@ Unit Ra386int;
cclasses, cclasses,
cpubase, cpubase,
globtype, globtype,
aasmbase,
rasm, rasm,
rax86; rax86;
@ -62,7 +63,7 @@ Unit Ra386int;
function consume(t : tasmtoken):boolean; function consume(t : tasmtoken):boolean;
procedure RecoverConsume(allowcomma:boolean); procedure RecoverConsume(allowcomma:boolean);
procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint); procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint);
procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string); procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype);
function BuildConstExpression:aint; function BuildConstExpression:aint;
function BuildRefConstExpression:aint; function BuildRefConstExpression:aint;
procedure BuildReference(oper : tx86operand); procedure BuildReference(oper : tx86operand);
@ -82,7 +83,7 @@ Unit Ra386int;
globals,verbose, globals,verbose,
systems, systems,
{ aasm } { aasm }
aasmbase,aasmtai,aasmcpu, aasmtai,aasmcpu,
{ symtable } { symtable }
symconst,symbase,symtype,symsym,symdef,symtable, symconst,symbase,symtype,symsym,symdef,symtable,
{ parser } { parser }
@ -713,7 +714,7 @@ Unit Ra386int;
end; end;
Procedure ti386intreader.BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string); Procedure ti386intreader.BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype);
var var
tempstr,expr,hs : string; tempstr,expr,hs : string;
parenlevel : longint; parenlevel : longint;
@ -722,6 +723,7 @@ Unit Ra386int;
errorflag : boolean; errorflag : boolean;
prevtok : tasmtoken; prevtok : tasmtoken;
hl : tasmlabel; hl : tasmlabel;
hssymtyp : Tasmsymtype;
def : tdef; def : tdef;
sym : tsym; sym : tsym;
srsymtable : tsymtable; srsymtable : tsymtable;
@ -729,6 +731,7 @@ Unit Ra386int;
{ reset } { reset }
value:=0; value:=0;
asmsym:=''; asmsym:='';
asmsymtyp:=AT_DATA;
errorflag:=FALSE; errorflag:=FALSE;
tempstr:=''; tempstr:='';
expr:=''; expr:='';
@ -894,6 +897,7 @@ Unit Ra386int;
AS_ID: AS_ID:
Begin Begin
hs:=''; hs:='';
hssymtyp:=AT_DATA;
def:=nil; def:=nil;
tempstr:=actasmpattern; tempstr:=actasmpattern;
prevtok:=prevasmtoken; prevtok:=prevasmtoken;
@ -908,11 +912,15 @@ Unit Ra386int;
if is_locallabel(tempstr) then if is_locallabel(tempstr) then
begin begin
CreateLocalLabel(tempstr,hl,false); CreateLocalLabel(tempstr,hl,false);
hs:=hl.name hs:=hl.name;
hssymtyp:=AT_FUNCTION;
end end
else else
if SearchLabel(tempstr,hl,false) then if SearchLabel(tempstr,hl,false) then
hs:=hl.name begin
hs:=hl.name;
hssymtyp:=AT_FUNCTION;
end
else else
begin begin
searchsym(tempstr,sym,srsymtable); searchsym(tempstr,sym,srsymtable);
@ -939,6 +947,7 @@ Unit Ra386int;
if Tprocsym(sym).procdef_count>1 then if Tprocsym(sym).procdef_count>1 then
Message(asmr_w_calling_overload_func); Message(asmr_w_calling_overload_func);
hs:=tprocsym(sym).first_procdef.mangledname; hs:=tprocsym(sym).first_procdef.mangledname;
hssymtyp:=AT_FUNCTION;
end; end;
typesym : typesym :
begin begin
@ -956,7 +965,10 @@ Unit Ra386int;
if hs<>'' then if hs<>'' then
begin begin
if asmsym='' then if asmsym='' then
asmsym:=hs begin
asmsym:=hs;
asmsymtyp:=hssymtyp;
end
else else
Message(asmr_e_cant_have_multiple_relocatable_symbols); Message(asmr_e_cant_have_multiple_relocatable_symbols);
if (expr='') or (expr[length(expr)]='+') then if (expr='') or (expr[length(expr)]='+') then
@ -1039,8 +1051,9 @@ Unit Ra386int;
var var
l : aint; l : aint;
hs : string; hs : string;
hssymtyp : TAsmsymtype;
begin begin
BuildConstSymbolExpression(false,false,l,hs); BuildConstSymbolExpression(false,false,l,hs,hssymtyp);
if hs<>'' then if hs<>'' then
Message(asmr_e_relocatable_symbol_not_allowed); Message(asmr_e_relocatable_symbol_not_allowed);
BuildConstExpression:=l; BuildConstExpression:=l;
@ -1051,8 +1064,9 @@ Unit Ra386int;
var var
l : aint; l : aint;
hs : string; hs : string;
hssymtyp : TAsmsymtype;
begin begin
BuildConstSymbolExpression(false,true,l,hs); BuildConstSymbolExpression(false,true,l,hs,hssymtyp);
if hs<>'' then if hs<>'' then
Message(asmr_e_relocatable_symbol_not_allowed); Message(asmr_e_relocatable_symbol_not_allowed);
BuildRefConstExpression:=l; BuildRefConstExpression:=l;
@ -1063,6 +1077,7 @@ Unit Ra386int;
var var
k,l,scale : aint; k,l,scale : aint;
tempstr,hs : string; tempstr,hs : string;
tempsymtyp : tasmsymtype;
typesize : longint; typesize : longint;
code : integer; code : integer;
hreg : tregister; hreg : tregister;
@ -1320,14 +1335,14 @@ Unit Ra386int;
begin begin
if not GotPlus and not GotStar then if not GotPlus and not GotStar then
Message(asmr_e_invalid_reference_syntax); Message(asmr_e_invalid_reference_syntax);
BuildConstSymbolExpression(true,true,l,tempstr); BuildConstSymbolExpression(true,true,l,tempstr,tempsymtyp);
if tempstr<>'' then if tempstr<>'' then
begin begin
if GotStar then if GotStar then
Message(asmr_e_only_add_relocatable_symbol); Message(asmr_e_only_add_relocatable_symbol);
if not assigned(oper.opr.ref.symbol) then if not assigned(oper.opr.ref.symbol) then
oper.opr.ref.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_FUNCTION) oper.opr.ref.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,tempsymtyp)
else else
Message(asmr_e_cant_have_multiple_relocatable_symbols); Message(asmr_e_cant_have_multiple_relocatable_symbols);
end; end;
@ -1401,17 +1416,16 @@ Unit Ra386int;
var var
l : aint; l : aint;
tempstr : string; tempstr : string;
tempsymtyp : tasmsymtype;
begin begin
if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
Message(asmr_e_invalid_operand_type); Message(asmr_e_invalid_operand_type);
BuildConstSymbolExpression(true,false,l,tempstr); BuildConstSymbolExpression(true,false,l,tempstr,tempsymtyp);
if tempstr<>'' then if tempstr<>'' then
begin begin
oper.opr.typ:=OPR_SYMBOL; oper.opr.typ:=OPR_SYMBOL;
oper.opr.symofs:=l; oper.opr.symofs:=l;
{ the symbol already exists, but we don't know whether it is data or oper.opr.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,tempsymtyp);
a function. we can use AT_NONE }
oper.opr.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_NONE);
end end
else else
begin begin
@ -1832,6 +1846,7 @@ Unit Ra386int;
Procedure ti386intreader.BuildConstant(constsize: longint); Procedure ti386intreader.BuildConstant(constsize: longint);
var var
asmsymtyp : tasmsymtype;
asmsym, asmsym,
expr: string; expr: string;
value : aint; value : aint;
@ -1865,12 +1880,12 @@ Unit Ra386int;
AS_INTNUM, AS_INTNUM,
AS_ID : AS_ID :
Begin Begin
BuildConstSymbolExpression(false,false,value,asmsym); BuildConstSymbolExpression(false,false,value,asmsym,asmsymtyp);
if asmsym<>'' then if asmsym<>'' then
begin begin
if constsize<>sizeof(aint) then if constsize<>sizeof(aint) then
Message1(asmr_w_const32bit_for_address,asmsym); Message1(asmr_w_const32bit_for_address,asmsym);
ConcatConstSymbol(curlist,asmsym,value) ConcatConstSymbol(curlist,asmsym,asmsymtyp,value)
end end
else else
ConcatConstant(curlist,value,constsize); ConcatConstant(curlist,value,constsize);
@ -2022,7 +2037,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.81 2004-11-21 21:36:13 peter Revision 1.82 2004-11-29 18:50:15 peter
* os2 fixes for import
* asmsymtype support for intel reader
Revision 1.81 2004/11/21 21:36:13 peter
* allow spaces before : of a label * allow spaces before : of a label
Revision 1.80 2004/11/09 22:32:59 peter Revision 1.80 2004/11/09 22:32:59 peter

8
compiler/pdecvar.pas
View File

@ -1118,7 +1118,7 @@ implementation
if not(current_module.uses_imports) then if not(current_module.uses_imports) then
begin begin
current_module.uses_imports:=true; current_module.uses_imports:=true;
importlib.preparelib(current_module.modulename^); importlib.preparelib(current_module.realmodulename^);
end; end;
importlib.importvariable(tglobalvarsym(vs),C_name,dll_name); importlib.importvariable(tglobalvarsym(vs),C_name,dll_name);
end end
@ -1306,7 +1306,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.85 2004-11-16 20:32:40 peter Revision 1.86 2004-11-29 18:50:15 peter
* os2 fixes for import
* asmsymtype support for intel reader
Revision 1.85 2004/11/16 20:32:40 peter
* fixes for win32 mangledname * fixes for win32 mangledname
Revision 1.84 2004/11/15 23:35:31 peter Revision 1.84 2004/11/15 23:35:31 peter

14
compiler/pmodules.pas
View File

@ -1277,9 +1277,11 @@ implementation
begin begin
consume(_LIBRARY); consume(_LIBRARY);
stringdispose(current_module.modulename); stringdispose(current_module.modulename);
stringdispose(current_module.realmodulename);
current_module.modulename:=stringdup(pattern); current_module.modulename:=stringdup(pattern);
current_module.realmodulename:=stringdup(orgpattern);
current_module.islibrary:=true; current_module.islibrary:=true;
exportlib.preparelib(pattern); exportlib.preparelib(orgpattern);
consume(_ID); consume(_ID);
consume(_SEMICOLON); consume(_SEMICOLON);
end end
@ -1293,7 +1295,7 @@ implementation
current_module.modulename:=stringdup(pattern); current_module.modulename:=stringdup(pattern);
current_module.realmodulename:=stringdup(orgpattern); current_module.realmodulename:=stringdup(orgpattern);
if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
exportlib.preparelib(pattern); exportlib.preparelib(orgpattern);
consume(_ID); consume(_ID);
if token=_LKLAMMER then if token=_LKLAMMER then
begin begin
@ -1306,7 +1308,7 @@ implementation
consume(_SEMICOLON); consume(_SEMICOLON);
end end
else if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then else if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
exportlib.preparelib(current_module.modulename^); exportlib.preparelib(current_module.realmodulename^);
{ global switches are read, so further changes aren't allowed } { global switches are read, so further changes aren't allowed }
current_module.in_global:=false; current_module.in_global:=false;
@ -1521,7 +1523,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.176 2004-11-19 08:17:02 michael Revision 1.177 2004-11-29 18:50:15 peter
* os2 fixes for import
* asmsymtype support for intel reader
Revision 1.176 2004/11/19 08:17:02 michael
* Split po_public into po_public and po_global (Peter) * Split po_public into po_public and po_global (Peter)
Revision 1.175 2004/11/16 20:32:40 peter Revision 1.175 2004/11/16 20:32:40 peter

8
compiler/psub.pas
View File

@ -1289,7 +1289,7 @@ implementation
if not(current_module.uses_imports) then if not(current_module.uses_imports) then
begin begin
current_module.uses_imports:=true; current_module.uses_imports:=true;
importlib.preparelib(current_module.modulename^); importlib.preparelib(current_module.realmodulename^);
end; end;
if assigned(pd.import_name) then if assigned(pd.import_name) then
@ -1438,7 +1438,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.219 2004-11-21 17:17:03 florian Revision 1.220 2004-11-29 18:50:15 peter
* os2 fixes for import
* asmsymtype support for intel reader
Revision 1.219 2004/11/21 17:17:03 florian
* changed funcret location back to tlocation * changed funcret location back to tlocation
Revision 1.218 2004/11/19 08:17:02 michael Revision 1.218 2004/11/19 08:17:02 michael

8
compiler/raatt.pas
View File

@ -792,7 +792,7 @@ unit raatt;
begin begin
if constsize<>sizeof(aint) then if constsize<>sizeof(aint) then
Message(asmr_w_32bit_const_for_address); Message(asmr_w_32bit_const_for_address);
ConcatConstSymbol(curlist,asmsym,value) ConcatConstSymbol(curlist,asmsym,asmsymtyp,value)
end end
else else
ConcatConstant(curlist,value,constsize); ConcatConstant(curlist,value,constsize);
@ -1514,7 +1514,11 @@ end.
{ {
$Log$ $Log$
Revision 1.14 2004-11-21 15:35:23 peter Revision 1.15 2004-11-29 18:50:15 peter
* os2 fixes for import
* asmsymtype support for intel reader
Revision 1.14 2004/11/21 15:35:23 peter
* float routines all use internproc and compilerproc helpers * float routines all use internproc and compilerproc helpers
Revision 1.13 2004/11/08 22:09:59 peter Revision 1.13 2004/11/08 22:09:59 peter

12
compiler/rautils.pas
View File

@ -200,7 +200,7 @@ Function SearchIConstant(const s:string; var l:aint): boolean;
Procedure ConcatDirect(p : TAAsmoutput;s:string); Procedure ConcatDirect(p : TAAsmoutput;s:string);
Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel); Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel);
Procedure ConcatConstant(p : TAAsmoutput;value: aint; constsize:byte); Procedure ConcatConstant(p : TAAsmoutput;value: aint; constsize:byte);
Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:aint); Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;symtyp:tasmsymtype;l:aint);
Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype); Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype);
Procedure ConcatString(p : TAAsmoutput;s:string); Procedure ConcatString(p : TAAsmoutput;s:string);
procedure ConcatAlign(p:TAAsmoutput;l:aint); procedure ConcatAlign(p:TAAsmoutput;l:aint);
@ -1521,9 +1521,9 @@ Begin
end; end;
Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:aint); Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;symtyp:tasmsymtype;l:aint);
begin begin
p.concat(Tai_const.Createname(sym,AT_DATA,l)); p.concat(Tai_const.Createname(sym,symtyp,l));
end; end;
@ -1617,7 +1617,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.96 2004-11-21 15:35:23 peter Revision 1.97 2004-11-29 18:50:15 peter
* os2 fixes for import
* asmsymtype support for intel reader
Revision 1.96 2004/11/21 15:35:23 peter
* float routines all use internproc and compilerproc helpers * float routines all use internproc and compilerproc helpers
Revision 1.95 2004/11/09 22:32:59 peter Revision 1.95 2004/11/09 22:32:59 peter