paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-01 19:53:40 +02:00
Code Issues Packages Projects Releases Wiki Activity
99e1e85447
fpc/compiler/x86/rax86int.pas
Jonas Maebe f36e5411af * split cpu64bit compiler define into 
a) cpu64bitaddr, which means that we are generating a compiler which
       will generate code for targets with a 64 bit address space/abi
    b) cpu64bitalu, which means that we are generating a compiler which
       will generate code for a cpu with support for 64 bit integer
       operations (possibly running in a 32 bit address space, depending
       on the cpu64bitaddr define)
   All cpus which had cpu64bit set now have both the above defines set,
   and none of the 32 bit cpus have cpu64bitalu set (and none will
   compile with it currently)
  + pint and puint types, similar to aint/aword (not pword because that
    that conflicts with pword=^word)
  * several changes from aint/aword to pint/pword
  * some changes of tcgsize2size[OS_INT] to sizeof(pint)

git-svn-id: trunk@10320 -
2008-02-13 20:44:00 +00:00

2172 lines
73 KiB
ObjectPascal
Raw Blame History

{
Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
Does the parsing process for the intel styled inline assembler.
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 Rax86int;
{$i fpcdefs.inc}
interface
uses
cclasses,
cpubase,
globtype,
aasmbase,
rasm,
rax86;
type
tasmtoken = (
AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN,
AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,
AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,
{------------------ Assembler directives --------------------}
AS_ALIGN,AS_DB,AS_DW,AS_DD,AS_END,
{------------------ Assembler Operators --------------------}
AS_BYTE,AS_WORD,AS_DWORD,AS_QWORD,AS_TBYTE,AS_DQWORD,AS_NEAR,AS_FAR,
AS_HIGH,AS_LOW,AS_OFFSET,AS_SIZEOF,AS_VMTOFFSET,AS_SEG,AS_TYPE,AS_PTR,AS_MOD,AS_SHL,AS_SHR,AS_NOT,
AS_AND,AS_OR,AS_XOR);
type
tx86intreader = class(tasmreader)
actasmtoken : tasmtoken;
prevasmtoken : tasmtoken;
ActOpsize : topsize;
constructor create;override;
function is_asmopcode(const s: string):boolean;
function is_asmoperator(const s: string):boolean;
function is_asmdirective(const s: string):boolean;
function is_register(const s:string):boolean;
function is_locallabel(const s:string):boolean;
function Assemble: tlinkedlist;override;
procedure GetToken;
function consume(t : tasmtoken):boolean;
procedure RecoverConsume(allowcomma:boolean);
procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean);
procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype);
function BuildConstExpression:aint;
function BuildRefConstExpression:aint;
procedure BuildReference(oper : tx86operand);
procedure BuildOperand(oper: tx86operand;istypecast:boolean);
procedure BuildConstantOperand(oper: tx86operand);
procedure BuildOpCode(instr : tx86instruction);
procedure BuildConstant(constsize: byte);
end;
implementation
uses
{ common }
cutils,
{ global }
globals,verbose,
systems,
{ aasm }
aasmtai,aasmdata,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symdef,symtable,
{ parser }
scanner,
{ register allocator }
rabase,rautils,itx86int,
{ codegen }
cgbase,cgobj,procinfo
;
type
tasmkeyword = string[9];
const
{ These tokens should be modified accordingly to the modifications }
{ in the different enumerations. }
firstdirective = AS_ALIGN;
lastdirective = AS_END;
firstoperator = AS_BYTE;
lastoperator = AS_XOR;
_count_asmdirectives = longint(lastdirective)-longint(firstdirective);
_count_asmoperators = longint(lastoperator)-longint(firstoperator);
_asmdirectives : array[0.._count_asmdirectives] of tasmkeyword =
('ALIGN','DB','DW','DD','END');
{ problems with shl,shr,not,and,or and xor, they are }
{ context sensitive. }
_asmoperators : array[0.._count_asmoperators] of tasmkeyword = (
'BYTE','WORD','DWORD','QWORD','TBYTE','DQWORD','NEAR','FAR','HIGH',
'LOW','OFFSET','SIZEOF','VMTOFFSET','SEG','TYPE','PTR','MOD','SHL','SHR','NOT','AND',
'OR','XOR');
token2str : array[tasmtoken] of string[10] = (
'','Label','LLabel','String','Integer',
',','[',']','(',
')',':','.','+','-','*',
';','identifier','register','opcode','/',
'','','','','END',
'','','','','','','','','',
'','','sizeof','vmtoffset','','type','ptr','mod','shl','shr','not',
'and','or','xor'
);
var
inexpression : boolean;
constructor tx86intreader.create;
var
i : tasmop;
Begin
inherited create;
iasmops:=TFPHashList.create;
for i:=firstop to lastop do
iasmops.Add(upper(std_op2str[i]),Pointer(PtrInt(i)));
end;
{---------------------------------------------------------------------}
{ Routines for the tokenizing }
{---------------------------------------------------------------------}
function tx86intreader.is_asmopcode(const s: string):boolean;
var
cond : string[4];
cnd : tasmcond;
j: longint;
Begin
is_asmopcode:=FALSE;
actopcode:=A_None;
actcondition:=C_None;
actopsize:=S_NO;
{ Search opcodes }
actopcode:=tasmop(PtrInt(iasmops.Find(s)));
if actopcode<>A_NONE then
begin
actasmtoken:=AS_OPCODE;
result:=TRUE;
exit;
end;
{ not found yet, check condition opcodes }
j:=0;
while (j<CondAsmOps) do
begin
if Copy(s,1,Length(CondAsmOpStr[j]))=CondAsmOpStr[j] then
begin
cond:=Copy(s,Length(CondAsmOpStr[j])+1,255);
if cond<>'' then
begin
for cnd:=low(TasmCond) to high(TasmCond) do
if Cond=Upper(cond2str[cnd]) then
begin
actopcode:=CondASmOp[j];
actcondition:=cnd;
is_asmopcode:=TRUE;
actasmtoken:=AS_OPCODE;
exit
end;
end;
end;
inc(j);
end;
end;
function tx86intreader.is_asmoperator(const s: string):boolean;
var
i : longint;
Begin
for i:=0 to _count_asmoperators do
if s=_asmoperators[i] then
begin
actasmtoken:=tasmtoken(longint(firstoperator)+i);
is_asmoperator:=true;
exit;
end;
is_asmoperator:=false;
end;
Function tx86intreader.is_asmdirective(const s: string):boolean;
var
i : longint;
Begin
for i:=0 to _count_asmdirectives do
if s=_asmdirectives[i] then
begin
actasmtoken:=tasmtoken(longint(firstdirective)+i);
is_asmdirective:=true;
exit;
end;
is_asmdirective:=false;
end;
function tx86intreader.is_register(const s:string):boolean;
begin
is_register:=false;
actasmregister:=masm_regnum_search(lower(s));
if actasmregister<>NR_NO then
begin
is_register:=true;
actasmtoken:=AS_REGISTER;
end;
end;
function tx86intreader.is_locallabel(const s:string):boolean;
begin
is_locallabel:=(length(s)>1) and (s[1]='@');
end;
Procedure tx86intreader.GetToken;
var
len : longint;
forcelabel : boolean;
srsym : tsym;
srsymtable : TSymtable;
begin
{ save old token and reset new token }
prevasmtoken:=actasmtoken;
actasmtoken:=AS_NONE;
{ reset }
forcelabel:=FALSE;
actasmpattern:='';
{ while space and tab , continue scan... }
while (c in [' ',#9]) do
c:=current_scanner.asmgetchar;
{ get token pos }
if not (c in [#10,#13,'{',';']) then
current_scanner.gettokenpos;
{ Local Label, Label, Directive, Prefix or Opcode }
if firsttoken and not (c in [#10,#13,'{',';']) then
begin
firsttoken:=FALSE;
len:=0;
while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
begin
{ if there is an at_sign, then this must absolutely be a label }
if c = '@' then
forcelabel:=TRUE;
inc(len);
actasmpattern[len]:=c;
c:=current_scanner.asmgetchar;
end;
actasmpattern[0]:=chr(len);
uppervar(actasmpattern);
{ allow spaces }
while (c in [' ',#9]) do
c:=current_scanner.asmgetchar;
{ label ? }
if c = ':' then
begin
if actasmpattern[1]='@' then
actasmtoken:=AS_LLABEL
else
actasmtoken:=AS_LABEL;
{ let us point to the next character }
c:=current_scanner.asmgetchar;
firsttoken:=true;
exit;
end;
{ Are we trying to create an identifier with }
{ an at-sign...? }
if forcelabel then
Message(asmr_e_none_label_contain_at);
{ opcode ? }
If is_asmopcode(actasmpattern) then
Begin
{ check if we are in an expression }
{ then continue with asm directives }
if not inexpression then
exit;
end;
if is_asmdirective(actasmpattern) then
exit;
message1(asmr_e_unknown_opcode,actasmpattern);
actasmtoken:=AS_NONE;
exit;
end
else { else firsttoken }
begin
case c of
'@' : { possiblities : - local label reference , such as in jmp @local1 }
{ - @Result, @Code or @Data special variables. }
begin
actasmpattern:=c;
c:=current_scanner.asmgetchar;
while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
begin
actasmpattern:=actasmpattern + c;
c:=current_scanner.asmgetchar;
end;
uppervar(actasmpattern);
actasmtoken:=AS_ID;
exit;
end;
'A'..'Z','a'..'z','_': { identifier, register, opcode, prefix or directive }
begin
actasmpattern:=c;
c:=current_scanner.asmgetchar;
while c in ['A'..'Z','a'..'z','0'..'9','_'] do
begin
actasmpattern:=actasmpattern + c;
c:=current_scanner.asmgetchar;
end;
uppervar(actasmpattern);
{ after prefix we allow also a new opcode }
If is_prefix(actopcode) and is_asmopcode(actasmpattern) then
Begin
{ if we are not in a constant }
{ expression than this is an }
{ opcode. }
if not inexpression then
exit;
end;
{ support st(X) for fpu registers }
if (actasmpattern = 'ST') and (c='(') then
Begin
actasmpattern:=actasmpattern+c;
c:=current_scanner.asmgetchar;
{ allow spaces }
while (c in [' ',#9]) do
c:=current_scanner.asmgetchar;
if c in ['0'..'7'] then
actasmpattern:=actasmpattern + c
else
Message(asmr_e_invalid_fpu_register);
c:=current_scanner.asmgetchar;
{ allow spaces }
while (c in [' ',#9]) do
c:=current_scanner.asmgetchar;
if c <> ')' then
Message(asmr_e_invalid_fpu_register)
else
Begin
actasmpattern:=actasmpattern + c;
c:=current_scanner.asmgetchar;
end;
end;
if is_register(actasmpattern) then
exit;
if is_asmdirective(actasmpattern) then
exit;
if is_asmoperator(actasmpattern) then
exit;
{ allow spaces }
while (c in [' ',#9]) do
c:=current_scanner.asmgetchar;
{ if next is a '.' and this is a unitsym then we also need to
parse the identifier }
if (c='.') then
begin
searchsym(actasmpattern,srsym,srsymtable);
if assigned(srsym) and
(srsym.typ=unitsym) and
(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
srsym.owner.iscurrentunit then
begin
{ Add . to create System.Identifier }
actasmpattern:=actasmpattern+c;
c:=current_scanner.asmgetchar;
{ Delphi allows System.@Halt, just ignore the @ }
if c='@' then
c:=current_scanner.asmgetchar;
while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
begin
actasmpattern:=actasmpattern + upcase(c);
c:=current_scanner.asmgetchar;
end;
end;
end;
actasmtoken:=AS_ID;
exit;
end;
'''' : { string or character }
begin
actasmpattern:='';
current_scanner.in_asm_string:=true;
repeat
if c = '''' then
begin
c:=current_scanner.asmgetchar;
if c in [#10,#13] then
begin
Message(scan_f_string_exceeds_line);
break;
end;
repeat
if c='''' then
begin
c:=current_scanner.asmgetchar;
if c='''' then
begin
actasmpattern:=actasmpattern+'''';
c:=current_scanner.asmgetchar;
if c in [#10,#13] then
begin
Message(scan_f_string_exceeds_line);
break;
end;
end
else
break;
end
else
begin
actasmpattern:=actasmpattern+c;
c:=current_scanner.asmgetchar;
if c in [#10,#13] then
begin
Message(scan_f_string_exceeds_line);
break
end;
end;
until false; { end repeat }
end
else
break; { end if }
until false;
current_scanner.in_asm_string:=false;
actasmtoken:=AS_STRING;
exit;
end;
'"' : { string or character }
begin
current_scanner.in_asm_string:=true;
actasmpattern:='';
repeat
if c = '"' then
begin
c:=current_scanner.asmgetchar;
if c in [#10,#13] then
begin
Message(scan_f_string_exceeds_line);
break;
end;
repeat
if c='"' then
begin
c:=current_scanner.asmgetchar;
if c='"' then
begin
actasmpattern:=actasmpattern+'"';
c:=current_scanner.asmgetchar;
if c in [#10,#13] then
begin
Message(scan_f_string_exceeds_line);
break;
end;
end
else
break;
end
else
begin
actasmpattern:=actasmpattern+c;
c:=current_scanner.asmgetchar;
if c in [#10,#13] then
begin
Message(scan_f_string_exceeds_line);
break
end;
end;
until false; { end repeat }
end
else
break; { end if }
until false;
current_scanner.in_asm_string:=false;
actasmtoken:=AS_STRING;
exit;
end;
'$' :
begin
c:=current_scanner.asmgetchar;
while c in ['0'..'9','A'..'F','a'..'f'] do
begin
actasmpattern:=actasmpattern + c;
c:=current_scanner.asmgetchar;
end;
actasmpattern:=tostr(ParseVal(actasmpattern,16));
actasmtoken:=AS_INTNUM;
exit;
end;
'&' : { identifier }
begin
actasmpattern:='';
c:=current_scanner.asmgetchar;
while c in ['A'..'Z','a'..'z','0'..'9','_'] do
begin
actasmpattern:=actasmpattern + c;
c:=current_scanner.asmgetchar;
end;
uppervar(actasmpattern);
actasmtoken:=AS_ID;
exit;
end;
',' :
begin
actasmtoken:=AS_COMMA;
c:=current_scanner.asmgetchar;
exit;
end;
'[' :
begin
actasmtoken:=AS_LBRACKET;
c:=current_scanner.asmgetchar;
exit;
end;
']' :
begin
actasmtoken:=AS_RBRACKET;
c:=current_scanner.asmgetchar;
exit;
end;
'(' :
begin
actasmtoken:=AS_LPAREN;
c:=current_scanner.asmgetchar;
exit;
end;
')' :
begin
actasmtoken:=AS_RPAREN;
c:=current_scanner.asmgetchar;
exit;
end;
':' :
begin
actasmtoken:=AS_COLON;
c:=current_scanner.asmgetchar;
exit;
end;
'.' :
begin
actasmtoken:=AS_DOT;
c:=current_scanner.asmgetchar;
exit;
end;
'+' :
begin
actasmtoken:=AS_PLUS;
c:=current_scanner.asmgetchar;
exit;
end;
'-' :
begin
actasmtoken:=AS_MINUS;
c:=current_scanner.asmgetchar;
exit;
end;
'*' :
begin
actasmtoken:=AS_STAR;
c:=current_scanner.asmgetchar;
exit;
end;
'/' :
begin
actasmtoken:=AS_SLASH;
c:=current_scanner.asmgetchar;
exit;
end;
'0'..'9':
begin
actasmpattern:=c;
c:=current_scanner.asmgetchar;
{ Get the possible characters }
while c in ['0'..'9','A'..'F','a'..'f'] do
begin
actasmpattern:=actasmpattern + c;
c:=current_scanner.asmgetchar;
end;
{ Get ending character }
uppervar(actasmpattern);
c:=upcase(c);
{ possibly a binary number. }
if (actasmpattern[length(actasmpattern)] = 'B') and (c <> 'H') then
Begin
{ Delete the last binary specifier }
delete(actasmpattern,length(actasmpattern),1);
actasmpattern:=tostr(ParseVal(actasmpattern,2));
actasmtoken:=AS_INTNUM;
exit;
end
else
Begin
case c of
'O' :
Begin
actasmpattern:=tostr(ParseVal(actasmpattern,8));
actasmtoken:=AS_INTNUM;
c:=current_scanner.asmgetchar;
exit;
end;
'H' :
Begin
actasmpattern:=tostr(ParseVal(actasmpattern,16));
actasmtoken:=AS_INTNUM;
c:=current_scanner.asmgetchar;
exit;
end;
else { must be an integer number }
begin
actasmpattern:=tostr(ParseVal(actasmpattern,10));
actasmtoken:=AS_INTNUM;
exit;
end;
end;
end;
end;
';','{',#13,#10 :
begin
c:=current_scanner.asmgetchar;
firsttoken:=TRUE;
actasmtoken:=AS_SEPARATOR;
exit;
end;
else
current_scanner.illegal_char(c);
end;
end;
end;
function tx86intreader.consume(t : tasmtoken):boolean;
begin
Consume:=true;
if t<>actasmtoken then
begin
Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
Consume:=false;
end;
repeat
gettoken;
until actasmtoken<>AS_NONE;
end;
procedure tx86intreader.RecoverConsume(allowcomma:boolean);
begin
While not (actasmtoken in [AS_SEPARATOR,AS_END]) do
begin
if allowcomma and (actasmtoken=AS_COMMA) then
break;
Consume(actasmtoken);
end;
end;
{*****************************************************************************
Parsing Helpers
*****************************************************************************}
{ This routine builds up a record offset after a AS_DOT
token is encountered.
On entry actasmtoken should be equal to AS_DOT }
Procedure tx86intreader.BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean);
var
s: string;
Begin
offset:=0;
size:=0;
s:=expr;
while (actasmtoken=AS_DOT) do
begin
Consume(AS_DOT);
if actasmtoken in [AS_BYTE,AS_ID,AS_WORD,AS_DWORD,AS_QWORD] then
begin
s:=s+'.'+actasmpattern;
consume(actasmtoken);
end
else
begin
Consume(AS_ID);
RecoverConsume(true);
break;
end;
end;
if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs) then
Message(asmr_e_building_record_offset);
end;
Procedure tx86intreader.BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype);
var
tempstr,expr,hs,mangledname : string;
parenlevel : longint;
l,k : aint;
hasparen,
errorflag,
needvmtofs : boolean;
prevtok : tasmtoken;
hl : tasmlabel;
hssymtyp : Tasmsymtype;
def : tdef;
sym : tsym;
srsymtable : TSymtable;
Begin
{ reset }
value:=0;
asmsym:='';
asmsymtyp:=AT_DATA;
errorflag:=FALSE;
tempstr:='';
expr:='';
inexpression:=TRUE;
parenlevel:=0;
sym:=nil;
needvmtofs:=FALSE;
Repeat
{ Support ugly delphi constructs like: [ECX].1+2[EDX] }
if isref and (actasmtoken=AS_LBRACKET) then
break;
Case actasmtoken of
AS_LPAREN:
Begin
Consume(AS_LPAREN);
expr:=expr + '(';
inc(parenlevel);
end;
AS_RPAREN:
Begin
{ Keep the AS_PAREN in actasmtoken, it is maybe a typecast }
if parenlevel=0 then
break;
Consume(AS_RPAREN);
expr:=expr + ')';
dec(parenlevel);
end;
AS_SHL:
Begin
Consume(AS_SHL);
expr:=expr + '<';
end;
AS_SHR:
Begin
Consume(AS_SHR);
expr:=expr + '>';
end;
AS_SLASH:
Begin
Consume(AS_SLASH);
expr:=expr + '/';
end;
AS_MOD:
Begin
Consume(AS_MOD);
expr:=expr + '%';
end;
AS_STAR:
Begin
Consume(AS_STAR);
if isref and (actasmtoken=AS_REGISTER) then
break;
expr:=expr + '*';
end;
AS_PLUS:
Begin
Consume(AS_PLUS);
if isref and (actasmtoken=AS_REGISTER) then
break;
expr:=expr + '+';
end;
AS_MINUS:
Begin
Consume(AS_MINUS);
expr:=expr + '-';
end;
AS_AND:
Begin
Consume(AS_AND);
expr:=expr + '&';
end;
AS_NOT:
Begin
Consume(AS_NOT);
expr:=expr + '~';
end;
AS_XOR:
Begin
Consume(AS_XOR);
expr:=expr + '^';
end;
AS_OR:
Begin
Consume(AS_OR);
expr:=expr + '|';
end;
AS_INTNUM:
Begin
expr:=expr + actasmpattern;
Consume(AS_INTNUM);
end;
AS_VMTOFFSET,
AS_OFFSET:
begin
if (actasmtoken = AS_OFFSET) then
needofs:=true
else
needvmtofs:=true;
Consume(actasmtoken);
if actasmtoken<>AS_ID then
Message(asmr_e_offset_without_identifier);
end;
AS_SIZEOF,
AS_TYPE:
begin
l:=0;
hasparen:=false;
Consume(actasmtoken);
if actasmtoken=AS_LPAREN then
begin
hasparen:=true;
Consume(AS_LPAREN);
end;
if actasmtoken<>AS_ID then
Message(asmr_e_type_without_identifier)
else
begin
tempstr:=actasmpattern;
Consume(AS_ID);
if actasmtoken=AS_DOT then
begin
BuildRecordOffsetSize(tempstr,k,l,mangledname,false);
if mangledname<>'' then
{ procsym }
Message(asmr_e_wrong_sym_type);
end
else
begin
searchsym(tempstr,sym,srsymtable);
if assigned(sym) then
begin
case sym.typ of
staticvarsym,
localvarsym,
paravarsym :
l:=tabstractvarsym(sym).getsize;
typesym :
l:=ttypesym(sym).typedef.size;
else
Message(asmr_e_wrong_sym_type);
end;
end
else
Message1(sym_e_unknown_id,tempstr);
end;
end;
str(l, tempstr);
expr:=expr + tempstr;
if hasparen then
Consume(AS_RPAREN);
end;
AS_PTR :
begin
{ Support ugly delphi constructs like <constant> PTR [ref] }
break;
end;
AS_STRING:
begin
l:=0;
case Length(actasmpattern) of
1 :
l:=ord(actasmpattern[1]);
2 :
l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
3 :
l:=ord(actasmpattern[3]) +
Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
4 :
l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
else
Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
end;
str(l, tempstr);
expr:=expr + tempstr;
Consume(AS_STRING);
end;
AS_ID:
begin
hs:='';
hssymtyp:=AT_DATA;
def:=nil;
tempstr:=actasmpattern;
prevtok:=prevasmtoken;
{ stop parsing a constant expression if we find an opcode after a
non-operator like "db $66 mov eax,ebx" }
if (prevtok in [AS_ID,AS_INTNUM,AS_RPAREN]) and
is_asmopcode(actasmpattern) then
break;
consume(AS_ID);
if SearchIConstant(tempstr,l) then
begin
str(l, tempstr);
expr:=expr + tempstr;
end
else
begin
if is_locallabel(tempstr) then
begin
CreateLocalLabel(tempstr,hl,false);
hs:=hl.name;
hssymtyp:=AT_FUNCTION;
end
else
if SearchLabel(tempstr,hl,false) then
begin
hs:=hl.name;
hssymtyp:=AT_FUNCTION;
end
else
begin
searchsym(tempstr,sym,srsymtable);
if assigned(sym) then
begin
case sym.typ of
staticvarsym :
begin
hs:=tstaticvarsym(sym).mangledname;
def:=tstaticvarsym(sym).vardef;
end;
localvarsym,
paravarsym :
begin
Message(asmr_e_no_local_or_para_allowed);
end;
procsym :
begin
if Tprocsym(sym).ProcdefList.Count>1 then
Message(asmr_w_calling_overload_func);
hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname;
hssymtyp:=AT_FUNCTION;
end;
typesym :
begin
if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then
Message(asmr_e_wrong_sym_type);
end;
fieldvarsym :
begin
tempstr:=upper(tdef(sym.owner.defowner).GetTypeName)+'.'+tempstr;
end;
else
Message(asmr_e_wrong_sym_type);
end;
end
else
Message1(sym_e_unknown_id,tempstr);
end;
{ symbol found? }
if hs<>'' then
begin
if asmsym='' then
begin
asmsym:=hs;
asmsymtyp:=hssymtyp;
end
else
Message(asmr_e_cant_have_multiple_relocatable_symbols);
if (expr='') or (expr[length(expr)]='+') then
begin
{ don't remove the + if there could be a record field }
if actasmtoken<>AS_DOT then
delete(expr,length(expr),1);
end
else
if needofs then
begin
if (prevtok<>AS_OFFSET) then
Message(asmr_e_need_offset);
end
else
Message(asmr_e_only_add_relocatable_symbol);
end;
if (actasmtoken=AS_DOT) or
(assigned(sym) and
(sym.typ = fieldvarsym)) then
begin
BuildRecordOffsetSize(tempstr,l,k,hs,needvmtofs);
if hs <> '' then
hssymtyp:=AT_FUNCTION
else
begin
str(l, tempstr);
expr:=expr + tempstr;
end
end
else
begin
if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
delete(expr,length(expr),1);
end;
if (actasmtoken=AS_LBRACKET) and
assigned(def) and
(def.typ=arraydef) then
begin
consume(AS_LBRACKET);
l:=BuildConstExpression;
if l<tarraydef(def).lowrange then
begin
Message(asmr_e_constant_out_of_bounds);
l:=0;
end
else
l:=(l-tarraydef(def).lowrange)*tarraydef(def).elesize;
str(l, tempstr);
expr:=expr + '+' + tempstr;
consume(AS_RBRACKET);
end;
end;
{ check if there are wrong operator used like / or mod etc. }
if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END,AS_RBRACKET]) then
Message(asmr_e_only_add_relocatable_symbol);
end;
AS_ALIGN,
AS_DB,
AS_DW,
AS_DD,
AS_END,
AS_RBRACKET,
AS_SEPARATOR,
AS_COMMA,
AS_COLON:
break;
else
begin
{ write error only once. }
if not errorflag then
Message(asmr_e_invalid_constant_expression);
{ consume tokens until we find COMMA or SEPARATOR }
Consume(actasmtoken);
errorflag:=TRUE;
end;
end;
Until false;
{ calculate expression }
if not ErrorFlag then
value:=CalculateExpression(expr)
else
value:=0;
{ no longer in an expression }
inexpression:=FALSE;
end;
Function tx86intreader.BuildConstExpression:aint;
var
l : aint;
hs : string;
hssymtyp : TAsmsymtype;
begin
BuildConstSymbolExpression(false,false,l,hs,hssymtyp);
if hs<>'' then
Message(asmr_e_relocatable_symbol_not_allowed);
BuildConstExpression:=l;
end;
Function tx86intreader.BuildRefConstExpression:aint;
var
l : aint;
hs : string;
hssymtyp : TAsmsymtype;
begin
BuildConstSymbolExpression(false,true,l,hs,hssymtyp);
if hs<>'' then
Message(asmr_e_relocatable_symbol_not_allowed);
BuildRefConstExpression:=l;
end;
procedure tx86intreader.BuildReference(oper : tx86operand);
var
scale : byte;
k,l : aint;
tempstr,hs : string;
tempsymtyp : tasmsymtype;
code : integer;
hreg : tregister;
GotStar,GotOffset,HadVar,
GotPlus,Negative : boolean;
hl : tasmlabel;
Begin
Consume(AS_LBRACKET);
if not(oper.opr.typ in [OPR_LOCAL,OPR_REFERENCE]) then
oper.InitRef;
GotStar:=false;
GotPlus:=true;
GotOffset:=false;
Negative:=false;
Scale:=0;
repeat
if GotOffset and (actasmtoken<>AS_ID) then
Message(asmr_e_invalid_reference_syntax);
Case actasmtoken of
AS_ID, { Constant reference expression OR variable reference expression }
AS_VMTOFFSET:
Begin
if not GotPlus then
Message(asmr_e_invalid_reference_syntax);
GotStar:=false;
GotPlus:=false;
if (actasmtoken = AS_VMTOFFSET) or
(SearchIConstant(actasmpattern,l) or
SearchRecordType(actasmpattern)) then
begin
l:=BuildRefConstExpression;
GotPlus:=(prevasmtoken=AS_PLUS);
GotStar:=(prevasmtoken=AS_STAR);
case oper.opr.typ of
OPR_LOCAL :
begin
if GotStar then
Message(asmr_e_invalid_reference_syntax);
if negative then
Dec(oper.opr.localsymofs,l)
else
Inc(oper.opr.localsymofs,l);
end;
OPR_REFERENCE :
begin
if GotStar then
oper.opr.ref.scalefactor:=l
else
begin
if negative then
Dec(oper.opr.ref.offset,l)
else
Inc(oper.opr.ref.offset,l);
end;
end;
end;
end
else
Begin
if negative and not oper.hasvar then
Message(asmr_e_only_add_relocatable_symbol)
else if oper.hasvar and not GotOffset and
(not negative or assigned(oper.opr.ref.relsymbol)) then
Message(asmr_e_cant_have_multiple_relocatable_symbols);
HadVar:=oper.hasvar and GotOffset;
tempstr:=actasmpattern;
Consume(AS_ID);
{ typecasting? }
if (actasmtoken=AS_LPAREN) and
SearchType(tempstr,l) then
begin
oper.hastype:=true;
oper.typesize:=l;
Consume(AS_LPAREN);
BuildOperand(oper,true);
Consume(AS_RPAREN);
end
else
if is_locallabel(tempstr) then
begin
CreateLocalLabel(tempstr,hl,false);
oper.InitRef;
if not negative then
begin
oper.opr.ref.symbol:=hl;
oper.hasvar:=true;
end
else
oper.opr.ref.relsymbol:=hl;
end
else
if oper.SetupVar(tempstr,GotOffset) then
begin
{ force OPR_LOCAL to be a reference }
if oper.opr.typ=OPR_LOCAL then
oper.opr.localforceref:=true;
end
else
Message1(sym_e_unknown_id,tempstr);
{ record.field ? }
if actasmtoken=AS_DOT then
begin
BuildRecordOffsetSize(tempstr,l,k,hs,false);
if (hs<>'') then
Message(asmr_e_invalid_symbol_ref);
case oper.opr.typ of
OPR_LOCAL :
inc(oper.opr.localsymofs,l);
OPR_REFERENCE :
inc(oper.opr.ref.offset,l);
end;
end;
if GotOffset then
begin
if oper.hasvar and (oper.opr.ref.base=current_procinfo.framepointer) then
begin
if (oper.opr.typ=OPR_REFERENCE) then
oper.opr.ref.base:=NR_NO;
oper.hasvar:=hadvar;
end
else
begin
if oper.hasvar and hadvar then
Message(asmr_e_cant_have_multiple_relocatable_symbols);
{ should we allow ?? }
end;
end;
end;
GotOffset:=false;
end;
AS_PLUS :
Begin
Consume(AS_PLUS);
Negative:=false;
GotPlus:=true;
GotStar:=false;
Scale:=0;
end;
AS_DOT :
Begin
{ Handle like a + }
Consume(AS_DOT);
Negative:=false;
GotPlus:=true;
GotStar:=false;
Scale:=0;
end;
AS_MINUS :
begin
Consume(AS_MINUS);
Negative:=true;
GotPlus:=true;
GotStar:=false;
Scale:=0;
end;
AS_STAR : { Scaling, with eax*4 order }
begin
Consume(AS_STAR);
hs:='';
l:=0;
case actasmtoken of
AS_LPAREN :
l:=BuildConstExpression;
AS_INTNUM:
Begin
hs:=actasmpattern;
Consume(AS_INTNUM);
end;
AS_REGISTER :
begin
case oper.opr.typ of
OPR_REFERENCE :
begin
if oper.opr.ref.scalefactor=0 then
begin
if scale<>0 then
begin
oper.opr.ref.scalefactor:=scale;
scale:=0;
end
else
Message(asmr_e_wrong_scale_factor);
end
else
Message(asmr_e_invalid_reference_syntax);
end;
OPR_LOCAL :
begin
if oper.opr.localscale=0 then
begin
if scale<>0 then
begin
oper.opr.localscale:=scale;
scale:=0;
end
else
Message(asmr_e_wrong_scale_factor);
end
else
Message(asmr_e_invalid_reference_syntax);
end;
end;
end;
else
Message(asmr_e_invalid_reference_syntax);
end;
if actasmtoken<>AS_REGISTER then
begin
if hs<>'' then
val(hs,l,code);
case oper.opr.typ of
OPR_REFERENCE :
oper.opr.ref.scalefactor:=l;
OPR_LOCAL :
oper.opr.localscale:=l;
end;
if l>9 then
Message(asmr_e_wrong_scale_factor);
end;
GotPlus:=false;
GotStar:=false;
end;
AS_REGISTER :
begin
if not((GotPlus and (not Negative)) or
GotStar) then
Message(asmr_e_invalid_reference_syntax);
hreg:=actasmregister;
Consume(AS_REGISTER);
{ this register will be the index:
1. just read a *
2. next token is a *
3. base register is already used }
case oper.opr.typ of
OPR_LOCAL :
begin
if (oper.opr.localindexreg<>NR_NO) then
Message(asmr_e_multiple_index);
oper.opr.localindexreg:=hreg;
if scale<>0 then
begin
oper.opr.localscale:=scale;
scale:=0;
end;
end;
OPR_REFERENCE :
begin
if (GotStar) or
(actasmtoken=AS_STAR) or
(oper.opr.ref.base<>NR_NO) then
begin
if (oper.opr.ref.index<>NR_NO) then
Message(asmr_e_multiple_index);
oper.opr.ref.index:=hreg;
if scale<>0 then
begin
oper.opr.ref.scalefactor:=scale;
scale:=0;
end;
end
else
oper.opr.ref.base:=hreg;
end;
end;
GotPlus:=false;
GotStar:=false;
end;
AS_OFFSET :
begin
Consume(AS_OFFSET);
GotOffset:=true;
end;
AS_TYPE,
AS_NOT,
AS_STRING,
AS_INTNUM,
AS_LPAREN : { Constant reference expression }
begin
if not GotPlus and not GotStar then
Message(asmr_e_invalid_reference_syntax);
BuildConstSymbolExpression(true,true,l,tempstr,tempsymtyp);
if tempstr<>'' then
begin
if GotStar then
Message(asmr_e_only_add_relocatable_symbol);
if not assigned(oper.opr.ref.symbol) then
oper.opr.ref.symbol:=current_asmdata.RefAsmSymbol(tempstr)
else
Message(asmr_e_cant_have_multiple_relocatable_symbols);
end;
case oper.opr.typ of
OPR_REFERENCE :
begin
if GotStar then
oper.opr.ref.scalefactor:=l
else if (prevasmtoken = AS_STAR) then
begin
if scale<>0 then
scale:=l*scale
else
scale:=l;
end
else
begin
if negative then
Dec(oper.opr.ref.offset,l)
else
Inc(oper.opr.ref.offset,l);
end;
end;
OPR_LOCAL :
begin
if GotStar then
oper.opr.localscale:=l
else if (prevasmtoken = AS_STAR) then
begin
if scale<>0 then
scale:=l*scale
else
scale:=l;
end
else
begin
if negative then
Dec(oper.opr.localsymofs,l)
else
Inc(oper.opr.localsymofs,l);
end;
end;
end;
GotPlus:=(prevasmtoken=AS_PLUS) or
(prevasmtoken=AS_MINUS);
if GotPlus then
negative := prevasmtoken = AS_MINUS;
GotStar:=(prevasmtoken=AS_STAR);
end;
AS_RBRACKET :
begin
if GotPlus or GotStar then
Message(asmr_e_invalid_reference_syntax);
Consume(AS_RBRACKET);
break;
end;
else
Begin
Message(asmr_e_invalid_reference_syntax);
RecoverConsume(true);
break;
end;
end;
until false;
end;
Procedure tx86intreader.BuildConstantOperand(oper: tx86operand);
var
l : aint;
tempstr : string;
tempsymtyp : tasmsymtype;
begin
if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
Message(asmr_e_invalid_operand_type);
BuildConstSymbolExpression(true,false,l,tempstr,tempsymtyp);
if tempstr<>'' then
begin
oper.opr.typ:=OPR_SYMBOL;
oper.opr.symofs:=l;
oper.opr.symbol:=current_asmdata.RefAsmSymbol(tempstr);
end
else
if oper.opr.typ=OPR_NONE then
begin
oper.opr.typ:=OPR_CONSTANT;
oper.opr.val:=l;
end
else
inc(oper.opr.val,l);
end;
Procedure tx86intreader.BuildOperand(oper: tx86operand;istypecast:boolean);
procedure AddLabelOperand(hl:tasmlabel);
begin
if (oper.opr.typ=OPR_NONE) and
is_calljmp(actopcode) then
begin
oper.opr.typ:=OPR_SYMBOL;
oper.opr.symbol:=hl;
end
else
begin
oper.InitRef;
oper.opr.ref.symbol:=hl;
end;
end;
var
expr,
hs : string;
tempreg : tregister;
l : aint;
hl : tasmlabel;
toffset,
tsize : aint;
begin
expr:='';
repeat
if actasmtoken=AS_DOT then
begin
if expr<>'' then
begin
BuildRecordOffsetSize(expr,toffset,tsize,hs,false);
if (oper.opr.typ<>OPR_NONE) and
(hs<>'') then
Message(asmr_e_wrong_sym_type);
oper.SetSize(tsize,true);
{ we have used the size of a field. Reset the typesize of the record }
oper.typesize:=0;
case oper.opr.typ of
OPR_LOCAL :
begin
{ don't allow direct access to fields of parameters, becuase that
will generate buggy code. Allow it only for explicit typecasting
and when the parameter is in a register (delphi compatible) }
if (not oper.hastype) and
(oper.opr.localsym.owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,toffset)
end;
OPR_CONSTANT :
inc(oper.opr.val,toffset);
OPR_REFERENCE :
inc(oper.opr.ref.offset,toffset);
OPR_NONE :
begin
if (hs <> '') then
begin
oper.opr.typ:=OPR_SYMBOL;
oper.opr.symbol:=current_asmdata.RefAsmSymbol(hs);
end
else
begin
oper.opr.typ:=OPR_CONSTANT;
oper.opr.val:=toffset;
end;
end;
OPR_SYMBOL:
Message(asmr_e_invalid_symbol_ref);
else
internalerror(200309222);
end;
expr:='';
end
else
begin
{ See it as a separator }
Consume(AS_DOT);
end;
end;
case actasmtoken of
AS_OFFSET,
AS_SIZEOF,
AS_VMTOFFSET,
AS_TYPE,
AS_NOT,
AS_STRING,
AS_PLUS,
AS_MINUS,
AS_LPAREN,
AS_INTNUM :
begin
case oper.opr.typ of
OPR_REFERENCE :
inc(oper.opr.ref.offset,BuildRefConstExpression);
OPR_LOCAL :
inc(oper.opr.localsymofs,BuildConstExpression);
OPR_NONE,
OPR_CONSTANT :
BuildConstantOperand(oper);
else
Message(asmr_e_invalid_operand_type);
end;
end;
AS_PTR :
begin
if not oper.hastype then
begin
if (oper.opr.typ=OPR_CONSTANT) then
begin
oper.typesize:=oper.opr.val;
{ reset constant value of operand }
oper.opr.typ:=OPR_NONE;
oper.opr.val:=0;
end
else
Message(asmr_e_syn_operand);
end;
Consume(AS_PTR);
oper.InitRef;
BuildOperand(oper,false);
end;
AS_ID : { A constant expression, or a Variable ref. }
Begin
{ Label or Special symbol reference? }
if actasmpattern[1] = '@' then
Begin
if actasmpattern = '@RESULT' then
Begin
oper.SetupResult;
Consume(AS_ID);
end
else
if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
begin
Message(asmr_w_CODE_and_DATA_not_supported);
Consume(AS_ID);
end
else
{ Local Label }
begin
CreateLocalLabel(actasmpattern,hl,false);
Consume(AS_ID);
AddLabelOperand(hl);
end;
end
else
{ support result for delphi modes }
if (m_objpas in current_settings.modeswitches) and (actasmpattern='RESULT') then
begin
oper.SetUpResult;
Consume(AS_ID);
end
{ probably a variable or normal expression }
{ or a procedure (such as in CALL ID) }
else
Begin
{ is it a constant ? }
if SearchIConstant(actasmpattern,l) then
Begin
case oper.opr.typ of
OPR_REFERENCE :
inc(oper.opr.ref.offset,BuildRefConstExpression);
OPR_LOCAL :
inc(oper.opr.localsymofs,BuildRefConstExpression);
OPR_NONE,
OPR_CONSTANT :
BuildConstantOperand(oper);
else
Message(asmr_e_invalid_operand_type);
end;
end
else
{ Check for pascal label }
if SearchLabel(actasmpattern,hl,false) then
begin
Consume(AS_ID);
AddLabelOperand(hl);
end
else
{ is it a normal variable ? }
Begin
expr:=actasmpattern;
Consume(AS_ID);
{ typecasting? }
if SearchType(expr,l) then
begin
oper.hastype:=true;
oper.typesize:=l;
case actasmtoken of
AS_LPAREN :
begin
{ Support Type([Reference]) }
Consume(AS_LPAREN);
BuildOperand(oper,true);
Consume(AS_RPAREN);
end;
AS_LBRACKET :
begin
{ Support Var.Type[Index] }
{ Convert @label.Byte[1] to reference }
if oper.opr.typ=OPR_SYMBOL then
oper.initref;
end;
end;
end
else
begin
if not oper.SetupVar(expr,false) then
Begin
{ not a variable, check special variables.. }
if expr = 'SELF' then
oper.SetupSelf
else
Message1(sym_e_unknown_id,expr);
expr:='';
end;
end;
end;
end;
end;
AS_REGISTER : { Register, a variable reference or a constant reference }
begin
{ save the type of register used. }
tempreg:=actasmregister;
Consume(AS_REGISTER);
if actasmtoken = AS_COLON then
Begin
Consume(AS_COLON);
oper.InitRef;
oper.opr.ref.segment:=tempreg;
BuildReference(oper);
end
else
{ Simple register }
begin
if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
Message(asmr_e_invalid_operand_type);
oper.opr.typ:=OPR_REGISTER;
oper.opr.reg:=tempreg;
oper.SetSize(tcgsize2size[reg_cgsize(oper.opr.reg)],true);
end;
end;
AS_LBRACKET: { a variable reference, register ref. or a constant reference }
Begin
BuildReference(oper);
end;
AS_SEG :
Begin
Message(asmr_e_seg_not_supported);
Consume(actasmtoken);
end;
AS_DWORD,
AS_BYTE,
AS_WORD,
AS_TBYTE,
AS_DQWORD,
AS_QWORD :
begin
{ Type specifier }
oper.hastype:=true;
oper.typesize:=0;
case actasmtoken of
AS_DWORD : oper.typesize:=4;
AS_WORD : oper.typesize:=2;
AS_BYTE : oper.typesize:=1;
AS_QWORD : oper.typesize:=8;
AS_DQWORD : oper.typesize:=16;
AS_TBYTE : oper.typesize:=10;
end;
Consume(actasmtoken);
if (actasmtoken=AS_LPAREN) then
begin
{ Support Type([Reference]) }
Consume(AS_LPAREN);
BuildOperand(oper,true);
Consume(AS_RPAREN);
end;
end;
AS_SEPARATOR,
AS_END,
AS_COMMA,
AS_COLON:
begin
break;
end;
AS_RPAREN:
begin
if not istypecast then
begin
Message(asmr_e_syn_operand);
Consume(AS_RPAREN);
end
else
break;
end;
else
begin
Message(asmr_e_syn_operand);
RecoverConsume(true);
break;
end;
end;
until false;
{ End of operand, update size if a typecast is forced }
if (oper.typesize<>0) and
(oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL]) then
oper.SetSize(oper.typesize,true);
end;
Procedure tx86intreader.BuildOpCode(instr : tx86instruction);
var
PrefixOp,OverrideOp: tasmop;
operandnum : longint;
is_far_const:boolean;
i:byte;
begin
PrefixOp:=A_None;
OverrideOp:=A_None;
is_far_const:=false;
{ prefix seg opcode / prefix opcode }
repeat
if is_prefix(actopcode) then
with instr do
begin
OpOrder:=op_intel;
PrefixOp:=ActOpcode;
opcode:=ActOpcode;
condition:=ActCondition;
opsize:=ActOpsize;
ConcatInstruction(curlist);
consume(AS_OPCODE);
end
else
if is_override(actopcode) then
with instr do
begin
OpOrder:=op_intel;
OverrideOp:=ActOpcode;
opcode:=ActOpcode;
condition:=ActCondition;
opsize:=ActOpsize;
ConcatInstruction(curlist);
consume(AS_OPCODE);
end
else
break;
{ allow for newline after prefix or override }
while actasmtoken=AS_SEPARATOR do
consume(AS_SEPARATOR);
until (actasmtoken<>AS_OPCODE);
{ opcode }
if (actasmtoken <> AS_OPCODE) then
begin
Message(asmr_e_invalid_or_missing_opcode);
RecoverConsume(false);
exit;
end;
{ Fill the instr object with the current state }
with instr do
begin
OpOrder:=op_intel;
Opcode:=ActOpcode;
condition:=ActCondition;
opsize:=ActOpsize;
{ Valid combination of prefix/override and instruction ? }
if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then
Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern);
if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then
Message1(asmr_e_invalid_override_and_opcode,actasmpattern);
end;
{ We are reading operands, so opcode will be an AS_ID }
operandnum:=1;
is_far_const:=false;
Consume(AS_OPCODE);
{ Zero operand opcode ? }
if actasmtoken in [AS_SEPARATOR,AS_END] then
begin
operandnum:=0;
exit;
end;
{ Read Operands }
repeat
case actasmtoken of
{ End of asm operands for this opcode }
AS_END,
AS_SEPARATOR :
break;
{ Operand delimiter }
AS_COMMA :
begin
if operandnum > Max_Operands then
Message(asmr_e_too_many_operands)
else
Inc(operandnum);
Consume(AS_COMMA);
end;
{Far constant, i.e. jmp $0000:$11111111.}
AS_COLON:
begin
is_far_const:=true;
if operandnum>1 then
message(asmr_e_too_many_operands)
else
inc(operandnum);
consume(AS_COLON);
end;
{ Type specifier }
AS_NEAR,
AS_FAR :
begin
if actasmtoken = AS_NEAR then
begin
Message(asmr_w_near_ignored);
instr.opsize:=S_NEAR;
end
else
begin
Message(asmr_w_far_ignored);
instr.opsize:=S_FAR;
end;
Consume(actasmtoken);
if actasmtoken=AS_PTR then
begin
Consume(AS_PTR);
instr.Operands[operandnum].InitRef;
end;
BuildOperand(instr.Operands[operandnum] as tx86operand,false);
end;
else
BuildOperand(instr.Operands[operandnum] as tx86operand,false);
end; { end case }
until false;
instr.ops:=operandnum;
{ Check operands }
for i:=1 to operandnum do
begin
if is_far_const and
(instr.operands[i].opr.typ<>OPR_CONSTANT) then
message(asmr_e_expr_illegal)
else
if instr.operands[i].opr.typ=OPR_NONE then
Message(asmr_e_syntax_error);
end;
{ e.g. for "push dword 1", "push word 6" }
if (instr.ops=1) and
(instr.operands[1].typesize<>0) then
instr.operands[1].setsize(instr.operands[1].typesize,false);
end;
Procedure tx86intreader.BuildConstant(constsize: byte);
var
asmsymtyp : tasmsymtype;
asmsym,
expr: string;
value : aint;
Begin
Repeat
Case actasmtoken of
AS_STRING:
Begin
{ DD and DW cases }
if constsize <> 1 then
Begin
if Not PadZero(actasmpattern,constsize) then
Message(scan_f_string_exceeds_line);
end;
expr:=actasmpattern;
Consume(AS_STRING);
Case actasmtoken of
AS_COMMA:
Consume(AS_COMMA);
AS_END,
AS_SEPARATOR: ;
else
Message(asmr_e_invalid_string_expression);
end;
ConcatString(curlist,expr);
end;
AS_PLUS,
AS_MINUS,
AS_LPAREN,
AS_NOT,
AS_INTNUM,
AS_ID :
Begin
BuildConstSymbolExpression(false,false,value,asmsym,asmsymtyp);
if asmsym<>'' then
begin
if constsize<>sizeof(pint) then
Message1(asmr_w_const32bit_for_address,asmsym);
ConcatConstSymbol(curlist,asmsym,asmsymtyp,value)
end
else
ConcatConstant(curlist,value,constsize);
end;
AS_COMMA:
begin
Consume(AS_COMMA);
end;
AS_ALIGN,
AS_DB,
AS_DW,
AS_DD,
AS_OPCODE,
AS_END,
AS_SEPARATOR:
break;
else
begin
Message(asmr_e_syn_constant);
RecoverConsume(false);
end
end;
Until false;
end;
function tx86intreader.Assemble: tlinkedlist;
Var
hl : tasmlabel;
instr : Tx86Instruction;
Begin
Message1(asmr_d_start_reading,'intel');
inexpression:=FALSE;
firsttoken:=TRUE;
{ sets up all opcode and register tables in uppercase
done in the construtor now
if not _asmsorted then
Begin
SetupTables;
_asmsorted:=TRUE;
end;
}
curlist:=TAsmList.Create;
{ setup label linked list }
LocalLabelList:=TLocalLabelList.Create;
{ start tokenizer }
c:=current_scanner.asmgetcharstart;
gettoken;
{ main loop }
repeat
case actasmtoken of
AS_LLABEL:
Begin
if CreateLocalLabel(actasmpattern,hl,true) then
ConcatLabel(curlist,hl);
Consume(AS_LLABEL);
end;
AS_LABEL:
Begin
if SearchLabel(upper(actasmpattern),hl,true) then
ConcatLabel(curlist,hl)
else
Message1(asmr_e_unknown_label_identifier,actasmpattern);
Consume(AS_LABEL);
end;
AS_DW :
Begin
inexpression:=true;
Consume(AS_DW);
BuildConstant(2);
inexpression:=false;
end;
AS_DB :
Begin
inexpression:=true;
Consume(AS_DB);
BuildConstant(1);
inexpression:=false;
end;
AS_DD :
Begin
inexpression:=true;
Consume(AS_DD);
BuildConstant(4);
inexpression:=false;
end;
AS_ALIGN:
Begin
Consume(AS_ALIGN);
ConcatAlign(curlist,BuildConstExpression);
if actasmtoken<>AS_SEPARATOR then
Consume(AS_SEPARATOR);
end;
AS_OPCODE :
Begin
instr:=Tx86Instruction.Create(Tx86Operand);
BuildOpcode(instr);
with instr do
begin
{ We need AT&T style operands }
Swapoperands;
{ Must be done with args in ATT order }
CheckNonCommutativeOpcodes;
AddReferenceSizes;
SetInstructionOpsize;
CheckOperandSizes;
ConcatInstruction(curlist);
end;
instr.Free;
end;
AS_SEPARATOR :
Begin
Consume(AS_SEPARATOR);
end;
AS_END :
break; { end assembly block }
else
Begin
Message(asmr_e_syntax_error);
RecoverConsume(false);
end;
end; { end case }
until false;
{ Check LocalLabelList }
LocalLabelList.CheckEmitted;
LocalLabelList.Free;
{ Return the list in an asmnode }
assemble:=curlist;
Message1(asmr_d_finish_reading,'intel');
end;
end.
Reference in New Issue View Git Blame Copy Permalink