mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-01 18:53:39 +02:00
02ad2e4879
the assembler level
o initially for use during the typed constant parsing, but usable anywhere
we generate initialised data in the compiler
git-svn-id: branches/hlcgllvm@28117 -
339 lines
12 KiB
ObjectPascal
339 lines
12 KiB
ObjectPascal
{
|
||
Copyright (c) 2014 by Jonas Maebe, member of the Free Pascal development
|
||
team
|
||
|
||
This unit implements typed constant data elements at the assembler level
|
||
|
||
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.
|
||
|
||
****************************************************************************
|
||
}
|
||
unit aasmcnst;
|
||
|
||
{$i fpcdefs.inc}
|
||
|
||
interface
|
||
|
||
uses
|
||
cclasses,globtype,constexp,
|
||
aasmbase,aasmdata,aasmtai,
|
||
symtype,symdef,symsym;
|
||
|
||
type
|
||
{ Warning: never directly create a ttai_typedconstbuilder instance,
|
||
instead create a cai_typedconstbuilder (this class can be overridden) }
|
||
ttai_lowleveltypedconstbuilder = class abstract
|
||
protected
|
||
{ temporary list in which all data is collected }
|
||
fasmlist: tasmlist;
|
||
{ while queueing elements of a compound expression, this is the current
|
||
offset in the top-level array/record }
|
||
fqueue_offset: asizeint;
|
||
|
||
{ ensure that finalize_asmlist is called only once }
|
||
fasmlist_finalized: boolean;
|
||
|
||
{ returns whether def must be handled as an aggregate on the current
|
||
platform }
|
||
function aggregate_kind(def: tdef): ttypedconstkind; virtual;
|
||
{ finalize the asmlist: add the necessary symbols etc }
|
||
procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean); virtual;
|
||
public
|
||
{ sym is the symbol for which this typed constant data is emitted. }
|
||
constructor create; virtual;
|
||
destructor destroy; override;
|
||
|
||
{ add a simple constant data element (p) to the typed constant.
|
||
def is the type of the added value }
|
||
procedure emit_tai(p: tai; def: tdef); virtual;
|
||
{ same as above, for a special case: when the def is a procvardef and we
|
||
want to use it explicitly as a procvdef (i.e., not as a record with a
|
||
code and data pointer in case of a complex procvardef) }
|
||
procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); virtual;
|
||
{ begin a potential aggregate type. Must be called for any type
|
||
that consists of multiple tai constant data entries, or that
|
||
represents an aggregate at the Pascal level (a record, a non-dynamic
|
||
array, ... }
|
||
procedure maybe_begin_aggregate(def: tdef); virtual;
|
||
{ end a potential aggregate type. Must be paired with every
|
||
maybe_begin_aggregate }
|
||
procedure maybe_end_aggregate(def: tdef); virtual;
|
||
|
||
{ The next group of routines are for constructing complex expressions.
|
||
While parsing a typed constant these operators are encountered from
|
||
outer to inner, so that is also the order in which they should be
|
||
added to the queue. Only one queue can be active at a time. There is
|
||
no default implementation. }
|
||
{ Init the queue. Gives an internalerror if a queu was already active }
|
||
procedure queue_init(todef: tdef); virtual;
|
||
{ queue an array/string indexing operation (performs all range checking,
|
||
so it doesn't have to be duplicated in all descendents). Returns the
|
||
length of the elements (in bytes) and the index in the vector
|
||
(0-based) }
|
||
procedure queue_vecn(def: tdef; const index: tconstexprint); virtual;
|
||
{ queue a subscripting operation }
|
||
procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); virtual;
|
||
{ queue a type conversion operation }
|
||
procedure queue_typeconvn(fromdef, todef: tdef); virtual;
|
||
{ queue an address taking operation }
|
||
procedure queue_addrn(fromdef, todef: tdef); virtual;
|
||
{ (these default implementations don't do anything but indicate the
|
||
queue has been flushed by resetting fqueueu_offset)
|
||
finalise the queue (so a new one can be created) and flush the
|
||
previously queued operations, applying them in reverse order on a...}
|
||
{ ... procdef }
|
||
procedure queue_emit_proc(pd: tprocdef); virtual;
|
||
{ ... staticvarsym }
|
||
procedure queue_emit_staticvar(vs: tstaticvarsym); virtual;
|
||
{ ... labelsym }
|
||
procedure queue_emit_label(l: tlabelsym); virtual;
|
||
{ ... constsym }
|
||
procedure queue_emit_const(cs: tconstsym); virtual;
|
||
{ ... asmsym }
|
||
procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); virtual;
|
||
|
||
{ finalize the asmlist (if necessary) and return it.
|
||
At the end, the generated data can be found in the asmlist. It will
|
||
be freed when the builder is destroyed, so add its contents to
|
||
another list first. This property should only be accessed once all
|
||
data has been added. }
|
||
function get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; lab: boolean): tasmlist;
|
||
end;
|
||
ttai_lowleveltypedconstbuilderclass = class of ttai_lowleveltypedconstbuilder;
|
||
|
||
var
|
||
ctai_typedconstbuilder: ttai_lowleveltypedconstbuilderclass;
|
||
|
||
implementation
|
||
|
||
uses
|
||
verbose,globals,
|
||
symconst,defutil;
|
||
|
||
{*****************************************************************************
|
||
ttai_lowleveltypedconstbuilder
|
||
*****************************************************************************}
|
||
|
||
function ttai_lowleveltypedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind;
|
||
begin
|
||
if (def.typ in [recorddef,filedef,variantdef]) or
|
||
is_object(def) or
|
||
((def.typ=procvardef) and
|
||
not tprocvardef(def).is_addressonly) then
|
||
result:=tck_record
|
||
else if ((def.typ=arraydef) and
|
||
not is_dynamic_array(def)) or
|
||
((def.typ=setdef) and
|
||
not is_smallset(def)) or
|
||
is_shortstring(def) then
|
||
result:=tck_array
|
||
else
|
||
result:=tck_simple;
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean);
|
||
var
|
||
prelist: tasmlist;
|
||
begin
|
||
prelist:=tasmlist.create_without_marker;
|
||
maybe_new_object_file(prelist);
|
||
{ only now add items based on the symbolname, because it may be
|
||
modified by the "section" specifier in case of a typed constant }
|
||
new_section(prelist,section,secname,const_align(alignment));
|
||
if not lab then
|
||
if sym.bind=AB_GLOBAL then
|
||
prelist.concat(tai_symbol.Create_Global(sym,0))
|
||
else
|
||
prelist.concat(tai_symbol.Create(sym,0))
|
||
else
|
||
prelist.concat(tai_label.Create(tasmlabel(sym)));
|
||
{ insert the symbol information before the data }
|
||
fasmlist.insertlist(prelist);
|
||
{ end of the symbol }
|
||
fasmlist.concat(tai_symbol_end.Createname(sym.name));
|
||
{ free the temporary list }
|
||
prelist.free;
|
||
end;
|
||
|
||
|
||
function ttai_lowleveltypedconstbuilder.get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; lab: boolean): tasmlist;
|
||
begin
|
||
if not fasmlist_finalized then
|
||
begin
|
||
finalize_asmlist(sym,def,section,secname,alignment,lab);
|
||
fasmlist_finalized:=true;
|
||
end;
|
||
result:=fasmlist;
|
||
end;
|
||
|
||
|
||
constructor ttai_lowleveltypedconstbuilder.create;
|
||
begin
|
||
inherited create;
|
||
fasmlist:=tasmlist.create_without_marker;
|
||
{ queue is empty }
|
||
fqueue_offset:=low(fqueue_offset);
|
||
end;
|
||
|
||
|
||
destructor ttai_lowleveltypedconstbuilder.destroy;
|
||
begin
|
||
{ the queue should have been flushed if it was used }
|
||
if fqueue_offset<>low(fqueue_offset) then
|
||
internalerror(2014062901);
|
||
fasmlist.free;
|
||
inherited destroy;
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.emit_tai(p: tai; def: tdef);
|
||
begin
|
||
{ by default, we ignore the def info since we don't care about it at the
|
||
the assembler level }
|
||
fasmlist.concat(p);
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
|
||
begin
|
||
{ nothing special by default, since we don't care about the type }
|
||
emit_tai(p,pvdef);
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.maybe_begin_aggregate(def: tdef);
|
||
begin
|
||
{ do nothing }
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.maybe_end_aggregate(def: tdef);
|
||
begin
|
||
{ do nothing }
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_init(todef: tdef);
|
||
begin
|
||
{ nested call to init? }
|
||
if fqueue_offset<>low(fqueue_offset) then
|
||
internalerror(2014062101);
|
||
fqueue_offset:=0;
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_vecn(def: tdef; const index: tconstexprint);
|
||
var
|
||
elelen,
|
||
vecbase: asizeint;
|
||
v: tconstexprint;
|
||
begin
|
||
elelen:=1;
|
||
vecbase:=0;
|
||
case def.typ of
|
||
stringdef :
|
||
;
|
||
arraydef :
|
||
begin
|
||
if not is_packed_array(def) then
|
||
begin
|
||
elelen:=tarraydef(def).elesize;
|
||
vecbase:=tarraydef(def).lowrange;
|
||
end
|
||
else
|
||
Message(parser_e_packed_dynamic_open_array);
|
||
end;
|
||
else
|
||
Message(parser_e_illegal_expression);
|
||
end;
|
||
{ Prevent overflow }
|
||
v:=index-vecbase;
|
||
if (v<int64(low(fqueue_offset))) or (v>int64(high(fqueue_offset))) then
|
||
message3(type_e_range_check_error_bounds,tostr(v),tostr(low(fqueue_offset)),tostr(high(fqueue_offset)));
|
||
if high(fqueue_offset)-fqueue_offset div elelen>v then
|
||
inc(fqueue_offset,elelen*v.svalue)
|
||
else
|
||
message3(type_e_range_check_error_bounds,tostr(index),tostr(vecbase),tostr(high(fqueue_offset)-fqueue_offset div elelen+vecbase))
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
|
||
begin
|
||
inc(fqueue_offset,vs.fieldoffset);
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
|
||
begin
|
||
{ do nothing }
|
||
end;
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_addrn(fromdef, todef: tdef);
|
||
begin
|
||
{ do nothing }
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_emit_proc(pd: tprocdef);
|
||
begin
|
||
emit_tai(Tai_const.Createname(pd.mangledname,fqueue_offset),pd);
|
||
fqueue_offset:=low(fqueue_offset);
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_emit_staticvar(vs: tstaticvarsym);
|
||
begin
|
||
{ getpointerdef because we are emitting a pointer to the staticvarsym
|
||
data, not the data itself }
|
||
emit_tai(Tai_const.Createname(vs.mangledname,fqueue_offset),getpointerdef(vs.vardef));
|
||
fqueue_offset:=low(fqueue_offset);
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_emit_label(l: tlabelsym);
|
||
begin
|
||
emit_tai(Tai_const.Createname(l.mangledname,fqueue_offset),voidcodepointertype);
|
||
fqueue_offset:=low(fqueue_offset);
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_emit_const(cs: tconstsym);
|
||
begin
|
||
if cs.consttyp<>constresourcestring then
|
||
internalerror(2014062102);
|
||
if fqueue_offset<>0 then
|
||
internalerror(2014062103);
|
||
{ warning: update if/when the type of resource strings changes }
|
||
emit_tai(Tai_const.Createname(make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA,sizeof(pint)),cansistringtype);
|
||
fqueue_offset:=low(fqueue_offset);
|
||
end;
|
||
|
||
|
||
procedure ttai_lowleveltypedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
|
||
begin
|
||
{ getpointerdef, because "sym" represents the address of whatever the
|
||
data is }
|
||
def:=getpointerdef(def);
|
||
emit_tai(Tai_const.Create_sym(sym),def);
|
||
fqueue_offset:=low(fqueue_offset);
|
||
end;
|
||
|
||
|
||
begin
|
||
ctai_typedconstbuilder:=ttai_lowleveltypedconstbuilder;
|
||
end.
|
||
|