mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-05 16:52:33 +02:00
4cf2a2672a
* changed most of the variables in the assembler readers used to store constants from aint to tcgint as aint has only the size of the accumular while some CPUs (AVR) allow larger constants in instructions + allow access to absolute symbols with address type in inline assembler * allow absolute addresses in avr inline assembler + tests git-svn-id: trunk@37411 -
1792 lines
64 KiB
ObjectPascal
1792 lines
64 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2000 by Carl Eric Codere
|
|
|
|
This unit does the parsing process for the motorola 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 ra68kmot;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
{**********************************************************************}
|
|
{ WARNING }
|
|
{**********************************************************************}
|
|
{ Any modification in the order or removal of terms in the tables }
|
|
{ in m68k.pas and asmo68k.pas will BREAK the code in this unit, }
|
|
{ unless the appropriate changes are made to this unit. Addition }
|
|
{ of terms though, will not change the code herein. }
|
|
{**********************************************************************}
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ LEFT TO DO }
|
|
{---------------------------------------------------------------------------}
|
|
{ o Add support for sized indexing such as in d0.l }
|
|
{ presently only (an,dn) is supported for indexing -- }
|
|
{ size defaults to LONG. }
|
|
{ o Add support for MC68020 opcodes. }
|
|
{ o Add support for MC68020 adressing modes. }
|
|
{ o Add operand checking with m68k opcode table in ConcatOpCode }
|
|
{ o Add Floating point support }
|
|
{---------------------------------------------------------------------------}
|
|
|
|
interface
|
|
|
|
|
|
uses
|
|
cutils,
|
|
globtype,cclasses,cpubase,
|
|
symconst,
|
|
aasmbase,
|
|
rabase,rasm,ra68k,rautils;
|
|
|
|
type
|
|
tasmtoken = (
|
|
AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_HEXNUM,AS_OCTALNUM,
|
|
AS_BINNUM,AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN,
|
|
AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,AS_INTNUM,
|
|
AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_APPT,AS_REALNUM,
|
|
AS_ALIGN,
|
|
{------------------ Assembler directives --------------------}
|
|
AS_DB,AS_DW,AS_DD,AS_XDEF,AS_END,
|
|
{------------------ Assembler Operators --------------------}
|
|
AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR);
|
|
|
|
tasmtokenset = set of tasmtoken;
|
|
tasmkeyword = string[10];
|
|
|
|
tm68kmotreader = class(tasmreader)
|
|
actasmtoken : tasmtoken;
|
|
prevasmtoken : tasmtoken;
|
|
procedure SetupTables;
|
|
function Assemble: tlinkedlist;override;
|
|
function is_asmopcode(const s: string) : boolean;
|
|
Function is_asmdirective(const s: string):boolean;
|
|
function is_register(const s:string):boolean;
|
|
procedure GetToken;
|
|
function consume(t : tasmtoken):boolean;
|
|
function try_to_consume(t : tasmtoken):boolean;
|
|
procedure consume_all_until(tokens : tasmtokenset);
|
|
function findopcode(const s: string; var opsize: topsize): tasmop;
|
|
Function BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint;
|
|
Procedure BuildConstant(maxvalue: longint);
|
|
Procedure BuildRealConstant(typ : tfloattype);
|
|
Procedure BuildScaling(const oper:tm68koperand);
|
|
Function BuildRefExpression: longint;
|
|
procedure BuildReference(const oper:tm68koperand);
|
|
procedure BuildRegList(const oper:tm68koperand);
|
|
procedure BuildRegPair(const oper:tm68koperand);
|
|
Procedure BuildOperand(const oper:tm68koperand);
|
|
Procedure BuildOpCode(instr:Tm68kinstruction);
|
|
end;
|
|
|
|
|
|
Implementation
|
|
|
|
uses
|
|
{ global }
|
|
globals,verbose,
|
|
systems,
|
|
{ aasm }
|
|
cpuinfo,aasmtai,aasmdata,aasmcpu,
|
|
cgbase,cgutils,
|
|
{ symtable }
|
|
symbase,symtype,symsym,symdef,symtable,
|
|
{ pass 1 }
|
|
nbas,
|
|
{ parser }
|
|
scanner,ag68kgas,
|
|
itcpugas
|
|
;
|
|
|
|
const
|
|
firstdirective = AS_DB;
|
|
lastdirective = AS_END;
|
|
firstoperator = AS_MOD;
|
|
lastoperator = AS_XOR;
|
|
|
|
_count_asmdirectives = longint(lastdirective)-longint(firstdirective);
|
|
_count_asmoperators = longint(lastoperator)-longint(firstoperator);
|
|
|
|
_asmdirectives : array[0.._count_asmdirectives] of tasmkeyword =
|
|
('DC.B','DC.W','DC.L','XDEF','END');
|
|
|
|
{ problems with shl,shr,not,and,or and xor, they are }
|
|
{ context sensitive. }
|
|
_asmoperators : array[0.._count_asmoperators] of tasmkeyword = (
|
|
'MOD','SHL','SHR','NOT','AND','OR','XOR');
|
|
|
|
token2str : array[tasmtoken] of tasmkeyword=(
|
|
'NONE','LABEL','LLABEL','STRING','HEXNUM','OCTALNUM',
|
|
'BINNUM',',','[',']','(',
|
|
')',':','.','+','-','*','INTNUM',
|
|
'SEPARATOR','ID','REGISTER','OPCODE','/','APPT','REALNUM',
|
|
'ALIGN',
|
|
{------------------ Assembler directives --------------------}
|
|
'DB','DW','DD','XDEF','END',
|
|
{------------------ Assembler Operators --------------------}
|
|
'MOD','SHL','SHR','NOT','AND','OR','XOR');
|
|
|
|
const
|
|
firsttoken : boolean = TRUE;
|
|
operandnum : byte = 0;
|
|
|
|
procedure tm68kmotreader.SetupTables;
|
|
{ creates uppercased symbol tables for speed access }
|
|
var
|
|
i : tasmop;
|
|
Begin
|
|
{ opcodes }
|
|
iasmops:=TFPHashList.create;
|
|
for i:=firstop to lastop do
|
|
iasmops.Add(upper(gas_op2str[i]),Pointer(PtrInt(i)));
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------}
|
|
{ Routines for the tokenizing }
|
|
{---------------------------------------------------------------------}
|
|
|
|
function tm68kmotreader.is_asmopcode(const s: string):boolean;
|
|
var
|
|
hs : string;
|
|
j : byte;
|
|
begin
|
|
is_asmopcode:=false;
|
|
{ first of all we remove the suffix }
|
|
j:=pos('.',s);
|
|
if j>0 then
|
|
hs:=copy(s,1,j-1)
|
|
else
|
|
hs:=s;
|
|
|
|
{ Search opcodes }
|
|
actopcode:=tasmop(PtrUInt(iasmops.Find(hs)));
|
|
{ Also filter the helper opcodes, they can't be valid
|
|
while reading an assembly source }
|
|
if not (actopcode in
|
|
[A_NONE, A_LABEL, A_DBXX, A_SXX, A_BXX, A_FBXX]) then
|
|
begin
|
|
actasmtoken:=AS_OPCODE;
|
|
result:=TRUE;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
Function tm68kmotreader.is_asmdirective(const s: string):boolean;
|
|
var
|
|
i:byte;
|
|
begin
|
|
result:=false;
|
|
for i:=0 to _count_asmdirectives do
|
|
begin
|
|
if s=_asmdirectives[i] then
|
|
begin
|
|
actasmtoken := tasmtoken(longint(firstdirective)+i);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tm68kmotreader.is_register(const s:string):boolean;
|
|
begin
|
|
result:=false;
|
|
actasmregister:=std_regnum_search(lower(s));
|
|
if actasmregister<>NR_NO then
|
|
begin
|
|
result:=true;
|
|
actasmtoken:=AS_REGISTER;
|
|
end;
|
|
{ reg found?
|
|
possible aliases are always 2 char
|
|
}
|
|
if result or (length(s)<>2) then
|
|
exit;
|
|
if lower(s)='sp' then
|
|
actasmregister:=NR_STACK_POINTER_REG;
|
|
if lower(s)='fp' then
|
|
actasmregister:=NR_FRAME_POINTER_REG;
|
|
if actasmregister<>NR_NO then
|
|
begin
|
|
result:=true;
|
|
actasmtoken:=AS_REGISTER;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure tm68kmotreader.GetToken;
|
|
{*********************************************************************}
|
|
{ FUNCTION GetToken: tinteltoken; }
|
|
{ Description: This routine returns intel assembler tokens and }
|
|
{ does some minor syntax error checking. }
|
|
{*********************************************************************}
|
|
var
|
|
token: tasmtoken;
|
|
forcelabel: boolean;
|
|
begin
|
|
c:=scanner.c;
|
|
forcelabel := FALSE;
|
|
actasmpattern :='';
|
|
{* INIT TOKEN TO NOTHING *}
|
|
token := AS_NONE;
|
|
{ while space and tab , continue scan... }
|
|
while c in [' ',#9] do
|
|
c:=current_scanner.asmgetchar;
|
|
|
|
if not (c in [#10,#13,'{',';','(','/']) then
|
|
current_scanner.gettokenpos;
|
|
{ Possiblities for first token in a statement: }
|
|
{ Local Label, Label, Directive, Prefix or Opcode.... }
|
|
if firsttoken and not (c in [#10,#13,'{',';','(','/']) then
|
|
begin
|
|
|
|
firsttoken := FALSE;
|
|
if c = '@' then
|
|
begin
|
|
token := AS_LLABEL; { this is a local label }
|
|
{ Let us point to the next character }
|
|
c := current_scanner.asmgetchar;
|
|
end;
|
|
|
|
|
|
|
|
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;
|
|
actasmpattern := actasmpattern + c;
|
|
c := current_scanner.asmgetchar;
|
|
end;
|
|
|
|
uppervar(actasmpattern);
|
|
|
|
if c = ':' then
|
|
begin
|
|
case token of
|
|
AS_NONE: token := AS_LABEL;
|
|
AS_LLABEL: ; { do nothing }
|
|
end; { end case }
|
|
{ let us point to the next character }
|
|
c := current_scanner.asmgetchar;
|
|
actasmtoken := token;
|
|
exit;
|
|
end;
|
|
|
|
{ Are we trying to create an identifier with }
|
|
{ an at-sign...? }
|
|
if forcelabel then
|
|
Message(asmr_e_none_label_contain_at);
|
|
|
|
If is_asmopcode(actasmpattern) then
|
|
exit;
|
|
if is_asmdirective(actasmpattern) then
|
|
exit
|
|
else
|
|
begin
|
|
actasmtoken := AS_NONE;
|
|
Message1(asmr_e_invalid_or_missing_opcode,actasmpattern);
|
|
end;
|
|
end
|
|
else { else firsttoken }
|
|
{ Here we must handle all possible cases }
|
|
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;
|
|
{ identifier, register, opcode, prefix or directive }
|
|
'A'..'Z','a'..'z','_': 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);
|
|
|
|
{ this isn't the first token, so it can't be an
|
|
opcode }
|
|
{ Actually, it's possible, since @label: OPCODE foo,bar
|
|
is valid and was supported in 0.99/1.0 FPC for 68k,
|
|
the amunits package is full of such code. (KB) }
|
|
if is_asmopcode(actasmpattern) then
|
|
exit;
|
|
if is_register(actasmpattern) then
|
|
exit;
|
|
if is_asmdirective(actasmpattern) then
|
|
exit;
|
|
{ this is surely an identifier }
|
|
actasmtoken := AS_ID;
|
|
exit;
|
|
end;
|
|
{ override operator... not supported }
|
|
'&': begin
|
|
c:=current_scanner.asmgetchar;
|
|
actasmtoken := AS_AND;
|
|
end;
|
|
{ string or character }
|
|
'''' :
|
|
begin
|
|
actasmpattern:='';
|
|
while true do
|
|
begin
|
|
if c = '''' then
|
|
begin
|
|
c:=current_scanner.asmgetchar;
|
|
if c=#10 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=#10 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=#10 then
|
|
begin
|
|
Message(scan_f_string_exceeds_line);
|
|
break
|
|
end;
|
|
end;
|
|
until false; { end repeat }
|
|
end
|
|
else break; { end if }
|
|
end; { end while }
|
|
token:=AS_STRING;
|
|
actasmtoken := token;
|
|
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;
|
|
actasmtoken := AS_HEXNUM;
|
|
exit;
|
|
end;
|
|
',' : begin
|
|
actasmtoken := AS_COMMA;
|
|
c:=current_scanner.asmgetchar;
|
|
exit;
|
|
end;
|
|
'(' : begin
|
|
c:=current_scanner.asmgetchar;
|
|
if c='*' then
|
|
begin
|
|
current_scanner.skipoldtpcomment(true);
|
|
GetToken;
|
|
end
|
|
else
|
|
actasmtoken:=AS_LPAREN;
|
|
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
|
|
c:=current_scanner.asmgetchar;
|
|
if c='/' then
|
|
begin
|
|
current_scanner.skipdelphicomment;
|
|
GetToken;
|
|
end
|
|
else
|
|
actasmtoken := AS_SLASH;
|
|
exit;
|
|
end;
|
|
'<' : begin
|
|
c := current_scanner.asmgetchar;
|
|
{ invalid characters }
|
|
if c <> '<' then
|
|
Message(asmr_e_invalid_char_smaller);
|
|
{ still assume << }
|
|
actasmtoken := AS_SHL;
|
|
c := current_scanner.asmgetchar;
|
|
exit;
|
|
end;
|
|
'>' : begin
|
|
c := current_scanner.asmgetchar;
|
|
{ invalid characters }
|
|
if c <> '>' then
|
|
Message(asmr_e_invalid_char_greater);
|
|
{ still assume << }
|
|
actasmtoken := AS_SHR;
|
|
c := current_scanner.asmgetchar;
|
|
exit;
|
|
end;
|
|
'|' : begin
|
|
actasmtoken := AS_OR;
|
|
c := current_scanner.asmgetchar;
|
|
exit;
|
|
end;
|
|
'^' : begin
|
|
actasmtoken := AS_XOR;
|
|
c := current_scanner.asmgetchar;
|
|
exit;
|
|
end;
|
|
'#' : begin
|
|
actasmtoken:=AS_APPT;
|
|
c:=current_scanner.asmgetchar;
|
|
exit;
|
|
end;
|
|
'%' : begin
|
|
c:=current_scanner.asmgetchar;
|
|
while c in ['0','1'] do
|
|
begin
|
|
actasmpattern := actasmpattern + c;
|
|
c := current_scanner.asmgetchar;
|
|
end;
|
|
actasmtoken := AS_BINNUM;
|
|
exit;
|
|
end;
|
|
{ integer number }
|
|
'0'..'9': begin
|
|
actasmpattern := c;
|
|
c := current_scanner.asmgetchar;
|
|
while c in ['0'..'9'] do
|
|
begin
|
|
actasmpattern := actasmpattern + c;
|
|
c:= current_scanner.asmgetchar;
|
|
end;
|
|
actasmtoken := AS_INTNUM;
|
|
exit;
|
|
end;
|
|
';' : begin
|
|
repeat
|
|
c:=current_scanner.asmgetchar;
|
|
until c=#10;
|
|
firsttoken := TRUE;
|
|
actasmtoken:=AS_SEPARATOR;
|
|
end;
|
|
|
|
'{' : begin
|
|
current_scanner.skipcomment(true);
|
|
GetToken;
|
|
end;
|
|
|
|
#13,#10 : begin
|
|
current_scanner.linebreak;
|
|
c:=current_scanner.asmgetchar;
|
|
firsttoken := TRUE;
|
|
actasmtoken:=AS_SEPARATOR;
|
|
end;
|
|
else
|
|
current_scanner.illegal_char(c);
|
|
|
|
end; { end case }
|
|
end; { end else if }
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------}
|
|
{ Routines for the parsing }
|
|
{---------------------------------------------------------------------}
|
|
|
|
function tm68kmotreader.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;
|
|
|
|
function tm68kmotreader.try_to_consume(t : tasmtoken):boolean;
|
|
begin
|
|
try_to_consume:=t=actasmtoken;
|
|
if try_to_consume then
|
|
Consume(actasmtoken);
|
|
end;
|
|
|
|
procedure tm68kmotreader.consume_all_until(tokens : tasmtokenset);
|
|
begin
|
|
while not (actasmtoken in tokens) do
|
|
Consume(actasmtoken);
|
|
end;
|
|
|
|
|
|
|
|
function tm68kmotreader.findopcode(const s: string; var opsize: topsize): tasmop;
|
|
{*********************************************************************}
|
|
{ FUNCTION findopcode(s: string): tasmop; }
|
|
{ Description: Determines if the s string is a valid opcode }
|
|
{ if so returns correct tasmop token. }
|
|
{*********************************************************************}
|
|
var
|
|
j: longint;
|
|
begin
|
|
j:=pos('.',s);
|
|
if (j <> 0) and (j < length(s)) then
|
|
begin
|
|
case s[j+1] of
|
|
{ For the motorola only opsize size is used to }
|
|
{ determine the size of the operands. }
|
|
'B': opsize := S_B;
|
|
'W': opsize := S_W;
|
|
'L': opsize := S_L;
|
|
'S': opsize := S_FS;
|
|
'D': opsize := S_FD;
|
|
'X': opsize := S_FX;
|
|
else
|
|
Message1(asmr_e_unknown_opcode,s);
|
|
end;
|
|
end;
|
|
result:=actopcode;
|
|
end;
|
|
|
|
|
|
|
|
|
|
Function tm68kmotreader.BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint;
|
|
{*********************************************************************}
|
|
{ FUNCTION BuildExpression: longint }
|
|
{ Description: This routine calculates a constant expression to }
|
|
{ a given value. The return value is the value calculated from }
|
|
{ the expression. }
|
|
{ The following tokens (not strings) are recognized: }
|
|
{ (,),SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
|
|
{*********************************************************************}
|
|
{ ENTRY: On entry the token should be any valid expression token. }
|
|
{ EXIT: On Exit the token points to either COMMA or SEPARATOR }
|
|
{ ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
|
|
{ invalid tokens. }
|
|
{*********************************************************************}
|
|
var expr: string;
|
|
hs, tempstr: string;
|
|
sym : tsym;
|
|
srsymtable : TSymtable;
|
|
hl : tasmlabel;
|
|
l : tcgint;
|
|
errorflag: boolean;
|
|
begin
|
|
BuildExpression:=0;
|
|
errorflag := FALSE;
|
|
expr := '';
|
|
tempstr := '';
|
|
if allow_symbol then
|
|
asmsym^:='';
|
|
Repeat
|
|
Case actasmtoken of
|
|
AS_LPAREN: begin
|
|
Consume(AS_LPAREN);
|
|
expr := expr + '(';
|
|
end;
|
|
AS_RPAREN: begin
|
|
Consume(AS_RPAREN);
|
|
expr := expr + ')';
|
|
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);
|
|
expr := expr + '*';
|
|
end;
|
|
AS_PLUS: begin
|
|
Consume(AS_PLUS);
|
|
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_ID: begin
|
|
if SearchIConstant(actasmpattern,l) then
|
|
begin
|
|
str(l, tempstr);
|
|
expr := expr + tempstr;
|
|
Consume(AS_ID);
|
|
End else
|
|
if not allow_symbol then
|
|
begin
|
|
Message(asmr_e_syn_constant);
|
|
l := 0;
|
|
End else
|
|
begin
|
|
hs:='';
|
|
if (expr[Length(expr)]='+') then
|
|
Delete(expr,Length(expr),1)
|
|
else if expr<>'' then
|
|
begin
|
|
Message(asmr_e_invalid_constant_expression);
|
|
break;
|
|
End;
|
|
tempstr:=actasmpattern;
|
|
consume(AS_ID);
|
|
if (length(tempstr)>1) and (tempstr[1]='@') then
|
|
begin
|
|
CreateLocalLabel(tempstr,hl,false);
|
|
hs:=hl.name
|
|
end
|
|
else if SearchLabel(tempstr,hl,false) then
|
|
hs:=hl.name
|
|
else
|
|
begin
|
|
asmsearchsym(tempstr,sym,srsymtable);
|
|
if assigned(sym) then
|
|
begin
|
|
case sym.typ of
|
|
paravarsym,
|
|
localvarsym :
|
|
begin
|
|
Message(asmr_e_no_local_or_para_allowed);
|
|
hs:=tabstractvarsym(sym).mangledname;
|
|
end;
|
|
staticvarsym :
|
|
hs:=tstaticvarsym(sym).mangledname;
|
|
procsym :
|
|
begin
|
|
if tprocsym(sym).procdeflist.count>1 then
|
|
Message(asmr_w_calling_overload_func);
|
|
hs:=tprocdef(tprocsym(sym).procdeflist[0]).mangledname;
|
|
end;
|
|
typesym :
|
|
begin
|
|
if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then
|
|
Message(asmr_e_wrong_sym_type);
|
|
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
|
|
asmsym^:=hs
|
|
else
|
|
Message(asmr_e_cant_have_multiple_relocatable_symbols);
|
|
end;
|
|
end;
|
|
end;
|
|
AS_INTNUM: begin
|
|
expr := expr + actasmpattern;
|
|
Consume(AS_INTNUM);
|
|
end;
|
|
AS_BINNUM: begin
|
|
tempstr := tostr(ParseVal(actasmpattern,2));
|
|
if tempstr = '' then
|
|
Message(asmr_e_error_converting_binary);
|
|
expr:=expr+tempstr;
|
|
Consume(AS_BINNUM);
|
|
end;
|
|
|
|
AS_HEXNUM: begin
|
|
tempstr := tostr(ParseVal(actasmpattern,16));
|
|
if tempstr = '' then
|
|
Message(asmr_e_error_converting_hexadecimal);
|
|
expr:=expr+tempstr;
|
|
Consume(AS_HEXNUM);
|
|
end;
|
|
AS_OCTALNUM: begin
|
|
tempstr := tostr(ParseVal(actasmpattern,8));
|
|
if tempstr = '' then
|
|
Message(asmr_e_error_converting_octal);
|
|
expr:=expr+tempstr;
|
|
Consume(AS_OCTALNUM);
|
|
end;
|
|
{ go to next term }
|
|
AS_COMMA: begin
|
|
if not ErrorFlag then
|
|
BuildExpression := CalculateExpression(expr)
|
|
else
|
|
BuildExpression := 0;
|
|
Exit;
|
|
end;
|
|
{ go to next symbol }
|
|
AS_SEPARATOR: begin
|
|
if not ErrorFlag then
|
|
BuildExpression := CalculateExpression(expr)
|
|
else
|
|
BuildExpression := 0;
|
|
Exit;
|
|
end;
|
|
else
|
|
begin
|
|
{ only write error 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;
|
|
end;
|
|
|
|
|
|
Procedure tm68kmotreader.BuildRealConstant(typ : tfloattype);
|
|
{*********************************************************************}
|
|
{ PROCEDURE BuilRealConst }
|
|
{ Description: This routine calculates a constant expression to }
|
|
{ a given value. The return value is the value calculated from }
|
|
{ the expression. }
|
|
{ The following tokens (not strings) are recognized: }
|
|
{ +/-,numbers and real numbers }
|
|
{*********************************************************************}
|
|
{ ENTRY: On entry the token should be any valid expression token. }
|
|
{ EXIT: On Exit the token points to either COMMA or SEPARATOR }
|
|
{ ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
|
|
{ invalid tokens. }
|
|
{*********************************************************************}
|
|
var expr: string;
|
|
r : extended;
|
|
code : word;
|
|
negativ : boolean;
|
|
errorflag: boolean;
|
|
begin
|
|
errorflag := FALSE;
|
|
Repeat
|
|
negativ:=false;
|
|
expr := '';
|
|
if actasmtoken=AS_PLUS then Consume(AS_PLUS)
|
|
else if actasmtoken=AS_MINUS then
|
|
begin
|
|
negativ:=true;
|
|
consume(AS_MINUS);
|
|
end;
|
|
Case actasmtoken of
|
|
AS_INTNUM: begin
|
|
expr := actasmpattern;
|
|
Consume(AS_INTNUM);
|
|
end;
|
|
AS_REALNUM: begin
|
|
expr := actasmpattern;
|
|
{ in ATT syntax you have 0d in front of the real }
|
|
{ should this be forced ? yes i think so, as to }
|
|
{ conform to gas as much as possible. }
|
|
if (expr[1]='0') and (upper(expr[2])='D') then
|
|
expr:=copy(expr,3,255);
|
|
Consume(AS_REALNUM);
|
|
end;
|
|
AS_BINNUM: begin
|
|
{ checking for real constants with this should use }
|
|
{ real DECODING otherwise the compiler will crash! }
|
|
Message(asmr_e_invalid_float_expr);
|
|
expr:='0.0';
|
|
Consume(AS_BINNUM);
|
|
end;
|
|
|
|
AS_HEXNUM: begin
|
|
{ checking for real constants with this should use }
|
|
{ real DECODING otherwise the compiler will crash! }
|
|
Message(asmr_e_invalid_float_expr);
|
|
expr:='0.0';
|
|
Consume(AS_HEXNUM);
|
|
end;
|
|
AS_OCTALNUM: begin
|
|
{ checking for real constants with this should use }
|
|
{ real DECODING otherwise the compiler will crash! }
|
|
{ xxxToDec using reals could be a solution, but the }
|
|
{ problem is that these will crash the m68k compiler }
|
|
{ when compiling -- because of lack of good fpu }
|
|
{ support. }
|
|
Message(asmr_e_invalid_float_expr);
|
|
expr:='0.0';
|
|
Consume(AS_OCTALNUM);
|
|
end;
|
|
else
|
|
begin
|
|
{ only write error once. }
|
|
if not errorflag then
|
|
Message(asmr_e_invalid_float_expr);
|
|
{ consume tokens until we find COMMA or SEPARATOR }
|
|
Consume(actasmtoken);
|
|
errorflag := TRUE;
|
|
End;
|
|
|
|
end;
|
|
{ go to next term }
|
|
if (actasmtoken=AS_COMMA) or (actasmtoken=AS_SEPARATOR) then
|
|
begin
|
|
if negativ then expr:='-'+expr;
|
|
val(expr,r,code);
|
|
if code<>0 then
|
|
begin
|
|
r:=0;
|
|
Message(asmr_e_invalid_float_expr);
|
|
ConcatRealConstant(curlist,r,typ);
|
|
End
|
|
else
|
|
begin
|
|
ConcatRealConstant(curlist,r,typ);
|
|
End;
|
|
end
|
|
else
|
|
Message(asmr_e_invalid_float_expr);
|
|
Until actasmtoken=AS_SEPARATOR;
|
|
end;
|
|
|
|
|
|
Procedure tm68kmotreader.BuildConstant(maxvalue: longint);
|
|
{*********************************************************************}
|
|
{ PROCEDURE BuildConstant }
|
|
{ Description: This routine takes care of parsing a DB,DD,or DW }
|
|
{ line and adding those to the assembler node. Expressions, range- }
|
|
{ checking are fullly taken care of. }
|
|
{ maxvalue: $ff -> indicates that this is a DB node. }
|
|
{ $ffff -> indicates that this is a DW node. }
|
|
{ $ffffffff -> indicates that this is a DD node. }
|
|
{*********************************************************************}
|
|
{ EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
|
|
{*********************************************************************}
|
|
var
|
|
expr: string;
|
|
value : longint;
|
|
begin
|
|
Repeat
|
|
Case actasmtoken of
|
|
AS_STRING: begin
|
|
if maxvalue <> $ff then
|
|
Message(asmr_e_string_not_allowed_as_const);
|
|
expr := actasmpattern;
|
|
if length(expr) > 1 then
|
|
Message(asmr_e_string_not_allowed_as_const);
|
|
Consume(AS_STRING);
|
|
Case actasmtoken of
|
|
AS_COMMA: Consume(AS_COMMA);
|
|
AS_SEPARATOR: ;
|
|
else
|
|
Message(asmr_e_invalid_string_expression);
|
|
end; { end case }
|
|
ConcatString(curlist,expr);
|
|
end;
|
|
AS_INTNUM,AS_BINNUM,
|
|
AS_OCTALNUM,AS_HEXNUM:
|
|
begin
|
|
value:=BuildExpression(false,nil);
|
|
ConcatConstant(curlist,value,maxvalue);
|
|
end;
|
|
AS_ID:
|
|
begin
|
|
value:=BuildExpression(false,nil);
|
|
if value > maxvalue then
|
|
begin
|
|
Message(asmr_e_constant_out_of_bounds);
|
|
{ assuming a value of maxvalue }
|
|
value := maxvalue;
|
|
end;
|
|
ConcatConstant(curlist,value,maxvalue);
|
|
end;
|
|
{ These terms can start an assembler expression }
|
|
AS_PLUS,AS_MINUS,AS_LPAREN,AS_NOT: begin
|
|
value := BuildExpression(false,nil);
|
|
ConcatConstant(curlist,value,maxvalue);
|
|
end;
|
|
AS_COMMA: begin
|
|
Consume(AS_COMMA);
|
|
END;
|
|
AS_SEPARATOR: ;
|
|
|
|
else
|
|
begin
|
|
Message(asmr_e_syntax_error);
|
|
end;
|
|
end; { end case }
|
|
Until actasmtoken = AS_SEPARATOR;
|
|
end;
|
|
|
|
|
|
Procedure TM68kMotreader.BuildScaling(const oper:tm68koperand);
|
|
{*********************************************************************}
|
|
{ Takes care of parsing expression starting from the scaling value }
|
|
{ up to and including possible field specifiers. }
|
|
{ EXIT CONDITION: On exit the routine should point to AS_SEPARATOR }
|
|
{ or AS_COMMA. On entry should point to the AS_STAR token. }
|
|
{*********************************************************************}
|
|
var str:string;
|
|
l: longint;
|
|
code: integer;
|
|
begin
|
|
str:='';
|
|
Consume(AS_STAR);
|
|
if (oper.opr.ref.scalefactor <> 0)
|
|
and (oper.opr.ref.scalefactor <> 1) then
|
|
Message(asmr_e_wrong_base_index);
|
|
case actasmtoken of
|
|
AS_INTNUM: str := actasmpattern;
|
|
AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16));
|
|
AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2));
|
|
AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8));
|
|
else
|
|
Message(asmr_e_syntax_error);
|
|
end;
|
|
val(str, l, code);
|
|
if code <> 0 then
|
|
Message(asmr_e_wrong_scale_factor);
|
|
if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then
|
|
begin
|
|
oper.opr.ref.scalefactor := l;
|
|
end
|
|
else
|
|
begin
|
|
Message(asmr_e_wrong_scale_factor);
|
|
oper.opr.ref.scalefactor := 0;
|
|
end;
|
|
if oper.opr.ref.index = NR_NO then
|
|
begin
|
|
Message(asmr_e_wrong_base_index);
|
|
oper.opr.ref.scalefactor := 0;
|
|
end;
|
|
{ Consume the scaling number }
|
|
Consume(actasmtoken);
|
|
if actasmtoken = AS_RPAREN then
|
|
Consume(AS_RPAREN)
|
|
else
|
|
Message(asmr_e_wrong_scale_factor);
|
|
{ // .Field.Field ... or separator/comma // }
|
|
if actasmtoken in [AS_COMMA,AS_SEPARATOR] then
|
|
begin
|
|
end
|
|
else
|
|
Message(asmr_e_syntax_error);
|
|
end;
|
|
|
|
|
|
Function TM68kMotreader.BuildRefExpression: longint;
|
|
{*********************************************************************}
|
|
{ FUNCTION BuildRefExpression: longint }
|
|
{ Description: This routine calculates a constant expression to }
|
|
{ a given value. The return value is the value calculated from }
|
|
{ the expression. }
|
|
{ The following tokens (not strings) are recognized: }
|
|
{ SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
|
|
{*********************************************************************}
|
|
{ ENTRY: On entry the token should be any valid expression token. }
|
|
{ EXIT: On Exit the token points to the LPAREN token. }
|
|
{ ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
|
|
{ invalid tokens. }
|
|
{*********************************************************************}
|
|
var
|
|
tempstr: string;
|
|
expr: string;
|
|
l : tcgint;
|
|
errorflag : boolean;
|
|
begin
|
|
BuildRefExpression := 0;
|
|
errorflag := FALSE;
|
|
expr := '';
|
|
|
|
repeat
|
|
tempstr := '';
|
|
case actasmtoken of
|
|
AS_RPAREN:
|
|
Message(asmr_e_syntax_error);
|
|
AS_SHL:
|
|
tempstr := '<';
|
|
AS_SHR:
|
|
tempstr := '>';
|
|
AS_SLASH:
|
|
tempstr := '/';
|
|
AS_MOD:
|
|
tempstr := '%';
|
|
AS_STAR:
|
|
tempstr := '*';
|
|
AS_PLUS:
|
|
tempstr := '+';
|
|
AS_MINUS:
|
|
tempstr := '-';
|
|
AS_AND:
|
|
tempstr := '&';
|
|
AS_NOT:
|
|
tempstr := '~';
|
|
AS_XOR:
|
|
tempstr := '^';
|
|
AS_OR:
|
|
tempstr := '|';
|
|
|
|
{ End of reference }
|
|
AS_LPAREN:
|
|
begin
|
|
if not ErrorFlag then
|
|
BuildRefExpression := CalculateExpression(expr);
|
|
{ no longer in an expression }
|
|
exit;
|
|
end;
|
|
AS_ID:
|
|
begin
|
|
if not SearchIConstant(actasmpattern,l) then
|
|
begin
|
|
Message(asmr_e_syn_constant);
|
|
l := 0;
|
|
end;
|
|
str(l, tempstr);
|
|
end;
|
|
AS_INTNUM:
|
|
tempstr := actasmpattern;
|
|
AS_BINNUM:
|
|
begin
|
|
tempstr := Tostr(ParseVal(actasmpattern,2));
|
|
if tempstr = '' then
|
|
Message(asmr_e_error_converting_binary);
|
|
end;
|
|
AS_HEXNUM:
|
|
begin
|
|
tempstr := Tostr(ParseVal(actasmpattern,16));
|
|
if tempstr = '' then
|
|
Message(asmr_e_error_converting_hexadecimal);
|
|
end;
|
|
AS_OCTALNUM:
|
|
begin
|
|
tempstr := Tostr(ParseVal(actasmpattern,8));
|
|
if tempstr = '' then
|
|
Message(asmr_e_error_converting_octal);
|
|
end;
|
|
else
|
|
begin
|
|
{ write error only once. }
|
|
if not errorflag then
|
|
Message(asmr_e_invalid_constant_expression);
|
|
if actasmtoken in [AS_COMMA,AS_SEPARATOR] then exit;
|
|
{ consume tokens until we find COMMA or SEPARATOR }
|
|
errorflag := true;
|
|
end;
|
|
end;
|
|
if tempstr <> '' then
|
|
expr := expr + tempstr;
|
|
Consume(actasmtoken);
|
|
until false;
|
|
end;
|
|
|
|
|
|
|
|
{*********************************************************************}
|
|
{ PROCEDURE BuildBracketExpression }
|
|
{ Description: This routine builds up an expression after a LPAREN }
|
|
{ token is encountered. }
|
|
{ On entry actasmtoken should be equal to AS_LPAREN }
|
|
{*********************************************************************}
|
|
{ EXIT CONDITION: On exit the routine should point to either the }
|
|
{ AS_COMMA or AS_SEPARATOR token. }
|
|
{*********************************************************************}
|
|
procedure TM68kMotreader.BuildReference(const oper:tm68koperand);
|
|
var
|
|
l:longint;
|
|
code: integer;
|
|
str: string;
|
|
begin
|
|
str:='';
|
|
Consume(AS_LPAREN);
|
|
case actasmtoken of
|
|
{ // (reg ... // }
|
|
AS_REGISTER:
|
|
begin
|
|
oper.opr.ref.base := actasmregister;
|
|
Consume(AS_REGISTER);
|
|
{ can either be a register or a right parenthesis }
|
|
{ // (reg) // }
|
|
{ // (reg)+ // }
|
|
if actasmtoken=AS_RPAREN then
|
|
begin
|
|
Consume(AS_RPAREN);
|
|
if actasmtoken = AS_PLUS then
|
|
begin
|
|
if (oper.opr.ref.direction <> dir_none) then
|
|
Message(asmr_e_no_inc_and_dec_together)
|
|
else
|
|
oper.opr.ref.direction := dir_inc;
|
|
Consume(AS_PLUS);
|
|
end;
|
|
if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then
|
|
begin
|
|
Message(asmr_e_invalid_reference_syntax);
|
|
{ error recovery ... }
|
|
while actasmtoken <> AS_SEPARATOR do
|
|
Consume(actasmtoken);
|
|
end;
|
|
exit;
|
|
end;
|
|
{ // (reg,reg .. // }
|
|
Consume(AS_COMMA);
|
|
if actasmtoken = AS_REGISTER then
|
|
begin
|
|
oper.opr.ref.index :=
|
|
actasmregister;
|
|
Consume(AS_REGISTER);
|
|
{ check for scaling ... }
|
|
case actasmtoken of
|
|
AS_RPAREN:
|
|
begin
|
|
Consume(AS_RPAREN);
|
|
if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then
|
|
begin
|
|
{ error recovery ... }
|
|
Message(asmr_e_invalid_reference_syntax);
|
|
while actasmtoken <> AS_SEPARATOR do
|
|
Consume(actasmtoken);
|
|
end;
|
|
exit;
|
|
end;
|
|
AS_STAR:
|
|
begin
|
|
BuildScaling(oper);
|
|
end;
|
|
else
|
|
begin
|
|
Message(asmr_e_invalid_reference_syntax);
|
|
while (actasmtoken <> AS_SEPARATOR) do
|
|
Consume(actasmtoken);
|
|
end;
|
|
end; { end case }
|
|
end
|
|
else
|
|
begin
|
|
Message(asmr_e_invalid_reference_syntax);
|
|
while (actasmtoken <> AS_SEPARATOR) do
|
|
Consume(actasmtoken);
|
|
end;
|
|
end;
|
|
AS_HEXNUM,AS_OCTALNUM, { direct address }
|
|
AS_BINNUM,AS_INTNUM:
|
|
begin
|
|
case actasmtoken of
|
|
AS_INTNUM: str := actasmpattern;
|
|
AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16));
|
|
AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2));
|
|
AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8));
|
|
else
|
|
Message(asmr_e_syntax_error);
|
|
end;
|
|
Consume(actasmtoken);
|
|
val(str, l, code);
|
|
if code <> 0 then
|
|
Message(asmr_e_invalid_reference_syntax)
|
|
else
|
|
oper.opr.ref.offset := l;
|
|
Consume(AS_RPAREN);
|
|
if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then
|
|
begin
|
|
{ error recovery ... }
|
|
Message(asmr_e_invalid_reference_syntax);
|
|
while actasmtoken <> AS_SEPARATOR do
|
|
Consume(actasmtoken);
|
|
end;
|
|
exit;
|
|
end;
|
|
else
|
|
begin
|
|
Message(asmr_e_invalid_reference_syntax);
|
|
while (actasmtoken <> AS_SEPARATOR) do
|
|
Consume(actasmtoken);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tm68kmotreader.BuildRegList(const oper:tm68koperand);
|
|
{*********************************************************************}
|
|
{ EXIT CONDITION: On exit the routine should point to either the }
|
|
{ AS_COMMA or AS_SEPARATOR token. }
|
|
{*********************************************************************}
|
|
var
|
|
i: Tsuperregister;
|
|
reg_one, reg_two: tregister;
|
|
rs_one, rs_two: tsuperregister;
|
|
addrregset,dataregset,fpuregset: tcpuregisterset;
|
|
errorflag, first: boolean;
|
|
begin
|
|
dataregset := [];
|
|
addrregset := [];
|
|
fpuregset := [];
|
|
|
|
{ 1., try to consume a register list
|
|
2., if successful, add the register list
|
|
3., if not possible, then we have a standalone register, add
|
|
4., repeat until we dont have a slash any more }
|
|
|
|
errorflag:=false;
|
|
first:=true;
|
|
repeat
|
|
reg_one:=actasmregister;
|
|
rs_one:=getsupreg(reg_one);
|
|
if not (first or try_to_consume(AS_REGISTER)) then
|
|
begin
|
|
errorflag:=true;
|
|
break;
|
|
end;
|
|
first:=false;
|
|
|
|
{ try to consume a register list }
|
|
if try_to_consume(AS_MINUS) then
|
|
begin
|
|
reg_two:=actasmregister;
|
|
rs_two:=getsupreg(reg_two);
|
|
if (not try_to_consume(AS_REGISTER)) or
|
|
(rs_one >= rs_two) or
|
|
(getregtype(reg_one) <> getregtype(reg_two)) then
|
|
begin
|
|
errorflag:=true;
|
|
break;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ nope, we have a single element "list" }
|
|
reg_two:=reg_one;
|
|
rs_two:=getsupreg(reg_two);
|
|
end;
|
|
|
|
case getregtype(reg_one) of
|
|
R_INTREGISTER:
|
|
for i:=getsupreg(reg_one) to getsupreg(reg_two) do
|
|
include(dataregset,i);
|
|
R_ADDRESSREGISTER:
|
|
for i:=getsupreg(reg_one) to getsupreg(reg_two) do
|
|
include(addrregset,i);
|
|
R_FPUREGISTER:
|
|
for i:=getsupreg(reg_one) to getsupreg(reg_two) do
|
|
include(fpuregset,i);
|
|
else
|
|
internalerror(201611041);
|
|
end;
|
|
|
|
until not try_to_consume(AS_SLASH);
|
|
|
|
errorflag:=errorflag or
|
|
(((dataregset <> []) or (addrregset <> [])) and (fpuregset <> [])) or
|
|
(not (actasmtoken in [AS_SEPARATOR,AS_COMMA]));
|
|
|
|
if errorflag then
|
|
begin
|
|
Message(asmr_e_invalid_reg_list_in_movem_or_fmovem);
|
|
consume_all_until([AS_SEPARATOR,AS_COMMA]);
|
|
end
|
|
else
|
|
begin
|
|
oper.opr.typ:= OPR_REGSET;
|
|
oper.opr.regsetdata := dataregset;
|
|
oper.opr.regsetaddr := addrregset;
|
|
oper.opr.regsetfpu := fpuregset;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tm68kmotreader.BuildRegPair(const oper:tm68koperand);
|
|
{*********************************************************************}
|
|
{ EXIT CONDITION: On exit the routine should point to either the }
|
|
{ AS_COMMA or AS_SEPARATOR token. }
|
|
{*********************************************************************}
|
|
begin
|
|
oper.opr.typ := OPR_REGPAIR;
|
|
oper.opr.reghi := actasmregister;
|
|
Consume(AS_COLON);
|
|
if not try_to_consume(AS_REGISTER) then
|
|
begin
|
|
Message(asmr_e_invalid_reg_list_for_opcode);
|
|
consume_all_until([AS_SEPARATOR,AS_COMMA]);
|
|
end
|
|
else
|
|
oper.opr.reglo:=actasmregister;
|
|
end;
|
|
|
|
|
|
Procedure TM68kMotreader.BuildOperand(const oper:tm68koperand);
|
|
{*********************************************************************}
|
|
{ EXIT CONDITION: On exit the routine should point to either the }
|
|
{ AS_COMMA or AS_SEPARATOR token. }
|
|
{*********************************************************************}
|
|
var
|
|
expr: string;
|
|
tempstr: string;
|
|
lab: tasmlabel;
|
|
l : tcgint;
|
|
hl: tasmlabel;
|
|
p: pointer;
|
|
begin
|
|
case actasmtoken of
|
|
{ // Memory reference // }
|
|
AS_LPAREN:
|
|
begin
|
|
Oper.InitRef;
|
|
BuildReference(oper);
|
|
end;
|
|
{ // Constant expression // }
|
|
AS_APPT: begin
|
|
Consume(AS_APPT);
|
|
if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
|
|
Message(asmr_e_invalid_operand_type);
|
|
{ identifiers are handled by BuildExpression }
|
|
oper.opr.typ := OPR_CONSTANT;
|
|
oper.opr.val :=BuildExpression(true,@tempstr);
|
|
if tempstr<>'' then
|
|
begin
|
|
l:=oper.opr.val;
|
|
oper.opr.typ := OPR_SYMBOL;
|
|
oper.opr.symofs := l;
|
|
oper.opr.symbol := current_asmdata.RefAsmSymbol(tempstr,AT_FUNCTION);
|
|
end;
|
|
end;
|
|
{ // Constant memory offset . // }
|
|
{ // This must absolutely be followed by ( // }
|
|
AS_HEXNUM,AS_INTNUM,
|
|
AS_BINNUM,AS_OCTALNUM,AS_PLUS:
|
|
begin
|
|
Oper.InitRef;
|
|
oper.opr.ref.offset:=BuildRefExpression;
|
|
BuildReference(oper);
|
|
end;
|
|
{ // A constant expression, or a Variable ref. // }
|
|
AS_ID: begin
|
|
if actasmpattern[1] = '@' then
|
|
{ // Label or Special symbol reference // }
|
|
begin
|
|
if actasmpattern = '@RESULT' then
|
|
oper.SetUpResult
|
|
else
|
|
if actasmpattern = 'SELF' then
|
|
oper.SetUpSelf
|
|
else
|
|
if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
|
|
Message(asmr_w_CODE_and_DATA_not_supported)
|
|
else
|
|
begin
|
|
delete(actasmpattern,1,1);
|
|
if actasmpattern = '' then
|
|
Message(asmr_e_null_label_ref_not_allowed);
|
|
CreateLocalLabel(actasmpattern,lab,false);
|
|
oper.opr.typ := OPR_SYMBOL;
|
|
oper.opr.symbol := lab;
|
|
oper.opr.symofs := 0;
|
|
end;
|
|
Consume(AS_ID);
|
|
if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
|
|
Message(asmr_e_syntax_error);
|
|
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
|
|
Oper.InitRef;
|
|
oper.opr.ref.offset:=BuildRefExpression;
|
|
BuildReference(oper);
|
|
end
|
|
else { is it a label variable ? }
|
|
|
|
{ // ID[ , ID.Field.Field or simple ID // }
|
|
{ check if this is a label, if so then }
|
|
{ emit it as a label. }
|
|
if SearchLabel(actasmpattern,hl,false) then
|
|
begin
|
|
oper.opr.typ := OPR_SYMBOL;
|
|
oper.opr.symbol := hl;
|
|
oper.opr.symofs := 0;
|
|
Consume(AS_ID);
|
|
if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
|
|
Message(asmr_e_syntax_error);
|
|
|
|
end
|
|
else 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 begin
|
|
Message1(sym_e_unknown_id,expr);
|
|
end;
|
|
expr:='';
|
|
end;
|
|
end;
|
|
// Message1(sym_e_unknown_id,actasmpattern);
|
|
end;
|
|
|
|
case actasmtoken of
|
|
AS_LPAREN: { indexing }
|
|
BuildReference(oper);
|
|
AS_SEPARATOR,AS_COMMA: begin
|
|
end;
|
|
else
|
|
Message(asmr_e_syntax_error);
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
{ // Pre-decrement mode reference or constant mem offset. // }
|
|
AS_MINUS: begin
|
|
Consume(AS_MINUS);
|
|
if actasmtoken = AS_LPAREN then
|
|
begin
|
|
Oper.InitRef;
|
|
{ indicate pre-decrement mode }
|
|
oper.opr.ref.direction := dir_dec;
|
|
BuildReference(oper);
|
|
end
|
|
else
|
|
if actasmtoken in [AS_OCTALNUM,AS_HEXNUM,AS_BINNUM,AS_INTNUM] then
|
|
begin
|
|
Oper.InitRef;
|
|
oper.opr.ref.offset:=BuildRefExpression;
|
|
{ negate because was preceded by a negative sign! }
|
|
oper.opr.ref.offset:=-oper.opr.ref.offset;
|
|
BuildReference(oper);
|
|
end
|
|
else
|
|
begin
|
|
Message(asmr_e_syntax_error);
|
|
while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do
|
|
Consume(actasmtoken);
|
|
end;
|
|
end;
|
|
{ // Register, a variable reference or a constant reference // }
|
|
AS_REGISTER: begin
|
|
Consume(AS_REGISTER);
|
|
case actasmtoken of
|
|
AS_SEPARATOR, AS_COMMA:
|
|
begin
|
|
{ // Simple register // }
|
|
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 := actasmregister;
|
|
end;
|
|
AS_SLASH, AS_MINUS:
|
|
{ // Register listing // }
|
|
BuildRegList(oper);
|
|
AS_COLON:
|
|
{ // Register pair // }
|
|
BuildRegPair(oper);
|
|
else
|
|
Message(asmr_e_invalid_register);
|
|
end;
|
|
end;
|
|
AS_SEPARATOR, AS_COMMA: ;
|
|
else
|
|
begin
|
|
Message(asmr_e_invalid_opcode_and_operand);
|
|
Consume(actasmtoken);
|
|
end;
|
|
end; { end case }
|
|
end;
|
|
|
|
|
|
Procedure TM68kmotReader.BuildOpCode(instr:Tm68kinstruction);
|
|
{*********************************************************************}
|
|
{ PROCEDURE BuildOpcode; }
|
|
{ Description: Parses the intel opcode and operands, and writes it }
|
|
{ in the TInstruction object. }
|
|
{*********************************************************************}
|
|
{ EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
|
|
{ On ENTRY: Token should point to AS_OPCODE }
|
|
{*********************************************************************}
|
|
var
|
|
operandnum : longint;
|
|
begin
|
|
{ // opcode // }
|
|
{ allow for newline as in gas styled syntax }
|
|
{ under DOS you get two AS_SEPARATOR !! }
|
|
while actasmtoken=AS_SEPARATOR do
|
|
Consume(AS_SEPARATOR);
|
|
if (actasmtoken <> AS_OPCODE) then
|
|
begin
|
|
Message(asmr_e_invalid_or_missing_opcode);
|
|
{ error recovery }
|
|
While not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do
|
|
Consume(actasmtoken);
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
Instr.opcode := findopcode(actasmpattern,instr.opsize);
|
|
Consume(AS_OPCODE);
|
|
{ // Zero operand opcode ? // }
|
|
if actasmtoken = AS_SEPARATOR then
|
|
exit
|
|
else
|
|
operandnum := 1;
|
|
end;
|
|
|
|
While actasmtoken <> AS_SEPARATOR do
|
|
begin
|
|
case actasmtoken of
|
|
{ // Operand delimiter // }
|
|
AS_COMMA: begin
|
|
if operandnum > Max_Operands then
|
|
Message(asmr_e_too_many_operands)
|
|
else
|
|
Inc(operandnum);
|
|
Consume(AS_COMMA);
|
|
end;
|
|
{ // End of asm operands for this opcode // }
|
|
AS_SEPARATOR: ;
|
|
else
|
|
BuildOperand(Instr.Operands[operandnum] as tm68koperand);
|
|
end; { end case }
|
|
end; { end while }
|
|
instr.Ops:=operandnum;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function tm68kmotreader.Assemble: tlinkedlist;
|
|
var
|
|
hl: tasmlabel;
|
|
instr : TM68kInstruction;
|
|
begin
|
|
//Message(asmr_d_start_reading);
|
|
firsttoken := TRUE;
|
|
operandnum := 0;
|
|
{ sets up all opcode and register tables in uppercase }
|
|
if not _asmsorted then
|
|
begin
|
|
SetupTables;
|
|
_asmsorted := TRUE;
|
|
end;
|
|
curlist:=TAsmList.Create;
|
|
gettoken;
|
|
while actasmtoken<>AS_END do
|
|
begin
|
|
case actasmtoken of
|
|
AS_LLABEL:
|
|
begin
|
|
if CreateLocalLabel(actasmpattern,hl,true) then
|
|
ConcatLabel(curlist,hl);
|
|
Consume(AS_LLABEL);
|
|
end;
|
|
AS_LABEL:
|
|
begin
|
|
{ when looking for Pascal labels, these must }
|
|
{ be in uppercase. }
|
|
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
|
|
Consume(AS_DW);
|
|
BuildConstant($ffff);
|
|
end;
|
|
AS_DB:
|
|
begin
|
|
Consume(AS_DB);
|
|
BuildConstant($ff);
|
|
end;
|
|
AS_DD:
|
|
begin
|
|
Consume(AS_DD);
|
|
BuildConstant(longint($ffffffff));
|
|
end;
|
|
AS_XDEF:
|
|
begin
|
|
Consume(AS_XDEF);
|
|
if actasmtoken=AS_ID then
|
|
ConcatPublic(curlist,actasmpattern);
|
|
Consume(AS_ID);
|
|
if actasmtoken<>AS_SEPARATOR then
|
|
Consume(AS_SEPARATOR);
|
|
end;
|
|
AS_ALIGN:
|
|
begin
|
|
Message(asmr_w_align_not_supported);
|
|
while actasmtoken <> AS_SEPARATOR do
|
|
Consume(actasmtoken);
|
|
end;
|
|
AS_OPCODE:
|
|
begin
|
|
instr:=TM68kInstruction.Create(tm68koperand);
|
|
BuildOpcode(instr);
|
|
// instr.AddReferenceSizes;
|
|
// instr.SetInstructionOpsize;
|
|
// instr.CheckOperandSizes;
|
|
if instr.labeled then
|
|
instr.ConcatLabeledInstr(curlist)
|
|
else begin
|
|
instr.ConcatInstruction(curlist);
|
|
end;
|
|
instr.Free;
|
|
|
|
end;
|
|
AS_SEPARATOR:
|
|
begin
|
|
Consume(AS_SEPARATOR);
|
|
{ let us go back to the first operand }
|
|
operandnum := 0;
|
|
end;
|
|
AS_END:
|
|
{ end assembly block }
|
|
;
|
|
else
|
|
begin
|
|
Message(asmr_e_syntax_error);
|
|
{ error recovery }
|
|
Consume(actasmtoken);
|
|
end;
|
|
end; { end case }
|
|
end; { end while }
|
|
|
|
{ Check LocalLabelList }
|
|
checklocallabels;
|
|
|
|
assemble:=curlist;
|
|
//Message(asmr_d_finish_reading);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Initialize
|
|
*****************************************************************************}
|
|
|
|
const
|
|
asmmode_m68k_mot_info : tasmmodeinfo =
|
|
(
|
|
id : asmmode_m68k_mot;
|
|
idtxt : 'MOTOROLA';
|
|
casmreader : tm68kmotreader;
|
|
);
|
|
|
|
asmmode_m68k_standard_info : tasmmodeinfo =
|
|
(
|
|
id : asmmode_standard;
|
|
idtxt : 'STANDARD';
|
|
casmreader : tm68kmotreader;
|
|
);
|
|
|
|
begin
|
|
RegisterAsmMode(asmmode_m68k_mot_info);
|
|
RegisterAsmMode(asmmode_m68k_standard_info);
|
|
end.
|