From 417f1cd49dd4f75009a4a868d5c07840866cc4cf Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 6 Jan 2017 22:21:37 +0000 Subject: [PATCH] + initial implementation of the RTTI for parameter locations (not *yet* used by anything) The parameter manager converts from the internal compiler representation of a parameter's location to an RTTI representation. As the general implementation more or less directly uses the compiler structures for this a platform specific parameter manager may override this functionality in case some parameter information changed in a non-backwards compatible way. The RTTI parameter location has a layout that allows for an easy enumeration as the size is fixed for all locations. Additionally there are properties that allow for easy access to the information stored in them. git-svn-id: trunk@35250 - --- compiler/ncgrtti.pas | 27 ++++++++++- compiler/parabase.pas | 13 ++++++ compiler/paramgr.pas | 74 +++++++++++++++++++++++++++++++ rtl/objpas/typinfo.pp | 101 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 213 insertions(+), 2 deletions(-) diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas index f1c9ae0192..e33786a53f 100644 --- a/compiler/ncgrtti.pas +++ b/compiler/ncgrtti.pas @@ -28,7 +28,7 @@ interface uses cclasses,constexp, aasmbase,aasmcnst, - symbase,symconst,symtype,symdef; + symbase,symconst,symtype,symdef,symsym; type @@ -60,6 +60,7 @@ interface procedure write_header(tcb: ttai_typedconstbuilder; def: tdef; typekind: byte); function write_methodkind(tcb:ttai_typedconstbuilder;def:tabstractprocdef):byte; procedure write_callconv(tcb:ttai_typedconstbuilder;def:tabstractprocdef); + procedure write_paralocs(tcb:ttai_typedconstbuilder;parasym:tparavarsym); public constructor create; procedure write_rtti(def:tdef;rt:trttitype); @@ -81,9 +82,10 @@ implementation cutils, globals,globtype,verbose,systems, fmodule, procinfo, - symtable,symsym, + symtable, aasmtai,aasmdata, defutil, + parabase,paramgr, wpobase ; @@ -237,6 +239,27 @@ implementation tcb.emit_ord_const(ProcCallOptionToCallConv[def.proccalloption],u8inttype); end; + + procedure TRTTIWriter.write_paralocs(tcb:ttai_typedconstbuilder;parasym:tparavarsym); + var + locs : trttiparalocs; + i : longint; + begin + locs:=paramanager.cgparalocs_to_rttiparalocs(parasym.paraloc[callerside].location); + if length(locs)>high(byte) then + internalerror(2017010601); + tcb.emit_ord_const(length(locs),u8inttype); + for i:=low(locs) to high(locs) do + begin + tcb.emit_ord_const(locs[i].loctype,u8inttype); + tcb.emit_ord_const(locs[i].regsub,u8inttype); + tcb.emit_ord_const(locs[i].regindex,u16inttype); + { the corresponding type for aint is alusinttype } + tcb.emit_ord_const(locs[i].offset,alusinttype); + end; + end; + + procedure TRTTIWriter.write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef); begin if is_open_array(def) then diff --git a/compiler/parabase.pas b/compiler/parabase.pas index def3584a39..59a7a01e0d 100644 --- a/compiler/parabase.pas +++ b/compiler/parabase.pas @@ -140,6 +140,19 @@ unit parabase; end; + trttiparaloc = record + { contains the regtype in bits 0-6 and whether it's reference or not + in bit 7 } + loctype : byte; + regsub : byte; + regindex : word; + { either stack offset or shiftval } + offset : aint; + end; + + + trttiparalocs = array of trttiparaloc; + implementation diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas index 8e21c89276..91ce724cf7 100644 --- a/compiler/paramgr.pas +++ b/compiler/paramgr.pas @@ -137,6 +137,10 @@ unit paramgr; function parseparaloc(parasym : tparavarsym;const s : string) : boolean;virtual; function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;virtual; + { Convert a list of CGParaLocation entries to a RTTIParaLoc array that + can be written by ncgrtti } + function cgparalocs_to_rttiparalocs(paralocs:pcgparalocation):trttiparalocs; + { allocate room for parameters on the stack in the entry code? } function use_fixed_stack: boolean; { whether stack pointer can be changed in the middle of procedure } @@ -155,6 +159,11 @@ unit paramgr; for which the def is paradef and the integer length is restlen. fullsize is true if restlen equals the full paradef size } function get_paraloc_def(paradef: tdef; restlen: aint; fullsize: boolean): tdef; + + { convert a single CGParaLocation to a RTTIParaLoc; the method *might* + be overriden by targets to provide backwards compatibility with + older versions in case register indices changed } + function cgparaloc_to_rttiparaloc(paraloc:pcgparalocation):trttiparaloc;virtual; end; @@ -662,6 +671,71 @@ implementation end; + function tparamanager.cgparalocs_to_rttiparalocs(paralocs:pcgparalocation):trttiparalocs; + var + c : longint; + tmploc : pcgparalocation; + begin + c:=0; + tmploc:=paralocs; + while assigned(tmploc) do + begin + inc(c); + tmploc:=tmploc^.next; + end; + + setlength(result,c); + + c:=0; + tmploc:=paralocs; + while assigned(tmploc) do + begin + result[c]:=cgparaloc_to_rttiparaloc(tmploc); + inc(c); + tmploc:=tmploc^.next; + end; + end; + + + function tparamanager.cgparaloc_to_rttiparaloc(paraloc:pcgparalocation):trttiparaloc; + var + reg : tregisterrec; + begin + if paraloc^.Loc=LOC_REFERENCE then + begin + reg:=tregisterrec(paraloc^.reference.index); + result.offset:=paraloc^.reference.offset; + result.loctype:=$80; + end + else + begin + reg:=tregisterrec(paraloc^.register); + { use sign extension } + result.offset:=paraloc^.shiftval; + result.loctype:=$00; + end; + case reg.regtype of + R_INTREGISTER, + R_FPUREGISTER, + R_MMXREGISTER, + R_MMREGISTER, + R_SPECIALREGISTER, + R_ADDRESSREGISTER: + begin + result.loctype:=result.loctype or ord(reg.regtype); + result.regsub:=ord(reg.subreg); + result.regindex:=reg.supreg; + end; + else + begin + { no need to adjust loctype } + result.regsub:=0; + result.regindex:=0; + end; + end; + end; + + initialization ; finalization diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index 2e8bae570c..2e06ed0685 100644 --- a/rtl/objpas/typinfo.pp +++ b/rtl/objpas/typinfo.pp @@ -80,6 +80,72 @@ unit typinfo; TTypeKinds = set of TTypeKind; ShortStringBase = string[255]; +{$push} +{$scopedenums on} + TSubRegister = ( + None, + Lo, + Hi, + Word, + DWord, + QWord, + FloatSingle, + FloatDouble, + FloatQuad, + MultiMediaSingle, + MultiMediaDouble, + MultiMediaWhole, + MultiMediaX, + MultiMediaY + ); + + TRegisterType = ( + Invalid, + Int, + FP, + MMX, + MultiMedia, + Special, + Address + ); +{$pop} + + TParameterLocation = +{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} + packed +{$endif FPC_REQUIRES_PROPER_ALIGNMENT} + record + private + LocType: Byte; + function GetRegType: TRegisterType; inline; + function GetReference: Boolean; inline; + function GetShiftVal: Int8; inline; + public + RegSub: TSubRegister; + RegNumber: Word; + { Stack offset if Reference, ShiftVal if not } + Offset: SizeInt; + { if Reference then the register is the index register otherwise the + register in wihch (part of) the parameter resides } + property Reference: Boolean read GetReference; + property RegType: TRegisterType read GetRegType; + { if Reference, otherwise 0 } + property ShiftVal: Int8 read GetShiftVal; + end; + PParameterLocation = ^TParameterLocation; + + TParameterLocations = +{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} + packed +{$endif FPC_REQUIRES_PROPER_ALIGNMENT} + record + private + function GetLocation(aIndex: Byte): PParameterLocation; inline; + public + Count: Byte; + property Location[Index: Byte]: PParameterLocation read GetLocation; + end; + PVmtFieldEntry = ^TVmtFieldEntry; TVmtFieldEntry = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} @@ -2298,6 +2364,41 @@ begin Result:=IsStoredProp(instance,FindPropInfo(Instance,PropName)); end; +{ TParameterLocation } + +function TParameterLocation.GetReference: Boolean; +begin + Result := (LocType and $80) <> 0; +end; + +function TParameterLocation.GetRegType: TRegisterType; +begin + Result := TRegisterType(LocType and $7F); +end; + +function TParameterLocation.GetShiftVal: Int8; +begin + if GetReference then begin + if Offset < Low(Int8) then + Result := Low(Int8) + else if Offset > High(Int8) then + Result := High(Int8) + else + Result := Offset; + end else + Result := 0; +end; + +{ TParameterLocations } + +function TParameterLocations.GetLocation(aIndex: Byte): PParameterLocation; +begin + if aIndex >= Count then + Result := Nil + else + Result := PParameterLocation(@Count + SizeOf(Count) + SizeOf(TParameterLocation) * Count); +end; + { TProcedureParam } function TProcedureParam.GetParamType: PTypeInfo;