mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 18:47:54 +02:00
1974 lines
59 KiB
ObjectPascal
1974 lines
59 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
|
|
|
|
This unit implements some support routines for assembler parsing
|
|
independent of the processor
|
|
|
|
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 RAUtils;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
Interface
|
|
|
|
Uses
|
|
cutils,cclasses,
|
|
globtype,aasmbase,aasmtai,aasmdata,cpubase,cpuinfo,cgbase,cgutils,
|
|
symconst,symbase,symtype,symdef,symsym,constexp,symcpu;
|
|
|
|
Const
|
|
RPNMax = 10; { I think you only need 4, but just to be safe }
|
|
OpMax = 25;
|
|
|
|
Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
|
|
|
|
|
|
{---------------------------------------------------------------------
|
|
Instruction management
|
|
---------------------------------------------------------------------}
|
|
|
|
type
|
|
TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL,
|
|
OPR_REFERENCE,OPR_REGISTER,OPR_COND,OPR_REGSET,
|
|
OPR_SHIFTEROP,OPR_MODEFLAGS,OPR_SPECIALREG,
|
|
OPR_REGPAIR,OPR_FENCEFLAGS,OPR_INDEXEDREG,OPR_FLOATCONSTANT,
|
|
OPR_FUNCTYPE);
|
|
|
|
TOprRec = record
|
|
case typ:TOprType of
|
|
OPR_NONE : ();
|
|
{$if defined(AVR)}
|
|
OPR_CONSTANT : (val:longint);
|
|
{$elseif defined(i8086)}
|
|
OPR_CONSTANT : (val:longint);
|
|
{$elseif defined(Z80)}
|
|
OPR_CONSTANT : (val:longint);
|
|
{$else}
|
|
OPR_CONSTANT : (val:aint);
|
|
{$endif}
|
|
OPR_SYMBOL : (symbol:tasmsymbol;symofs:aint;symseg:boolean;sym_farproc_entry:boolean);
|
|
OPR_REFERENCE : (varsize:asizeint; constoffset: asizeint;ref_farproc_entry:boolean;ref:treference);
|
|
OPR_LOCAL : (localvarsize, localconstoffset: asizeint;localsym:tabstractnormalvarsym;localsymofs:aint;localsegment,localindexreg:tregister;localscale:byte;localgetoffset,localforceref:boolean);
|
|
OPR_REGISTER : (reg:tregister);
|
|
{$ifdef m68k}
|
|
OPR_REGSET : (regsetdata,regsetaddr,regsetfpu : tcpuregisterset);
|
|
OPR_REGPAIR : (reghi,reglo: tregister);
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
OPR_COND : (cond : tasmcond);
|
|
{$endif powerpc}
|
|
{$ifdef POWERPC64}
|
|
OPR_COND : (cond : tasmcond);
|
|
{$endif POWERPC64}
|
|
{$ifdef arm}
|
|
OPR_REGSET : (regset : tcpuregisterset; regtype: tregistertype; subreg: tsubregister; usermode: boolean);
|
|
OPR_SHIFTEROP : (shifterop : tshifterop);
|
|
OPR_COND : (cc : tasmcond);
|
|
OPR_MODEFLAGS : (flags : tcpumodeflags);
|
|
OPR_SPECIALREG: (specialreg : tregister; specialregflags : tspecialregflags);
|
|
{$endif arm}
|
|
{$ifdef aarch64}
|
|
OPR_REGSET : (basereg: tregister; nregs, regsetindex: byte);
|
|
OPR_INDEXEDREG: (indexedreg: tregister; regindex: byte);
|
|
OPR_SHIFTEROP : (shifterop : tshifterop);
|
|
OPR_COND : (cc : tasmcond);
|
|
{$endif aarch64}
|
|
{$if defined(riscv32) or defined(riscv64)}
|
|
OPR_FENCEFLAGS: (fenceflags : TFenceFlags);
|
|
{$endif aarch64}
|
|
{$ifdef wasm32}
|
|
OPR_FLOATCONSTANT: (floatval:double);
|
|
OPR_FUNCTYPE : (functype: TWasmFuncType);
|
|
{$endif wasm32}
|
|
end;
|
|
|
|
TInstruction = class;
|
|
|
|
TOperand = class
|
|
opr : TOprRec;
|
|
typesize : byte;
|
|
haslabelref, { if the operand has a label, used in a reference like a
|
|
var (e.g. 'mov ax, word ptr [label+5]', but *not*
|
|
e.g. 'jmp label') }
|
|
hasproc, { if the operand has a procedure/function reference }
|
|
hastype, { if the operand has typecasted variable }
|
|
hasvar : boolean; { if the operand is loaded with a variable }
|
|
size : TCGSize;
|
|
constructor create;virtual;
|
|
destructor destroy;override;
|
|
Procedure SetSize(_size:longint;force:boolean);virtual;
|
|
Procedure SetCorrectSize(opcode:tasmop);virtual;
|
|
Function SetupResult:boolean;virtual;
|
|
Function SetupSelf:boolean;
|
|
Function SetupOldEBP:boolean;
|
|
Function SetupVar(const s:string;GetOffset : boolean): Boolean;
|
|
function CheckOperand(ins : TInstruction): boolean; virtual;
|
|
Procedure InitRef;
|
|
Procedure InitRefConvertLocal;
|
|
protected
|
|
Procedure InitRefError;
|
|
end;
|
|
TCOperand = class of TOperand;
|
|
|
|
TInstruction = class
|
|
operands : array[1..max_operands] of toperand;
|
|
opcode : tasmop;
|
|
condition : tasmcond;
|
|
ops : byte;
|
|
labeled : boolean;
|
|
filepos : tfileposinfo;
|
|
constructor create(optype : tcoperand);virtual;
|
|
destructor destroy;override;
|
|
{ converts the instruction to an instruction how it's used by the assembler writer
|
|
and concats it to the passed list. The newly created item is returned if the
|
|
instruction was valid, otherwise nil is returned }
|
|
function ConcatInstruction(p:TAsmList) : tai;virtual;
|
|
end;
|
|
|
|
{---------------------------------------------------------------------}
|
|
{ Expression parser types }
|
|
{---------------------------------------------------------------------}
|
|
|
|
TExprOperator = record
|
|
ch: char; { operator }
|
|
is_prefix: boolean; { was it a prefix, possible prefixes are +,- and not }
|
|
end;
|
|
|
|
{**********************************************************************}
|
|
{ The following operators are supported: }
|
|
{ '+' : addition }
|
|
{ '-' : subtraction }
|
|
{ '*' : multiplication }
|
|
{ '/' : modulo division }
|
|
{ '^' : exclusive or }
|
|
{ '<' : shift left }
|
|
{ '>' : shift right }
|
|
{ '&' : bitwise and }
|
|
{ '|' : bitwise or }
|
|
{ '~' : bitwise complement }
|
|
{ '%' : modulo division }
|
|
{ nnn: longint numbers }
|
|
{ ( and ) parenthesis }
|
|
{ [ and ] another kind of parenthesis }
|
|
{**********************************************************************}
|
|
|
|
TExprParse = class
|
|
public
|
|
Constructor create;
|
|
Destructor Destroy;override;
|
|
Function Evaluate(Expr: String): tcgint;
|
|
Function Priority(_Operator: Char): aint;
|
|
private
|
|
RPNStack : Array[1..RPNMax] of tcgint; { Stack For RPN calculator }
|
|
RPNTop : tcgint;
|
|
OpStack : Array[1..OpMax] of TExprOperator; { Operator stack For conversion }
|
|
OpTop : tcgint;
|
|
Procedure RPNPush(Num: tcgint);
|
|
Function RPNPop: tcgint;
|
|
Procedure RPNCalc(const token: String; prefix: boolean);
|
|
Procedure OpPush(_Operator: char; prefix: boolean);
|
|
{ In reality returns TExprOperaotr }
|
|
Procedure OpPop(var _Operator:TExprOperator);
|
|
end;
|
|
|
|
{ Evaluate an expression string to a tcgint }
|
|
Function CalculateExpression(const expression: string): tcgint;
|
|
|
|
{---------------------------------------------------------------------}
|
|
{ String routines }
|
|
{---------------------------------------------------------------------}
|
|
|
|
Function ParseVal(const S:String;base:byte):tcgint;
|
|
Function PadZero(Var s: String; n: byte): Boolean;
|
|
Function EscapeToPascal(const s:string): string;
|
|
|
|
{---------------------------------------------------------------------
|
|
Symbol helper routines
|
|
---------------------------------------------------------------------}
|
|
|
|
procedure AsmSearchSym(const s:string;out srsym:tsym;out srsymtable:TSymtable);
|
|
Function GetRecordOffsetSize(s:string;out Offset: tcgint;out Size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean):boolean;
|
|
Function SearchType(const hs:string;out size:tcgint): Boolean;
|
|
Function SearchRecordType(const s:string): boolean;
|
|
Function SearchIConstant(const s:string; var l:tcgint): boolean;
|
|
Function AsmRegisterPara(sym: tabstractnormalvarsym): boolean;
|
|
|
|
{---------------------------------------------------------------------
|
|
Instruction generation routines
|
|
---------------------------------------------------------------------}
|
|
|
|
Procedure ConcatLabel(p: TAsmList;var l : tasmlabel);
|
|
Procedure ConcatConstant(p : TAsmList;value: tcgint; constsize:byte);
|
|
Procedure ConcatConstSymbol(p : TAsmList;const sym,endsym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
|
|
Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype);
|
|
Procedure ConcatString(p : TAsmList;s:string);
|
|
procedure ConcatAlign(p:TAsmList;l:tcgint);
|
|
Procedure ConcatPublic(p:TAsmList;const s : string);
|
|
Procedure ConcatLocal(p:TAsmList;const s : string);
|
|
|
|
|
|
Implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
defutil,systems,verbose,globals,
|
|
symtable,paramgr,
|
|
aasmcpu,
|
|
procinfo,ngenutil;
|
|
|
|
{*************************************************************************
|
|
TExprParse
|
|
*************************************************************************}
|
|
|
|
Constructor TExprParse.create;
|
|
Begin
|
|
end;
|
|
|
|
|
|
Procedure TExprParse.RPNPush(Num : tcgint);
|
|
{ Add an operand to the top of the RPN stack }
|
|
begin
|
|
if RPNTop < RPNMax then
|
|
begin
|
|
Inc(RPNTop);
|
|
RPNStack[RPNTop]:=Num;
|
|
end
|
|
else
|
|
Message(asmr_e_expr_illegal);
|
|
end;
|
|
|
|
|
|
Function TExprParse.RPNPop : tcgint;
|
|
{ Get the operand at the top of the RPN stack }
|
|
begin
|
|
RPNPop:=0;
|
|
if RPNTop > 0 then
|
|
begin
|
|
RPNPop:=RPNStack[RPNTop];
|
|
Dec(RPNTop);
|
|
end
|
|
else
|
|
Message(asmr_e_expr_illegal);
|
|
end;
|
|
|
|
|
|
Procedure TExprParse.RPNCalc(const Token : String; prefix:boolean); { RPN Calculator }
|
|
Var
|
|
Temp : tcgint;
|
|
n1,n2 : tcgint;
|
|
LocalError : Integer;
|
|
begin
|
|
{ Handle operators }
|
|
if (Length(Token) = 1) and (Token[1] in ['+', '-', '*', '/','&','|','%','^','~','<','>']) then
|
|
Case Token[1] of
|
|
'+' :
|
|
Begin
|
|
if not prefix then
|
|
RPNPush(RPNPop + RPNPop);
|
|
end;
|
|
'-' :
|
|
Begin
|
|
if prefix then
|
|
RPNPush(-(RPNPop))
|
|
else
|
|
begin
|
|
n1:=RPNPop;
|
|
n2:=RPNPop;
|
|
RPNPush(n2 - n1);
|
|
end;
|
|
end;
|
|
'*' : RPNPush(RPNPop * RPNPop);
|
|
'&' :
|
|
begin
|
|
n1:=RPNPop;
|
|
n2:=RPNPop;
|
|
RPNPush(n2 and n1);
|
|
end;
|
|
'|' :
|
|
begin
|
|
n1:=RPNPop;
|
|
n2:=RPNPop;
|
|
RPNPush(n2 or n1);
|
|
end;
|
|
'~' : RPNPush(NOT RPNPop);
|
|
'<' :
|
|
begin
|
|
n1:=RPNPop;
|
|
n2:=RPNPop;
|
|
RPNPush(n2 SHL n1);
|
|
end;
|
|
'>' :
|
|
begin
|
|
n1:=RPNPop;
|
|
n2:=RPNPop;
|
|
RPNPush(n2 SHR n1);
|
|
end;
|
|
'%' :
|
|
begin
|
|
Temp:=RPNPop;
|
|
if Temp <> 0 then
|
|
RPNPush(RPNPop mod Temp)
|
|
else
|
|
begin
|
|
Message(asmr_e_expr_zero_divide);
|
|
{ push 1 for error recovery }
|
|
RPNPush(1);
|
|
end;
|
|
end;
|
|
'^' : RPNPush(RPNPop XOR RPNPop);
|
|
'/' :
|
|
begin
|
|
Temp:=RPNPop;
|
|
if Temp <> 0 then
|
|
RPNPush(RPNPop div Temp)
|
|
else
|
|
begin
|
|
Message(asmr_e_expr_zero_divide);
|
|
{ push 1 for error recovery }
|
|
RPNPush(1);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ Convert String to number and add to stack }
|
|
Val(Token, Temp, LocalError);
|
|
if LocalError = 0 then
|
|
RPNPush(Temp)
|
|
else
|
|
begin
|
|
Message(asmr_e_expr_illegal);
|
|
{ push 1 for error recovery }
|
|
RPNPush(1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TExprParse.OpPush(_Operator : char;prefix: boolean);
|
|
{ Add an operator onto top of the stack }
|
|
begin
|
|
if OpTop < OpMax then
|
|
begin
|
|
Inc(OpTop);
|
|
OpStack[OpTop].ch:=_Operator;
|
|
OpStack[OpTop].is_prefix:=prefix;
|
|
end
|
|
else
|
|
Message(asmr_e_expr_illegal);
|
|
end;
|
|
|
|
|
|
Procedure TExprParse.OpPop(var _Operator:TExprOperator);
|
|
{ Get operator at the top of the stack }
|
|
begin
|
|
if OpTop > 0 then
|
|
begin
|
|
_Operator:=OpStack[OpTop];
|
|
Dec(OpTop);
|
|
end
|
|
else
|
|
Message(asmr_e_expr_illegal);
|
|
end;
|
|
|
|
|
|
Function TExprParse.Priority(_Operator : Char) : aint;
|
|
{ Return priority of operator }
|
|
{ The greater the priority, the higher the precedence }
|
|
begin
|
|
Priority:=0;
|
|
Case _Operator OF
|
|
'(','[' :
|
|
Priority:=0;
|
|
'|','^','~' : // the lowest priority: OR, XOR, NOT
|
|
Priority:=0;
|
|
'&' : // bigger priority: AND
|
|
Priority:=1;
|
|
'+', '-' : // bigger priority: +, -
|
|
Priority:=2;
|
|
'*', '/','%','<','>' : // the highest priority: *, /, MOD, SHL, SHR
|
|
Priority:=3;
|
|
else
|
|
Message(asmr_e_expr_illegal);
|
|
end;
|
|
end;
|
|
|
|
|
|
Function TExprParse.Evaluate(Expr : String):tcgint;
|
|
Var
|
|
I : longint;
|
|
Token : String;
|
|
opr : TExprOperator;
|
|
begin
|
|
Evaluate:=0;
|
|
{ Reset stacks }
|
|
OpTop :=0;
|
|
RPNTop:=0;
|
|
Token :='';
|
|
{ nothing to do ? }
|
|
if Expr='' then
|
|
exit;
|
|
For I:=1 to Length(Expr) DO
|
|
begin
|
|
if Expr[I] in ['0'..'9'] then
|
|
begin { Build multi-digit numbers }
|
|
Token:=Token + Expr[I];
|
|
if I = Length(Expr) then { Send last one to calculator }
|
|
RPNCalc(Token,false);
|
|
end
|
|
else
|
|
if Expr[I] in ['+', '-', '*', '/', '(', ')','[',']','^','&','|','%','~','<','>'] then
|
|
begin
|
|
if Token <> '' then
|
|
begin { Send last built number to calc. }
|
|
RPNCalc(Token,false);
|
|
Token:='';
|
|
end;
|
|
|
|
Case Expr[I] OF
|
|
'[' : OpPush('[',false);
|
|
']' : begin
|
|
While (OpTop>0) and (OpStack[OpTop].ch <> '[') DO
|
|
Begin
|
|
OpPop(opr);
|
|
RPNCalc(opr.ch,opr.is_prefix);
|
|
end;
|
|
OpPop(opr); { Pop off and ignore the '[' }
|
|
end;
|
|
'(' : OpPush('(',false);
|
|
')' : begin
|
|
While (OpTop>0) and (OpStack[OpTop].ch <> '(') DO
|
|
Begin
|
|
OpPop(opr);
|
|
RPNCalc(opr.ch,opr.is_prefix);
|
|
end;
|
|
OpPop(opr); { Pop off and ignore the '(' }
|
|
end;
|
|
'+','-','~' : Begin
|
|
{ workaround for -2147483648 }
|
|
if (expr[I]='-') and (expr[i+1] in ['0'..'9']) then
|
|
begin
|
|
token:='-';
|
|
expr[i]:='+';
|
|
end;
|
|
{ if start of expression then surely a prefix }
|
|
{ or if previous char was also an operator }
|
|
if (I = 1) or (not (Expr[I-1] in ['0'..'9',')'])) then
|
|
OpPush(Expr[I],true)
|
|
else
|
|
Begin
|
|
{ Evaluate all higher priority operators }
|
|
While (OpTop > 0) AND (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
|
|
Begin
|
|
OpPop(opr);
|
|
RPNCalc(opr.ch,opr.is_prefix);
|
|
end;
|
|
OpPush(Expr[I],false);
|
|
End;
|
|
end;
|
|
'*', '/',
|
|
'^','|','&',
|
|
'%','<','>' : begin
|
|
While (OpTop > 0) and (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
|
|
Begin
|
|
OpPop(opr);
|
|
RPNCalc(opr.ch,opr.is_prefix);
|
|
end;
|
|
OpPush(Expr[I],false);
|
|
end;
|
|
end; { Case }
|
|
end
|
|
else
|
|
Message(asmr_e_expr_illegal); { Handle bad input error }
|
|
end;
|
|
|
|
{ Pop off the remaining operators }
|
|
While OpTop > 0 do
|
|
Begin
|
|
OpPop(opr);
|
|
RPNCalc(opr.ch,opr.is_prefix);
|
|
end;
|
|
|
|
{ The result is stored on the top of the stack }
|
|
Evaluate:=RPNPop;
|
|
end;
|
|
|
|
|
|
Destructor TExprParse.Destroy;
|
|
Begin
|
|
end;
|
|
|
|
|
|
Function CalculateExpression(const expression: string): tcgint;
|
|
var
|
|
expr: TExprParse;
|
|
Begin
|
|
expr:=TExprParse.create;
|
|
CalculateExpression:=expr.Evaluate(expression);
|
|
expr.Free;
|
|
end;
|
|
|
|
|
|
{*************************************************************************}
|
|
{ String conversions/utils }
|
|
{*************************************************************************}
|
|
|
|
Function EscapeToPascal(const s:string): string;
|
|
{ converts a C styled string - which contains escape }
|
|
{ characters to a pascal style string. }
|
|
var
|
|
i,len : asizeint;
|
|
hs : string;
|
|
temp : string;
|
|
c : char;
|
|
Begin
|
|
hs:='';
|
|
len:=0;
|
|
i:=0;
|
|
while (i<length(s)) and (len<255) do
|
|
begin
|
|
Inc(i);
|
|
if (s[i]='\') and (i<length(s)) then
|
|
Begin
|
|
inc(i);
|
|
case s[i] of
|
|
'\' :
|
|
c:='\';
|
|
'b':
|
|
c:=#8;
|
|
'f':
|
|
c:=#12;
|
|
'n':
|
|
c:=#10;
|
|
'r':
|
|
c:=#13;
|
|
't':
|
|
c:=#9;
|
|
'"':
|
|
c:='"';
|
|
'0'..'7':
|
|
Begin
|
|
temp:=s[i];
|
|
temp:=temp+s[i+1];
|
|
temp:=temp+s[i+2];
|
|
inc(i,2);
|
|
c:=chr(ParseVal(temp,8));
|
|
end;
|
|
'x':
|
|
Begin
|
|
temp:=s[i+1];
|
|
temp:=temp+s[i+2];
|
|
inc(i,2);
|
|
c:=chr(ParseVal(temp,16));
|
|
end;
|
|
else
|
|
Begin
|
|
Message1(asmr_e_escape_seq_ignored,s[i]);
|
|
c:=s[i];
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
c:=s[i];
|
|
inc(len);
|
|
hs[len]:=c;
|
|
end;
|
|
hs[0]:=chr(len);
|
|
EscapeToPascal:=hs;
|
|
end;
|
|
|
|
|
|
Function ParseVal(const S:String;base:byte):tcgint;
|
|
{ Converts a decimal string to tcgint }
|
|
var
|
|
code : integer;
|
|
errmsg : word;
|
|
prefix : string[2];
|
|
Begin
|
|
case base of
|
|
2 :
|
|
begin
|
|
errmsg:=asmr_e_error_converting_binary;
|
|
prefix:='%';
|
|
end;
|
|
8 :
|
|
begin
|
|
errmsg:=asmr_e_error_converting_octal;
|
|
prefix:='&';
|
|
end;
|
|
10 :
|
|
begin
|
|
errmsg:=asmr_e_error_converting_decimal;
|
|
prefix:='';
|
|
end;
|
|
16 :
|
|
begin
|
|
errmsg:=asmr_e_error_converting_hexadecimal;
|
|
prefix:='$';
|
|
end;
|
|
else
|
|
internalerror(200501202);
|
|
end;
|
|
val(prefix+s,result,code);
|
|
if code<>0 then
|
|
begin
|
|
val(prefix+s,result,code);
|
|
if code<>0 then
|
|
begin
|
|
Message1(errmsg,s);
|
|
result:=0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function PadZero(Var s: String; n: byte): Boolean;
|
|
Begin
|
|
PadZero:=TRUE;
|
|
{ Do some error checking first }
|
|
if Length(s) = n then
|
|
exit
|
|
else
|
|
if Length(s) > n then
|
|
Begin
|
|
PadZero:=FALSE;
|
|
delete(s,n+1,length(s));
|
|
exit;
|
|
end
|
|
else
|
|
PadZero:=TRUE;
|
|
{ Fill it up with the specified character }
|
|
fillchar(s[length(s)+1],n-1,#0);
|
|
s[0]:=chr(n);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TOperand
|
|
****************************************************************************}
|
|
|
|
constructor TOperand.Create;
|
|
begin
|
|
size:=OS_NO;
|
|
hasproc:=false;
|
|
hastype:=false;
|
|
hasvar:=false;
|
|
FillChar(Opr,sizeof(Opr),0);
|
|
end;
|
|
|
|
|
|
destructor TOperand.destroy;
|
|
begin
|
|
end;
|
|
|
|
|
|
Procedure TOperand.SetSize(_size:longint;force:boolean);
|
|
begin
|
|
if force or
|
|
((size = OS_NO) and (_size<=16)) then
|
|
Begin
|
|
case _size of
|
|
1 : size:=OS_8;
|
|
2 : size:=OS_16{ could be S_IS};
|
|
4 : size:=OS_32{ could be S_IL or S_FS};
|
|
8 : size:=OS_64{ could be S_D or S_FL};
|
|
10 : size:=OS_F80;
|
|
16 : size:=OS_128;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TOperand.SetCorrectSize(opcode:tasmop);
|
|
begin
|
|
end;
|
|
|
|
|
|
function TOperand.SetupResult:boolean;
|
|
|
|
begin
|
|
SetupResult:=false;
|
|
{ replace by correct offset. }
|
|
with current_procinfo.procdef do
|
|
if (not is_void(returndef)) then
|
|
begin
|
|
if (m_tp7 in current_settings.modeswitches) and
|
|
not (df_generic in defoptions) and
|
|
(po_assembler in procoptions) and
|
|
(not paramanager.ret_in_param(returndef,current_procinfo.procdef)) then
|
|
begin
|
|
message(asmr_e_cannot_use_RESULT_here);
|
|
exit;
|
|
end;
|
|
SetupResult:=setupvar('result',false)
|
|
end
|
|
else
|
|
message(asmr_e_void_function);
|
|
end;
|
|
|
|
|
|
Function TOperand.SetupSelf:boolean;
|
|
Begin
|
|
SetupSelf:=false;
|
|
if assigned(current_structdef) then
|
|
SetupSelf:=setupvar('self',false)
|
|
else
|
|
Message(asmr_e_cannot_use_SELF_outside_a_method);
|
|
end;
|
|
|
|
|
|
Function TOperand.SetupOldEBP:boolean;
|
|
Begin
|
|
SetupOldEBP:=false;
|
|
if current_procinfo.procdef.parast.symtablelevel>normal_function_level then
|
|
SetupOldEBP:=setupvar('parentframe',false)
|
|
else
|
|
Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
|
|
end;
|
|
|
|
|
|
Function TOperand.SetupVar(const s:string;GetOffset : boolean): Boolean;
|
|
|
|
function symtable_has_localvarsyms(st:TSymtable):boolean;
|
|
var
|
|
sym : tsym;
|
|
i : longint;
|
|
begin
|
|
result:=false;
|
|
for i:=0 to st.SymList.Count-1 do
|
|
begin
|
|
sym:=tsym(st.SymList[i]);
|
|
if sym.typ=localvarsym then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure setconst(l:aint);
|
|
begin
|
|
{ We return the address of the field, just like Delphi/TP }
|
|
case opr.typ of
|
|
OPR_NONE :
|
|
begin
|
|
opr.typ:=OPR_CONSTANT;
|
|
opr.val:=l;
|
|
end;
|
|
OPR_CONSTANT :
|
|
inc(opr.val,l);
|
|
OPR_REFERENCE :
|
|
inc(opr.ref.offset,l);
|
|
OPR_LOCAL :
|
|
inc(opr.localsymofs,l);
|
|
else
|
|
Message(asmr_e_invalid_operand_type);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure setvarsize(sym: tabstractvarsym);
|
|
var
|
|
harrdef: tarraydef;
|
|
l: asizeint;
|
|
begin
|
|
case sym.vardef.typ of
|
|
orddef,
|
|
enumdef,
|
|
pointerdef,
|
|
procvardef,
|
|
floatdef :
|
|
SetSize(sym.getsize,false);
|
|
arraydef :
|
|
begin
|
|
{ for arrays try to get the element size, take care of
|
|
multiple indexes }
|
|
harrdef:=tarraydef(sym.vardef);
|
|
|
|
{ calc array size }
|
|
if is_special_array(harrdef) then
|
|
l := -1
|
|
else
|
|
l := harrdef.size;
|
|
|
|
case opr.typ of
|
|
OPR_REFERENCE: opr.varsize := l;
|
|
OPR_LOCAL: opr.localvarsize := l;
|
|
else
|
|
;
|
|
end;
|
|
|
|
|
|
while assigned(harrdef.elementdef) and
|
|
(harrdef.elementdef.typ=arraydef) do
|
|
harrdef:=tarraydef(harrdef.elementdef);
|
|
if not is_packed_array(harrdef) then
|
|
SetSize(harrdef.elesize,false)
|
|
else
|
|
if (harrdef.elepackedbitsize mod 8) = 0 then
|
|
SetSize(harrdef.elepackedbitsize div 8,false);
|
|
end;
|
|
recorddef:
|
|
case opr.typ of
|
|
OPR_REFERENCE: opr.varsize := sym.getsize;
|
|
OPR_LOCAL: opr.localvarsize := sym.getsize;
|
|
else
|
|
;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
{ search and sets up the correct fields in the Instr record }
|
|
{ for the NON-constant identifier passed to the routine. }
|
|
{ if not found returns FALSE. }
|
|
var
|
|
sym : tsym;
|
|
srsymtable : TSymtable;
|
|
{$ifdef x86}
|
|
segreg,
|
|
{$endif x86}
|
|
indexreg : tregister;
|
|
plist : ppropaccesslistitem;
|
|
size_set_from_absolute : boolean = false;
|
|
{ offset fixup (in bytes), coming from an absolute declaration with an index
|
|
(e.g. var tralala: word absolute moo[5]; ) }
|
|
absoffset: asizeint=0;
|
|
harrdef: tarraydef;
|
|
tmpprocinfo: tprocinfo;
|
|
Begin
|
|
SetupVar:=false;
|
|
asmsearchsym(s,sym,srsymtable);
|
|
if sym = nil then
|
|
exit;
|
|
if sym.typ=absolutevarsym then
|
|
begin
|
|
case tabsolutevarsym(sym).abstyp of
|
|
tovar:
|
|
begin
|
|
{ Only support simple loads }
|
|
plist:=tabsolutevarsym(sym).ref.firstsym;
|
|
if assigned(plist) and
|
|
(plist^.sltype=sl_load) then
|
|
begin
|
|
setvarsize(tabstractvarsym(sym));
|
|
size_set_from_absolute:=true;
|
|
sym:=plist^.sym;
|
|
{ Check if address can be resolved, but only if not an array }
|
|
if (sym.typ=absolutevarsym) and (tabsolutevarsym(sym).abstyp=toaddr) and not
|
|
(assigned(plist^.next) and (plist^.next^.sltype=sl_vec)) then
|
|
begin
|
|
initref;
|
|
opr.ref.offset:=tabsolutevarsym(sym).addroffset;
|
|
hasvar:=true;
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
{ resolve the chain of array indexes (if there are any) }
|
|
harrdef:=nil;
|
|
while assigned(plist^.next) do
|
|
begin
|
|
plist:=plist^.next;
|
|
if (plist^.sltype=sl_vec) and (tabstractvarsym(sym).vardef.typ=arraydef) then
|
|
begin
|
|
if harrdef=nil then
|
|
harrdef:=tarraydef(tabstractvarsym(sym).vardef)
|
|
else if harrdef.elementdef.typ=arraydef then
|
|
harrdef:=tarraydef(harrdef.elementdef)
|
|
else
|
|
begin
|
|
Message(asmr_e_unsupported_symbol_type);
|
|
exit;
|
|
end;
|
|
if is_special_array(harrdef) then
|
|
begin
|
|
Message(asmr_e_unsupported_symbol_type);
|
|
exit;
|
|
end;
|
|
if not is_packed_array(harrdef) then
|
|
Inc(absoffset,asizeint(Int64(plist^.value-harrdef.lowrange))*harrdef.elesize)
|
|
else if (Int64(plist^.value-harrdef.lowrange)*harrdef.elepackedbitsize mod 8)=0 then
|
|
Inc(absoffset,asizeint(Int64(plist^.value-harrdef.lowrange)*harrdef.elepackedbitsize div 8))
|
|
else
|
|
Message(asmr_e_packed_element);
|
|
end
|
|
else
|
|
begin
|
|
Message(asmr_e_unsupported_symbol_type);
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Message(asmr_e_unsupported_symbol_type);
|
|
exit;
|
|
end;
|
|
end;
|
|
toaddr:
|
|
begin
|
|
initref;
|
|
opr.ref.offset:=tabsolutevarsym(sym).addroffset;
|
|
setvarsize(tabstractvarsym(sym));
|
|
size_set_from_absolute:=true;
|
|
hasvar:=true;
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
else
|
|
begin
|
|
Message(asmr_e_unsupported_symbol_type);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
case sym.typ of
|
|
fieldvarsym :
|
|
begin
|
|
if not tabstractrecordsymtable(sym.owner).is_packed then
|
|
setconst(absoffset+tfieldvarsym(sym).fieldoffset)
|
|
else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then
|
|
setconst(absoffset+tfieldvarsym(sym).fieldoffset div 8)
|
|
else
|
|
Message(asmr_e_packed_element);
|
|
if not size_set_from_absolute then
|
|
setvarsize(tabstractvarsym(sym));
|
|
hasvar:=true;
|
|
SetupVar:=true;
|
|
end;
|
|
staticvarsym,
|
|
localvarsym,
|
|
paravarsym :
|
|
begin
|
|
{ we always assume in asm statements that }
|
|
{ that the variable is valid. }
|
|
tabstractvarsym(sym).varstate:=vs_readwritten;
|
|
inc(tabstractvarsym(sym).refs);
|
|
{ variable can't be placed in a register }
|
|
tabstractvarsym(sym).varregable:=vr_none;
|
|
{ and anything may happen with its address }
|
|
tabstractvarsym(sym).addr_taken:=true;
|
|
case sym.typ of
|
|
staticvarsym :
|
|
begin
|
|
initref;
|
|
opr.ref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(sym).mangledname,AT_DATA);
|
|
Inc(opr.ref.offset,absoffset);
|
|
end;
|
|
paravarsym,
|
|
localvarsym :
|
|
begin
|
|
tmpprocinfo:=current_procinfo;
|
|
while assigned(tmpprocinfo) do
|
|
begin
|
|
if (sym.owner=tmpprocinfo.procdef.localst) or
|
|
(sym.owner=tmpprocinfo.procdef.parast) then
|
|
begin
|
|
tmpprocinfo.procdef.init_paraloc_info(calleeside);
|
|
break;
|
|
end;
|
|
tmpprocinfo:=tmpprocinfo.parent;
|
|
end;
|
|
if opr.typ=OPR_REFERENCE then
|
|
begin
|
|
{$ifdef x86}
|
|
segreg:=opr.ref.segment;
|
|
{$endif x86}
|
|
indexreg:=opr.ref.base;
|
|
if opr.ref.index<>NR_NO then
|
|
begin
|
|
if indexreg=NR_NO then
|
|
indexreg:=opr.ref.index
|
|
else
|
|
Message(asmr_e_multiple_index);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{$ifdef x86}
|
|
segreg:=NR_NO;
|
|
{$endif x86}
|
|
indexreg:=NR_NO;
|
|
end;
|
|
opr.typ:=OPR_LOCAL;
|
|
if assigned(current_procinfo.parent) and
|
|
not(po_inline in current_procinfo.procdef.procoptions) and
|
|
(sym.owner<>current_procinfo.procdef.localst) and
|
|
(sym.owner<>current_procinfo.procdef.parast) and
|
|
(current_procinfo.procdef.localst.symtablelevel>normal_function_level) and
|
|
symtable_has_localvarsyms(current_procinfo.procdef.localst) then
|
|
message1(asmr_e_local_para_unreachable,s);
|
|
opr.localsym:=tabstractnormalvarsym(sym);
|
|
opr.localsymofs:=absoffset;
|
|
{$ifdef x86}
|
|
opr.localsegment:=segreg;
|
|
{$endif x86}
|
|
opr.localindexreg:=indexreg;
|
|
opr.localscale:=0;
|
|
opr.localgetoffset:=GetOffset;
|
|
if paramanager.push_addr_param(tabstractvarsym(sym).varspez,tabstractvarsym(sym).vardef,current_procinfo.procdef.proccalloption) then
|
|
SetSize(sizeof(pint),false);
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
if not size_set_from_absolute then
|
|
setvarsize(tabstractvarsym(sym));
|
|
hasvar:=true;
|
|
SetupVar:=true;
|
|
Exit;
|
|
end;
|
|
constsym :
|
|
begin
|
|
if tconstsym(sym).consttyp=constord then
|
|
begin
|
|
setconst(tconstsym(sym).value.valueord.svalue);
|
|
SetupVar:=true;
|
|
Exit;
|
|
end;
|
|
end;
|
|
typesym :
|
|
begin
|
|
if ttypesym(sym).typedef.typ in [recorddef,objectdef] then
|
|
begin
|
|
setconst(0);
|
|
SetupVar:=TRUE;
|
|
Exit;
|
|
end;
|
|
end;
|
|
procsym :
|
|
begin
|
|
if Tprocsym(sym).ProcdefList.Count>1 then
|
|
Message(asmr_w_calling_overload_func);
|
|
case opr.typ of
|
|
OPR_REFERENCE:
|
|
begin
|
|
opr.ref.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION);
|
|
Inc(opr.ref.offset,absoffset);
|
|
{$ifdef i8086}
|
|
opr.ref_farproc_entry:=is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
|
|
and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions);
|
|
{$endif i8086}
|
|
end;
|
|
OPR_NONE:
|
|
begin
|
|
opr.typ:=OPR_SYMBOL;
|
|
opr.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION);
|
|
{$ifdef i8086}
|
|
opr.sym_farproc_entry:=is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
|
|
and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions);
|
|
{$endif i8086}
|
|
opr.symofs:=absoffset;
|
|
end;
|
|
else
|
|
Message(asmr_e_invalid_operand_type);
|
|
end;
|
|
hasproc:=true;
|
|
hasvar:=true;
|
|
SetupVar:=TRUE;
|
|
Exit;
|
|
end;
|
|
{$ifdef i8086}
|
|
labelsym :
|
|
begin
|
|
case opr.typ of
|
|
OPR_REFERENCE:
|
|
begin
|
|
opr.ref.symbol:=current_asmdata.RefAsmSymbol(tlabelsym(sym).mangledname,AT_FUNCTION);
|
|
Inc(opr.ref.offset,absoffset);
|
|
if opr.ref.segment=NR_NO then
|
|
opr.ref.segment:=NR_CS;
|
|
end;
|
|
else
|
|
begin
|
|
Message(asmr_e_unsupported_symbol_type);
|
|
exit;
|
|
end;
|
|
end;
|
|
haslabelref:=true;
|
|
hasvar:=true;
|
|
SetupVar:=TRUE;
|
|
Exit;
|
|
end
|
|
{$endif i8086}
|
|
else
|
|
begin
|
|
Message(asmr_e_unsupported_symbol_type);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TOperand.InitRef;
|
|
{*********************************************************************}
|
|
{ Description: This routine first check if the opcode is of }
|
|
{ type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. }
|
|
{ If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up }
|
|
{ the operand type to OPR_REFERENCE, as well as setting up the ref }
|
|
{ to point to the default segment. }
|
|
{*********************************************************************}
|
|
var
|
|
l : aint;
|
|
hsymofs : aint;
|
|
hsymbol : tasmsymbol;
|
|
reg : tregister;
|
|
hsym_farprocentry: Boolean;
|
|
Begin
|
|
case opr.typ of
|
|
OPR_REFERENCE :
|
|
exit;
|
|
OPR_CONSTANT :
|
|
begin
|
|
l:=opr.val;
|
|
opr.typ:=OPR_REFERENCE;
|
|
Fillchar(opr.ref,sizeof(treference),0);
|
|
opr.Ref.Offset:=l;
|
|
opr.varsize:=0;
|
|
opr.constoffset:=0;
|
|
opr.ref_farproc_entry:=false;
|
|
end;
|
|
OPR_NONE :
|
|
begin
|
|
opr.typ:=OPR_REFERENCE;
|
|
opr.varsize:=0;
|
|
opr.constoffset:=0;
|
|
opr.ref_farproc_entry:=false;
|
|
Fillchar(opr.ref,sizeof(treference),0);
|
|
end;
|
|
OPR_REGISTER :
|
|
begin
|
|
reg:=opr.reg;
|
|
opr.typ:=OPR_REFERENCE;
|
|
opr.varsize:=0;
|
|
opr.constoffset:=0;
|
|
opr.ref_farproc_entry:=false;
|
|
Fillchar(opr.ref,sizeof(treference),0);
|
|
opr.Ref.base:=reg;
|
|
end;
|
|
OPR_SYMBOL :
|
|
begin
|
|
hsymbol:=opr.symbol;
|
|
hsymofs:=opr.symofs;
|
|
hsym_farprocentry:=opr.sym_farproc_entry;
|
|
opr.typ:=OPR_REFERENCE;
|
|
opr.varsize:=0;
|
|
opr.constoffset:=0;
|
|
Fillchar(opr.ref,sizeof(treference),0);
|
|
opr.ref.symbol:=hsymbol;
|
|
opr.ref.offset:=hsymofs;
|
|
opr.ref_farproc_entry:=hsym_farprocentry;
|
|
end;
|
|
else
|
|
InitRefError;
|
|
end;
|
|
end;
|
|
|
|
procedure TOperand.InitRefConvertLocal;
|
|
var
|
|
localvarsize,localconstoffset: asizeint;
|
|
localsym:tabstractnormalvarsym;
|
|
localsymofs:aint;
|
|
{$ifdef x86}
|
|
localsegment,
|
|
{$endif x86}
|
|
localindexreg:tregister;
|
|
localscale:byte;
|
|
begin
|
|
if opr.typ=OPR_LOCAL then
|
|
begin
|
|
if AsmRegisterPara(opr.localsym) and
|
|
not opr.localgetoffset then
|
|
begin
|
|
localvarsize:=opr.localvarsize;
|
|
localconstoffset:=opr.localconstoffset;
|
|
localsym:=opr.localsym;
|
|
localsymofs:=opr.localsymofs;
|
|
{$ifdef x86}
|
|
localsegment:=opr.localsegment;
|
|
{$endif x86}
|
|
localindexreg:=opr.localindexreg;
|
|
localscale:=opr.localscale;
|
|
opr.typ:=OPR_REFERENCE;
|
|
hasvar:=false;
|
|
Fillchar(opr.ref,sizeof(treference),0);
|
|
opr.varsize:=localvarsize;
|
|
opr.constoffset:=localconstoffset;
|
|
opr.ref_farproc_entry:=false;
|
|
opr.ref.base:=tparavarsym(localsym).paraloc[calleeside].Location^.register;
|
|
opr.ref.offset:=localsymofs;
|
|
{$ifdef x86}
|
|
opr.ref.segment:=localsegment;
|
|
{$endif x86}
|
|
opr.ref.index:=localindexreg;
|
|
opr.ref.scalefactor:=localscale;
|
|
end
|
|
else
|
|
InitRefError;
|
|
end
|
|
else
|
|
InitRef;
|
|
end;
|
|
|
|
procedure TOperand.InitRefError;
|
|
begin
|
|
Message(asmr_e_invalid_operand_type);
|
|
{ Recover }
|
|
opr.typ:=OPR_REFERENCE;
|
|
opr.varsize:=0;
|
|
opr.constoffset:=0;
|
|
opr.ref_farproc_entry:=false;
|
|
Fillchar(opr.ref,sizeof(treference),0);
|
|
end;
|
|
|
|
Function TOperand.CheckOperand(ins : TInstruction): boolean;
|
|
{*********************************************************************}
|
|
{ Description: This routine checks if the operand is of }
|
|
{ valid, and returns false if it isn't. Does nothing by default. }
|
|
{*********************************************************************}
|
|
begin
|
|
result:=true;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TInstruction
|
|
****************************************************************************}
|
|
|
|
constructor TInstruction.create(optype : tcoperand);
|
|
var
|
|
i : longint;
|
|
Begin
|
|
{ these field are set to 0 anyways by the constructor helper (FK)
|
|
Opcode:=A_NONE;
|
|
Condition:=C_NONE;
|
|
Ops:=0;
|
|
}
|
|
filepos:=current_filepos;
|
|
for i:=1 to max_operands do
|
|
Operands[i]:=optype.create;
|
|
Labeled:=false;
|
|
end;
|
|
|
|
|
|
destructor TInstruction.destroy;
|
|
var
|
|
i : longint;
|
|
Begin
|
|
for i:=1 to max_operands do
|
|
Operands[i].free;
|
|
end;
|
|
|
|
|
|
function TInstruction.ConcatInstruction(p:TAsmList) : tai;
|
|
var
|
|
ai : taicpu;
|
|
i : longint;
|
|
begin
|
|
for i:=1 to Ops do
|
|
operands[i].CheckOperand(self);
|
|
|
|
ai:=taicpu.op_none(opcode);
|
|
ai.fileinfo:=filepos;
|
|
ai.Ops:=Ops;
|
|
ai.Allocate_oper(Ops);
|
|
for i:=1 to Ops do
|
|
with operands[i].opr do
|
|
begin
|
|
case typ of
|
|
OPR_CONSTANT :
|
|
ai.loadconst(i-1,val);
|
|
OPR_REGISTER:
|
|
ai.loadreg(i-1,reg);
|
|
OPR_SYMBOL:
|
|
ai.loadsymbol(i-1,symbol,symofs);
|
|
OPR_LOCAL :
|
|
begin
|
|
ai.loadlocal(i-1,localsym,localsymofs,localindexreg,
|
|
localscale,localgetoffset,localforceref);
|
|
{$ifdef x86}
|
|
ai.oper[i-1]^.localoper^.localsegment:=localsegment;
|
|
{$endif x86}
|
|
end;
|
|
OPR_REFERENCE:
|
|
ai.loadref(i-1,ref);
|
|
{$ifdef m68k}
|
|
OPR_REGSET:
|
|
ai.loadregset(i-1,regsetdata,regsetaddr,regsetfpu);
|
|
OPR_REGPAIR:
|
|
ai.loadregpair(i-1,reghi,reglo);
|
|
{$endif}
|
|
{$ifdef ARM}
|
|
OPR_REGSET:
|
|
ai.loadregset(i-1,regtype,subreg,regset,usermode);
|
|
OPR_MODEFLAGS:
|
|
ai.loadmodeflags(i-1,flags);
|
|
OPR_SPECIALREG:
|
|
ai.loadspecialreg(i-1,specialreg,specialregflags);
|
|
{$endif ARM}
|
|
{$if defined(arm) or defined(aarch64)}
|
|
OPR_SHIFTEROP:
|
|
ai.loadshifterop(i-1,shifterop);
|
|
OPR_COND:
|
|
ai.loadconditioncode(i-1,cc);
|
|
{$endif arm or aarch64}
|
|
{$ifdef aarch64}
|
|
OPR_REGSET:
|
|
ai.loadregset(i-1,basereg,nregs,regsetindex);
|
|
OPR_INDEXEDREG:
|
|
ai.loadindexedreg(i-1,indexedreg,regindex);
|
|
{$endif aarch64}
|
|
{$if defined(riscv32) or defined(riscv64)}
|
|
OPR_FENCEFLAGS:
|
|
ai.loadfenceflags(i-1,fenceflags);
|
|
{$endif riscv32 or riscv64}
|
|
{$ifdef wasm32}
|
|
OPR_FLOATCONSTANT:
|
|
case opcode of
|
|
a_f32_const:
|
|
ai.loadsingle(i-1,floatval);
|
|
a_f64_const:
|
|
ai.loaddouble(i-1,floatval);
|
|
else
|
|
internalerror(2024072001);
|
|
end;
|
|
OPR_FUNCTYPE:
|
|
ai.loadfunctype(i-1,functype);
|
|
{$endif wasm32}
|
|
{ ignore wrong operand }
|
|
OPR_NONE:
|
|
;
|
|
else
|
|
internalerror(200501051);
|
|
end;
|
|
end;
|
|
ai.SetCondition(condition);
|
|
{ Concat the opcode or give an error }
|
|
if assigned(ai) then
|
|
p.concat(ai)
|
|
else
|
|
Message(asmr_e_invalid_opcode_and_operand);
|
|
result:=ai;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Symbol table helper routines
|
|
****************************************************************************}
|
|
|
|
procedure AddAbsoluteSymRefs(sym: tabsolutevarsym); forward;
|
|
|
|
procedure MaybeAddSymRef(sym: tsym);
|
|
begin
|
|
case sym.typ of
|
|
absolutevarsym:
|
|
AddAbsoluteSymRefs(tabsolutevarsym(sym));
|
|
staticvarsym:
|
|
if not(vo_is_external in tstaticvarsym(sym).varoptions) then
|
|
cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),tstaticvarsym(sym).vardef,true);
|
|
procsym:
|
|
begin
|
|
{ if it's a pure assembler routine, the definition of the symbol will also
|
|
be in assembler and it can't be removed by the compiler (and if we mark
|
|
it as used anyway, clang will get into trouble) }
|
|
if not(po_assembler in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) and
|
|
not(po_external in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) then
|
|
cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION),tprocdef(tprocsym(sym).ProcdefList[0]),true);
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
procedure AddAbsoluteSymRefs(sym: tabsolutevarsym);
|
|
var
|
|
symlist: ppropaccesslistitem;
|
|
begin
|
|
case sym.abstyp of
|
|
toaddr:
|
|
;
|
|
toasm:
|
|
begin
|
|
cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),sym.vardef,true);
|
|
end;
|
|
tovar:
|
|
begin
|
|
symlist:=tabsolutevarsym(sym).ref.firstsym;
|
|
repeat
|
|
case symlist^.sltype of
|
|
sl_load:
|
|
MaybeAddSymRef(symlist^.sym);
|
|
sl_subscript,
|
|
sl_absolutetype,
|
|
sl_typeconv,
|
|
sl_vec:
|
|
;
|
|
else
|
|
internalerror(2009031401);
|
|
end;
|
|
symlist:=symlist^.next;
|
|
until not assigned(symlist);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure AsmSearchSym(const s:string;out srsym:tsym;out srsymtable:TSymtable);
|
|
var
|
|
i : integer;
|
|
begin
|
|
i:=pos('.',s);
|
|
{ allow unit.identifier }
|
|
if i>1 then
|
|
begin
|
|
searchsym(Copy(s,1,i-1),srsym,srsymtable);
|
|
if assigned(srsym) then
|
|
begin
|
|
if (srsym.typ=unitsym) and
|
|
(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
|
|
srsym.owner.iscurrentunit then
|
|
searchsym_in_module(tunitsym(srsym).module,Copy(s,i+1,255),srsym,srsymtable)
|
|
else
|
|
begin
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
searchsym(s,srsym,srsymtable);
|
|
{ in asm routines, the function result variable, that matches the function
|
|
name should be avoided, because:
|
|
1) there's already a @Result directive (even in TP7) that can be used, if
|
|
you want to access the function result
|
|
2) there's no other way to disambiguate between the function result variable
|
|
and the function's address (using asm syntax only)
|
|
|
|
This fixes code, such as:
|
|
|
|
function test1: word;
|
|
begin
|
|
asm
|
|
mov ax, offset test1
|
|
end;
|
|
end;
|
|
|
|
and makes it work in a consistent manner as this code:
|
|
|
|
procedure test2;
|
|
begin
|
|
asm
|
|
mov ax, offset test2
|
|
end;
|
|
end; }
|
|
if assigned(srsym) and
|
|
assigned(srsymtable) and
|
|
(srsym.typ=absolutevarsym) and
|
|
(vo_is_funcret in tabsolutevarsym(srsym).varoptions) and
|
|
(srsymtable.symtabletype=localsymtable) and
|
|
assigned(srsymtable.defowner) and
|
|
(srsymtable.defowner.typ=procdef) and
|
|
(tprocdef(srsymtable.defowner).procsym.name=tabsolutevarsym(srsym).Name) then
|
|
begin
|
|
srsym:=tprocdef(srsymtable.defowner).procsym;
|
|
srsymtable:=srsym.Owner;
|
|
end;
|
|
{ llvm can't catch symbol references from inline assembler blocks }
|
|
if assigned(srsym) then
|
|
MaybeAddSymRef(srsym);
|
|
end;
|
|
|
|
|
|
Function SearchType(const hs:string;out size:tcgint): Boolean;
|
|
var
|
|
srsym : tsym;
|
|
srsymtable : TSymtable;
|
|
begin
|
|
result:=false;
|
|
size:=0;
|
|
asmsearchsym(hs,srsym,srsymtable);
|
|
if assigned(srsym) and
|
|
(srsym.typ=typesym) then
|
|
begin
|
|
size:=ttypesym(srsym).typedef.size;
|
|
result:=true;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
Function SearchRecordType(const s:string): boolean;
|
|
var
|
|
srsym : tsym;
|
|
srsymtable : TSymtable;
|
|
Begin
|
|
SearchRecordType:=false;
|
|
{ Check the constants in symtable }
|
|
asmsearchsym(s,srsym,srsymtable);
|
|
if srsym <> nil then
|
|
Begin
|
|
case srsym.typ of
|
|
typesym :
|
|
begin
|
|
if ttypesym(srsym).typedef.typ in [recorddef,objectdef] then
|
|
begin
|
|
SearchRecordType:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
fieldvarsym :
|
|
begin
|
|
if (tfieldvarsym(srsym).vardef.typ in [recorddef,objectdef]) then
|
|
begin
|
|
SearchRecordType:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function SearchIConstant(const s:string; var l:tcgint): boolean;
|
|
{**********************************************************************}
|
|
{ Description: Searches for a CONSTANT of name s in either the local }
|
|
{ symbol list, then in the global symbol list, and returns the value }
|
|
{ of that constant in l. Returns TRUE if successfull, if not found, }
|
|
{ or if the constant is not of correct type, then returns FALSE }
|
|
{ Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 }
|
|
{ respectively. }
|
|
{**********************************************************************}
|
|
var
|
|
srsym : tsym;
|
|
srsymtable : TSymtable;
|
|
Begin
|
|
SearchIConstant:=false;
|
|
{ check for TRUE or FALSE reserved words first }
|
|
if s = 'TRUE' then
|
|
Begin
|
|
SearchIConstant:=TRUE;
|
|
l:=1;
|
|
exit;
|
|
end;
|
|
if s = 'FALSE' then
|
|
Begin
|
|
SearchIConstant:=TRUE;
|
|
l:=0;
|
|
exit;
|
|
end;
|
|
{ Check the constants in symtable }
|
|
asmsearchsym(s,srsym,srsymtable);
|
|
if srsym <> nil then
|
|
Begin
|
|
case srsym.typ of
|
|
constsym :
|
|
begin
|
|
if tconstsym(srsym).consttyp=constord then
|
|
Begin
|
|
l:=tconstsym(srsym).value.valueord.svalue;
|
|
SearchIConstant:=TRUE;
|
|
exit;
|
|
end;
|
|
end;
|
|
enumsym:
|
|
Begin
|
|
l:=tenumsym(srsym).value;
|
|
SearchIConstant:=TRUE;
|
|
exit;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function AsmRegisterPara(sym: tabstractnormalvarsym): boolean;
|
|
begin
|
|
result:=
|
|
(po_assembler in current_procinfo.procdef.procoptions) and
|
|
(sym.typ=paravarsym) and
|
|
(tparavarsym(sym).paraloc[calleeside].Location^.Loc=LOC_REGISTER);
|
|
end;
|
|
|
|
|
|
Function GetRecordOffsetSize(s:string;out Offset: tcgint;out Size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean):boolean;
|
|
{ search and returns the offset and size of records/objects of the base }
|
|
{ with field name setup in field. }
|
|
{ returns FALSE if not found. }
|
|
{ used when base is a variable or a typed constant name. }
|
|
var
|
|
st : TSymtable;
|
|
harrdef : tarraydef;
|
|
sym : tsym;
|
|
srsymtable : TSymtable;
|
|
i : longint;
|
|
base : string;
|
|
procdef: tprocdef;
|
|
Begin
|
|
GetRecordOffsetSize:=FALSE;
|
|
Offset:=0;
|
|
Size:=0;
|
|
mangledname:='';
|
|
hastypecast:=false;
|
|
i:=pos('.',s);
|
|
if i=0 then
|
|
i:=255;
|
|
base:=Copy(s,1,i-1);
|
|
delete(s,1,i);
|
|
if base='SELF' then
|
|
st:=current_structdef.symtable
|
|
else
|
|
begin
|
|
asmsearchsym(base,sym,srsymtable);
|
|
{ allow unitname.identifier }
|
|
if assigned(sym) and (sym.typ=unitsym) then
|
|
begin
|
|
i:=pos('.',s);
|
|
if i=0 then
|
|
i:=255;
|
|
base:=base+'.'+Copy(s,1,i-1);
|
|
delete(s,1,i);
|
|
asmsearchsym(base,sym,srsymtable);
|
|
end;
|
|
st:=nil;
|
|
{ we can start with a var,type,typedconst }
|
|
if assigned(sym) then
|
|
case sym.typ of
|
|
staticvarsym,
|
|
localvarsym,
|
|
paravarsym :
|
|
st:=Tabstractvarsym(sym).vardef.GetSymtable(gs_record);
|
|
typesym :
|
|
st:=Ttypesym(sym).typedef.GetSymtable(gs_record);
|
|
else
|
|
;
|
|
end
|
|
else
|
|
s:='';
|
|
end;
|
|
{ now walk all recordsymtables }
|
|
while assigned(st) and (s<>'') do
|
|
begin
|
|
{ load next field in base }
|
|
i:=pos('.',s);
|
|
if i=0 then
|
|
i:=255;
|
|
base:=Copy(s,1,i-1);
|
|
delete(s,1,i);
|
|
sym:=search_struct_member(tabstractrecorddef(st.defowner),base);
|
|
if not assigned(sym) then
|
|
begin
|
|
Message(asmr_e_unknown_field);
|
|
GetRecordOffsetSize:=false;
|
|
exit;
|
|
end;
|
|
st:=nil;
|
|
case sym.typ of
|
|
fieldvarsym :
|
|
with Tfieldvarsym(sym) do
|
|
begin
|
|
if not tabstractrecordsymtable(sym.owner).is_packed then
|
|
inc(Offset,fieldoffset)
|
|
else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then
|
|
inc(Offset,fieldoffset div 8)
|
|
else
|
|
Message(asmr_e_packed_element);
|
|
size:=getsize;
|
|
case vardef.typ of
|
|
arraydef :
|
|
begin
|
|
{ for arrays try to get the element size, take care of
|
|
multiple indexes }
|
|
harrdef:=tarraydef(vardef);
|
|
while assigned(harrdef.elementdef) and
|
|
(harrdef.elementdef.typ=arraydef) do
|
|
harrdef:=tarraydef(harrdef.elementdef);
|
|
if not is_packed_array(harrdef) then
|
|
size:=harrdef.elesize
|
|
else
|
|
begin
|
|
if (harrdef.elepackedbitsize mod 8) <> 0 then
|
|
Message(asmr_e_packed_element);
|
|
size := (harrdef.elepackedbitsize + 7) div 8;
|
|
end;
|
|
end;
|
|
recorddef :
|
|
st:=trecorddef(vardef).symtable;
|
|
objectdef :
|
|
st:=tobjectdef(vardef).symtable;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
procsym:
|
|
begin
|
|
st:=nil;
|
|
if Tprocsym(sym).ProcdefList.Count>1 then
|
|
Message(asmr_w_calling_overload_func);
|
|
procdef:=tprocdef(tprocsym(sym).ProcdefList[0]);
|
|
if (not needvmtofs) then
|
|
begin
|
|
mangledname:=procdef.mangledname;
|
|
end
|
|
else
|
|
begin
|
|
{ can only get the vmtoffset of virtual methods }
|
|
if not(po_virtualmethod in procdef.procoptions) or
|
|
is_objectpascal_helper(procdef.struct) then
|
|
Message1(asmr_e_no_vmtoffset_possible,FullTypeName(procdef,nil))
|
|
else
|
|
begin
|
|
{ size = sizeof(target_system_pointer) }
|
|
size:=sizeof(pint);
|
|
offset:=tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)
|
|
end;
|
|
end;
|
|
{ if something comes after the procsym, it's invalid assembler syntax }
|
|
GetRecordOffsetSize:=(s='');
|
|
exit;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
{ Support Field.Type as typecasting }
|
|
if (st=nil) and (s<>'') then
|
|
begin
|
|
asmsearchsym(s,sym,srsymtable);
|
|
if assigned(sym) and (sym.typ=typesym) then
|
|
begin
|
|
size:=ttypesym(sym).typedef.size;
|
|
s:='';
|
|
hastypecast:=true;
|
|
end;
|
|
end;
|
|
GetRecordOffsetSize:=(s='');
|
|
end;
|
|
|
|
|
|
Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
|
|
var
|
|
sym : tsym;
|
|
srsymtable : TSymtable;
|
|
hs : string;
|
|
Begin
|
|
hl:=nil;
|
|
SearchLabel:=false;
|
|
{ Check for pascal labels, which are case insensetive }
|
|
hs:=upper(s);
|
|
asmsearchsym(hs,sym,srsymtable);
|
|
if sym=nil then
|
|
exit;
|
|
case sym.typ of
|
|
labelsym :
|
|
begin
|
|
if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
|
|
begin
|
|
{$ifndef LLVM}
|
|
{ LLVM compiler requires that the static label RawThunkEnd
|
|
in packages/rtl-objpas/src/rtti.pp unit is set to nonlocal }
|
|
if (srsymtable.symtabletype=globalsymtable) or create_smartlink_library then
|
|
{$endif LLVM}
|
|
Tlabelsym(sym).nonlocal:=true;
|
|
if emit then
|
|
include(current_procinfo.flags,pi_has_interproclabel);
|
|
end;
|
|
if not(assigned(tlabelsym(sym).asmblocklabel)) then
|
|
if Tlabelsym(sym).nonlocal then
|
|
current_asmdata.getglobaljumplabel(tlabelsym(sym).asmblocklabel)
|
|
else
|
|
current_asmdata.getjumplabel(tlabelsym(sym).asmblocklabel);
|
|
hl:=tlabelsym(sym).asmblocklabel;
|
|
if emit then
|
|
begin
|
|
if tlabelsym(sym).defined then
|
|
Message(sym_e_label_already_defined);
|
|
tlabelsym(sym).defined:=true;
|
|
hl.defined_in_asmstatement:=true
|
|
end
|
|
else
|
|
tlabelsym(sym).used:=true;
|
|
SearchLabel:=true;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
|
|
{*************************************************************************}
|
|
{ Instruction Generation Utilities }
|
|
{*************************************************************************}
|
|
|
|
|
|
Procedure ConcatString(p : TAsmList;s:string);
|
|
{*********************************************************************}
|
|
{ PROCEDURE ConcatString(s:string); }
|
|
{ Description: This routine adds the character chain pointed to in }
|
|
{ s to the instruction linked list. }
|
|
{*********************************************************************}
|
|
Begin
|
|
p.concat(Tai_string.Create(s));
|
|
end;
|
|
|
|
|
|
Procedure ConcatConstant(p: TAsmList; value: tcgint; constsize:byte);
|
|
{*********************************************************************}
|
|
{ Description: This routine adds the value constant to the current }
|
|
{ instruction linked list. }
|
|
{*********************************************************************}
|
|
var
|
|
rangelo,rangehi : int64;
|
|
Begin
|
|
case constsize of
|
|
1 :
|
|
begin
|
|
p.concat(Tai_const.Create_8bit(byte(value)));
|
|
rangelo:=low(shortint);
|
|
rangehi:=high(byte);
|
|
end;
|
|
2 :
|
|
begin
|
|
p.concat(Tai_const.Create_16bit(word(value)));
|
|
rangelo:=low(smallint);
|
|
rangehi:=high(word);
|
|
end;
|
|
4 :
|
|
begin
|
|
p.concat(Tai_const.Create_32bit(longint(value)));
|
|
rangelo:=low(longint);
|
|
rangehi:=high(cardinal);
|
|
end;
|
|
8 :
|
|
begin
|
|
p.concat(Tai_const.Create_64bit(int64(value)));
|
|
rangelo:=0;
|
|
rangehi:=0;
|
|
end;
|
|
else
|
|
internalerror(200405011);
|
|
end;
|
|
{ check for out of bounds }
|
|
if (rangelo<>0) and
|
|
((value>rangehi) or (value<rangelo)) then
|
|
Message(asmr_e_constant_out_of_bounds);
|
|
end;
|
|
|
|
|
|
Procedure ConcatConstSymbol(p : TAsmList;const sym,endsym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
|
|
begin
|
|
{$ifdef i8086}
|
|
{ 'DW xx' as well as 'DW OFFSET xx' are just near pointers }
|
|
if constsize=2 then
|
|
p.concat(Tai_const.Createname_near(sym,l))
|
|
else if constsize=4 then
|
|
begin
|
|
if isofs then
|
|
begin
|
|
{ 'DD OFFSET xx' is a 32-bit offset; since we don't produce 32-bit
|
|
relocations yet, just do a 16-bit one and set the high word to 0 }
|
|
p.concat(Tai_const.Createname_near(sym,l));
|
|
p.concat(Tai_const.Create_16bit(0));
|
|
end
|
|
else
|
|
{ 'DD xx' is a far pointer }
|
|
p.concat(Tai_const.Createname_far(sym,l));
|
|
end
|
|
else
|
|
internalerror(2018020701);
|
|
{$else i8086}
|
|
p.concat(Tai_const.Createname(sym,l));
|
|
{$endif i8086}
|
|
end;
|
|
|
|
|
|
Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype);
|
|
{***********************************************************************}
|
|
{ PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); }
|
|
{ Description: This routine adds the value constant to the current }
|
|
{ instruction linked list. }
|
|
{ real_typ -> indicates the type of the real data to initialize: }
|
|
{ s32real -> create a single node. }
|
|
{ s64real -> create a double node. }
|
|
{ s80real -> create an extended node. }
|
|
{ s64bit -> create a comp node. }
|
|
{ f32bit -> create a fixed node. (not used normally) }
|
|
{***********************************************************************}
|
|
Begin
|
|
case real_typ of
|
|
s32real : p.concat(tai_realconst.create_s32real(value));
|
|
s64real :
|
|
{$ifdef ARM}
|
|
if is_double_hilo_swapped then
|
|
p.concat(tai_realconst.create_s64real_hiloswapped(value))
|
|
else
|
|
{$endif ARM}
|
|
p.concat(tai_realconst.create_s64real(value));
|
|
s80real : p.concat(tai_realconst.create_s80real(value,s80floattype.size));
|
|
sc80real : p.concat(tai_realconst.create_s80real(value,sc80floattype.size));
|
|
s64comp : p.concat(tai_realconst.create_s64compreal(trunc(value)));
|
|
else
|
|
internalerror(2014050608);
|
|
end;
|
|
end;
|
|
|
|
Procedure ConcatLabel(p: TAsmList;var l : tasmlabel);
|
|
{*********************************************************************}
|
|
{ PROCEDURE ConcatLabel }
|
|
{ Description: This routine either emits a label or a labeled }
|
|
{ instruction to the linked list of instructions. }
|
|
{*********************************************************************}
|
|
begin
|
|
p.concat(Tai_label.Create(l));
|
|
end;
|
|
|
|
procedure ConcatAlign(p:TAsmList;l:tcgint);
|
|
{*********************************************************************}
|
|
{ PROCEDURE ConcatPublic }
|
|
{ Description: This routine emits an global definition to the }
|
|
{ linked list of instructions.(used by AT&T styled asm) }
|
|
{*********************************************************************}
|
|
begin
|
|
p.concat(Tai_align.Create(l));
|
|
end;
|
|
|
|
procedure ConcatPublic(p:TAsmList;const s : string);
|
|
{*********************************************************************}
|
|
{ PROCEDURE ConcatPublic }
|
|
{ Description: This routine emits an global definition to the }
|
|
{ linked list of instructions.(used by AT&T styled asm) }
|
|
{*********************************************************************}
|
|
begin
|
|
p.concat(Tai_symbol.Createname_global(s,AT_LABEL,0,voidcodepointertype));
|
|
end;
|
|
|
|
procedure ConcatLocal(p:TAsmList;const s : string);
|
|
{*********************************************************************}
|
|
{ PROCEDURE ConcatLocal }
|
|
{ Description: This routine emits an local definition to the }
|
|
{ linked list of instructions. }
|
|
{*********************************************************************}
|
|
begin
|
|
p.concat(Tai_symbol.Createname(s,AT_LABEL,0,voidcodepointertype));
|
|
end;
|
|
|
|
|
|
end.
|