123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791 |
- {
- 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.
|