From 1f8c074ab458a8b6abeffd9b36d129e2be41361f Mon Sep 17 00:00:00 2001 From: peter Date: Mon, 19 Sep 2005 11:46:23 +0000 Subject: [PATCH] * make m68k compile git-svn-id: trunk@1138 - --- .gitattributes | 1 + compiler/m68k/aasmcpu.pas | 10 +- compiler/m68k/agcpugas.pas | 2 +- compiler/m68k/cputarg.pas | 9 +- compiler/m68k/ra68k.pas | 363 +++++++++++++ compiler/m68k/ra68kmot.pas | 1015 ++++++++++-------------------------- 6 files changed, 649 insertions(+), 751 deletions(-) create mode 100755 compiler/m68k/ra68k.pas diff --git a/.gitattributes b/.gitattributes index 8863969645..ab4d2ea3fd 100644 --- a/.gitattributes +++ b/.gitattributes @@ -192,6 +192,7 @@ compiler/m68k/r68ksri.inc svneol=native#text/plain compiler/m68k/r68ksta.inc svneol=native#text/plain compiler/m68k/r68kstd.inc svneol=native#text/plain compiler/m68k/r68ksup.inc svneol=native#text/plain +compiler/m68k/ra68k.pas svneol=native#text/plain compiler/m68k/ra68kmot.pas svneol=native#text/plain compiler/m68k/rgcpu.pas svneol=native#text/plain compiler/make_old.cmd -text diff --git a/compiler/m68k/aasmcpu.pas b/compiler/m68k/aasmcpu.pas index a45994c649..924b089d83 100644 --- a/compiler/m68k/aasmcpu.pas +++ b/compiler/m68k/aasmcpu.pas @@ -40,6 +40,7 @@ type taicpu = class(tai_cpu_abstract) opsize : topsize; + constructor op_none(op : tasmop); constructor op_none(op : tasmop;_size : topsize); constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); @@ -147,6 +148,13 @@ type end; + constructor taicpu.op_none(op : tasmop); + begin + inherited create(op); + init(S_NO); + end; + + constructor taicpu.op_none(op : tasmop;_size : topsize); begin inherited create(op); @@ -455,7 +463,7 @@ type result:=operand_write; end; // fake - + // internalerror(200404091); end; diff --git a/compiler/m68k/agcpugas.pas b/compiler/m68k/agcpugas.pas index f93ee60d07..f6ab696ca3 100644 --- a/compiler/m68k/agcpugas.pas +++ b/compiler/m68k/agcpugas.pas @@ -199,7 +199,7 @@ interface end else getopstr:=getreferencestring(o.ref^); - top_reglist: + top_regset: begin hs:=''; for i:=RS_D0 to RS_D7 do diff --git a/compiler/m68k/cputarg.pas b/compiler/m68k/cputarg.pas index 7624def33d..e337035a95 100644 --- a/compiler/m68k/cputarg.pas +++ b/compiler/m68k/cputarg.pas @@ -36,8 +36,15 @@ implementation **************************************} {$ifndef NOTARGETLINUX} - ,t_linux,t_amiga + ,t_linux {$endif} + ,t_amiga + +{************************************** + Assembler Readers +**************************************} + + ,ra68kmot {************************************** Assemblers diff --git a/compiler/m68k/ra68k.pas b/compiler/m68k/ra68k.pas new file mode 100755 index 0000000000..3b7c24dc8d --- /dev/null +++ b/compiler/m68k/ra68k.pas @@ -0,0 +1,363 @@ +{ + Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman + + Handles the common 68k assembler reader routines + + 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 ra68k; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmcpu, + cpubase,rautils,cclasses; + + type + Tm68kOperand=class(TOperand) + end; + + Tm68kInstruction=class(TInstruction) + opsize : topsize; + function ConcatInstruction(p : taasmoutput):tai;override; + function ConcatLabeledInstr(p : taasmoutput):tai; + end; + + implementation + + uses + verbose,cgbase; + +{***************************************************************************** + TM68kInstruction +*****************************************************************************} + + function TM68kInstruction.ConcatInstruction(p : taasmoutput):tai; + var + fits : boolean; + begin + result:=nil; + fits := FALSE; + { setup specific opcodetions for first pass } + + { Setup special operands } + { Convert to general form as to conform to the m68k opcode table } + if (opcode = A_ADDA) or (opcode = A_ADDI) + then opcode := A_ADD + else + { CMPM excluded because of GAS v1.34 BUG } + if (opcode = A_CMPA) or + (opcode = A_CMPI) then + opcode := A_CMP + else + if opcode = A_EORI then + opcode := A_EOR + else + if opcode = A_MOVEA then + opcode := A_MOVE + else + if opcode = A_ORI then + opcode := A_OR + else + if (opcode = A_SUBA) or (opcode = A_SUBI) then + opcode := A_SUB; + + { Setup operand types } + +(* + in opcode <> A_MOVEM then + begin + + while not(fits) do + begin + { set the opcodetion cache, if the opcodetion } + { occurs the first time } + if (it[i].i=opcode) and (ins_cache[opcode]=-1) then + ins_cache[opcode]:=i; + + if (it[i].i=opcode) and (instr.ops=it[i].ops) then + begin + { first fit } + case instr.ops of + 0 : begin + fits:=true; + break; + end; + 1 : + begin + if (optyp1 and it[i].o1)<>0 then + begin + fits:=true; + break; + end; + end; + 2 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) then + begin + fits:=true; + break; + end + 3 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) and + ((optyp3 and it[i].o3)<>0) then + begin + fits:=true; + break; + end; + end; { end case } + end; { endif } + if it[i].i=A_NONE then + begin + { NO MATCH! } + Message(asmr_e_invalid_combination_opcode_and_operand); + exit; + end; + inc(i); + end; { end while } + *) + fits:=TRUE; + + { We add the opcode to the opcode linked list } + if fits then + begin + case ops of + 0: + if opsize <> S_NO then + result:=(taicpu.op_none(opcode,opsize)) + else + result:=(taicpu.op_none(opcode,S_NO)); + 1: begin + case operands[1].opr.typ of + OPR_SYMBOL: + begin + result:=(taicpu.op_sym_ofs(opcode, + opsize, operands[1].opr.symbol,operands[1].opr.symofs)); + end; + OPR_CONSTANT: + begin + result:=(taicpu.op_const(opcode, + opsize, operands[1].opr.val)); + end; + OPR_REGISTER: + result:=(taicpu.op_reg(opcode,opsize,operands[1].opr.reg)); + OPR_REFERENCE: + if opsize <> S_NO then + begin + result:=(taicpu.op_ref(opcode, + opsize,operands[1].opr.ref)); + end + else + begin + { special jmp and call case with } + { symbolic references. } + if opcode in [A_BSR,A_JMP,A_JSR,A_BRA,A_PEA] then + begin + result:=(taicpu.op_ref(opcode, + S_NO,operands[1].opr.ref)); + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + OPR_NONE: + Message(asmr_e_invalid_opcode_and_operand); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; + end; + 2: begin + { source } + case operands[1].opr.typ of + { reg,reg } + { reg,ref } + OPR_REGISTER: + begin + case operands[2].opr.typ of + OPR_REGISTER: + begin + result:=(taicpu.op_reg_reg(opcode, + opsize,operands[1].opr.reg,operands[2].opr.reg)); + end; + OPR_REFERENCE: + result:=(taicpu.op_reg_ref(opcode, + opsize,operands[1].opr.reg,operands[2].opr.ref)); + else { else case } + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REGISTER } + end; + { regset, ref } + OPR_regset: + begin + case operands[2].opr.typ of + OPR_REFERENCE : + result:=(taicpu.op_regset_ref(opcode, + opsize,operands[1].opr.regset,operands[2].opr.ref)); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_regset } + end; + + { const,reg } + { const,const } + { const,ref } + OPR_CONSTANT: + case operands[2].opr.typ of + { constant, constant does not have a specific size. } + OPR_CONSTANT: + result:=(taicpu.op_const_const(opcode, + S_NO,operands[1].opr.val,operands[2].opr.val)); + OPR_REFERENCE: + begin + result:=(taicpu.op_const_ref(opcode, + opsize,operands[1].opr.val, + operands[2].opr.ref)) + end; + OPR_REGISTER: + begin + result:=(taicpu.op_const_reg(opcode, + opsize,operands[1].opr.val, + operands[2].opr.reg)) + end; + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_CONSTANT } + { ref,reg } + { ref,ref } + OPR_REFERENCE: + case operands[2].opr.typ of + OPR_REGISTER: + begin + result:=(taicpu.op_ref_reg(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.reg)); + end; + OPR_regset: + begin + result:=(taicpu.op_ref_regset(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.regset)); + end; + OPR_REFERENCE: { special opcodes } + result:=(taicpu.op_ref_ref(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.ref)); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REFERENCE } + OPR_SYMBOL: case operands[2].opr.typ of + OPR_REFERENCE: + begin + result:=(taicpu.op_sym_ofs_ref(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.ref)) + end; + OPR_REGISTER: + begin + result:=(taicpu.op_sym_ofs_reg(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.reg)) + end; + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_SYMBOL } + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end first operand case } + end; + 3: begin + if (opcode = A_DIVSL) or (opcode = A_DIVUL) or (opcode = A_MULU) + or (opcode = A_MULS) or (opcode = A_DIVS) or (opcode = A_DIVU) then + begin + if (operands[1].opr.typ <> OPR_REGISTER) + or (operands[2].opr.typ <> OPR_REGISTER) + or (operands[3].opr.typ <> OPR_REGISTER) then + begin + Message(asmr_e_invalid_opcode_and_operand); + end + else + begin + result:=(taicpu. op_reg_reg_reg(opcode,opsize, + operands[1].opr.reg,operands[2].opr.reg,operands[3].opr.reg)); + end; + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end case } + end; + if assigned(result) then + p.concat(result); + end; + + + function TM68kInstruction.ConcatLabeledInstr(p : taasmoutput):tai; + begin + if ((opcode >= A_BCC) and (opcode <= A_BVS)) or + (opcode = A_BRA) or (opcode = A_BSR) or + (opcode = A_JMP) or (opcode = A_JSR) or + ((opcode >= A_FBEQ) and (opcode <= A_FBNGLE)) then + begin + if ops > 2 then + Message(asmr_e_invalid_opcode_and_operand) + else if operands[1].opr.typ <> OPR_SYMBOL then + Message(asmr_e_invalid_opcode_and_operand) + else if (operands[1].opr.typ = OPR_SYMBOL) and + (ops = 1) then + if assigned(operands[1].opr.symbol) and + (operands[1].opr.symofs=0) then + result:=taicpu.op_sym(opcode,S_NO, + operands[1].opr.symbol) + else + Message(asmr_e_invalid_opcode_and_operand); + end + else if ((opcode >= A_DBCC) and (opcode <= A_DBF)) + or ((opcode >= A_FDBEQ) and (opcode <= A_FDBNGLE)) then + begin + if (ops<>2) or + (operands[1].opr.typ <> OPR_REGISTER) or + (operands[2].opr.typ <> OPR_SYMBOL) or + (operands[2].opr.symofs <> 0) then + Message(asmr_e_invalid_opcode_and_operand) + else + result:=taicpu.op_reg_sym(opcode,opsize,operands[1].opr.reg, + operands[2].opr.symbol); + end + else + Message(asmr_e_invalid_opcode_and_operand); + if assigned(result) then + p.concat(result); + end; + + + + +end. diff --git a/compiler/m68k/ra68kmot.pas b/compiler/m68k/ra68kmot.pas index 0e345c0482..11f8442c46 100644 --- a/compiler/m68k/ra68kmot.pas +++ b/compiler/m68k/ra68kmot.pas @@ -48,7 +48,11 @@ unit ra68kmot; uses - rasm; + cutils, + globtype,cclasses,cpubase, + symconst, + aasmbase, + rabase,rasm,ra68k,rautils; type tasmtoken = ( @@ -62,76 +66,49 @@ unit ra68kmot; {------------------ Assembler Operators --------------------} AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR); + tasmkeyword = string[10]; + tm68kmotreader = class(tasmreader) - actasmtoken: tasmtoken; - actasmpattern: string; - destructor destroy;override; + 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 findopcode(s: string; var opsize: topsize): tasmop; + Function BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint; + Procedure BuildConstant(maxvalue: longint); + Procedure BuildRealConstant(typ : tfloattype); + Procedure BuildScaling(const oper:tm68koperand); + Function BuildRefExpression: longint; + procedure BuildReference(const oper:tm68koperand); + Procedure BuildOperand(const oper:tm68koperand); + Procedure BuildStringConstant(asciiz: boolean); + Procedure BuildOpCode(instr:Tm68kinstruction); end; Implementation uses - { common } - cutils,cclasses, { global } - globtype,globals,verbose, + globals,verbose, systems, { aasm } - cpuinfo,aasmbase,aasmtai,aasmcpu, + cpuinfo,aasmtai,aasmcpu, + cgbase, { symtable } - symconst,symbase,symtype,symsym,symtable, + symbase,symtype,symsym,symtable, { pass 1 } nbas, { parser } scanner,agcpugas, - rautils + itcpugas ; -const - { this variable is TRUE if the lookup tables have already been setup } - { for fast access. On the first call to assemble the tables are setup } - { and stay set up. } - _asmsorted: boolean = FALSE; - firstasmreg = R_D0; - lastasmreg = R_FPSR; - -type - tiasmops = array[firstop..lastop] of string[7]; - piasmops = ^tiasmops; - - tasmkeyword = string[6]; - -var - { sorted tables of opcodes } - iasmops: piasmops; - { uppercased tables of registers } - iasmregs: array[firstasmreg..lastasmreg] of string[6]; - -const - regname_count=17; - regname_count_bsstart=16; - - regname2regnum:array[0..regname_count-1] of regname2regnumrec=( - (name:'A0'; number:NR_A0), - (name:'A1'; number:NR_A1), - (name:'A2'; number:NR_A2), - (name:'A3'; number:NR_A3), - (name:'A4'; number:NR_A4), - (name:'A5'; number:NR_A5), - (name:'A6'; number:NR_A6), - (name:'A7'; number:NR_A7), - (name:'D0'; number:NR_D0), - (name:'D1'; number:NR_D1), - (name:'D2'; number:NR_D2), - (name:'D3'; number:NR_D3), - (name:'D4'; number:NR_D4), - (name:'D5'; number:NR_D5), - (name:'D6'; number:NR_D6), - (name:'D7'; number:NR_D7), - (name:'SP'; number:NR_A7)); - - const firstdirective = AS_DB; lastdirective = AS_END; @@ -149,137 +126,99 @@ const _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 SetupTables; - { creates uppercased symbol tables for speed access } - var - i: tasmop; - j: tregister; - begin - {Message(asmr_d_creating_lookup_tables);} - { opcodes } - new(iasmops); - for i:=firstop to lastop do - iasmops^[i] := upper(gas_op2str[i]); - { opcodes } - for j.enum:=firstasmreg to lastasmreg do - iasmregs[j.enum] := upper(std_reg2str[j.enum]); - end; + procedure tm68kmotreader.SetupTables; + { creates uppercased symbol tables for speed access } + var + i : tasmop; + str2opentry: tstr2opentry; + Begin + { opcodes } + iasmops:=TDictionary.Create; + iasmops.delete_doubles:=true; + for i:=firstop to lastop do + begin + str2opentry:=tstr2opentry.createname(upper(gas_op2str[i])); + str2opentry.op:=i; + iasmops.insert(str2opentry); + end; + end; {---------------------------------------------------------------------} { Routines for the tokenizing } {---------------------------------------------------------------------} - function regnum_search(const s:string):Tnewregister; + function tm68kmotreader.is_asmopcode(const s: string):boolean; + var + str2opentry: tstr2opentry; + 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,3,255) + else + hs:=s; - {Searches the register number that belongs to the register in s. - s must be in uppercase!.} - - var i,p:byte; - - begin - {Binary search.} - p:=0; - i:=regname_count_bsstart; - while i<>0 do - begin - if (p+i0 then - delete(s,j,2); - for i:=firstop to lastop do - begin - if s = iasmops^[i] then - begin - is_asmopcode:=TRUE; - exit; - end; - end; - end; + str2opentry:=tstr2opentry(iasmops.search(hs)); + if assigned(str2opentry) then + begin + actopcode:=str2opentry.op; + actasmtoken:=AS_OPCODE; + is_asmopcode:=true; + exit; + end; + end; - Procedure is_asmdirective(const s: string; var token: tasmtoken); - {*********************************************************************} - { FUNCTION is_asmdirective(s: string; var token: tinteltoken):Boolean } - { Description: Determines if the s string is a valid directive } - { (an operator can occur in operand fields, while a directive cannot) } - { if so returns the directive token, otherwise does not change token.} - {*********************************************************************} + 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 - token := tasmtoken(longint(firstdirective)+i); + actasmtoken := tasmtoken(longint(firstdirective)+i); + result:=true; exit; end; end; end; - Procedure is_register(const s: string; var token: tasmtoken); - {*********************************************************************} - { PROCEDURE is_register(s: string; var token: tinteltoken); } - { Description: Determines if the s string is a valid register, if } - { so return token equal to A_REGISTER, otherwise does not change token} - {*********************************************************************} - var - i: tregister; - begin - if regnum_search(s)=NR_NO then - begin - for i.enum:=firstasmreg to lastasmreg do - begin - if s=iasmregs[i.enum] then - begin - token := AS_REGISTER; - exit; - end; - end; - { take care of other name for sp } - if s = 'A7' then - begin - token:=AS_REGISTER; - exit; - end; - end - else - token:=AS_REGISTER; - end; + function tm68kmotreader.is_register(const s:string):boolean; + begin + is_register:=false; + actasmregister:=gas_regnum_search(lower(s)); + if actasmregister<>NR_NO then + begin + is_register:=true; + actasmtoken:=AS_REGISTER; + end; + end; - - Function GetToken: tasmtoken; + Procedure tm68kmotreader.GetToken; {*********************************************************************} { FUNCTION GetToken: tinteltoken; } { Description: This routine returns intel assembler tokens and } @@ -297,11 +236,11 @@ const while c in [' ',#9] do c:=current_scanner.asmgetchar; - if not (c in [newline,#13,'{',';']) then + 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 [newline,#13,'{',';']) then + if firsttoken and not (c in [#10,#13,'{',';']) then begin firsttoken := FALSE; @@ -332,7 +271,7 @@ const end; { end case } { let us point to the next character } c := current_scanner.asmgetchar; - gettoken := token; + actasmtoken := token; exit; end; @@ -342,21 +281,14 @@ const Message(asmr_e_none_label_contain_at); If is_asmopcode(actasmpattern) then - begin - gettoken := AS_OPCODE; exit; - end; - is_asmdirective(actasmpattern, token); - if (token <> AS_NONE) then - begin - gettoken := token; + if is_asmdirective(actasmpattern) then exit - end else - begin - gettoken := AS_NONE; - Message1(asmr_e_invalid_or_missing_opcode,actasmpattern); - end; + begin + actasmtoken := AS_NONE; + Message1(asmr_e_invalid_or_missing_opcode,actasmpattern); + end; end else { else firsttoken } { Here we must handle all possible cases } @@ -374,7 +306,7 @@ const c := current_scanner.asmgetchar; end; uppervar(actasmpattern); - gettoken := AS_ID; + actasmtoken := AS_ID; exit; end; { identifier, register, opcode, prefix or directive } @@ -389,29 +321,19 @@ const uppervar(actasmpattern); If is_asmopcode(actasmpattern) then - begin - gettoken := AS_OPCODE; - exit; - end; - is_register(actasmpattern, token); - {is_asmoperator(actasmpattern,token);} - is_asmdirective(actasmpattern,token); - { if found } - if (token <> AS_NONE) then - begin - gettoken := token; exit; - end + if is_register(actasmpattern) then + exit; + if is_asmdirective(actasmpattern) then + exit; { this is surely an identifier } - else - token := AS_ID; - gettoken := token; + actasmtoken := AS_ID; exit; end; { override operator... not supported } '&': begin c:=current_scanner.asmgetchar; - gettoken := AS_AND; + actasmtoken := AS_AND; end; { string or character } '''' : @@ -422,7 +344,7 @@ const if c = '''' then begin c:=current_scanner.asmgetchar; - if c=newline then + if c=#10 then begin Message(scan_f_string_exceeds_line); break; @@ -435,7 +357,7 @@ const begin actasmpattern:=actasmpattern+''''; c:=current_scanner.asmgetchar; - if c=newline then + if c=#10 then begin Message(scan_f_string_exceeds_line); break; @@ -447,7 +369,7 @@ const begin actasmpattern:=actasmpattern+c; c:=current_scanner.asmgetchar; - if c=newline then + if c=#10 then begin Message(scan_f_string_exceeds_line); break @@ -458,7 +380,7 @@ const else break; { end if } end; { end while } token:=AS_STRING; - gettoken := token; + actasmtoken := token; exit; end; '$' : begin @@ -468,51 +390,51 @@ const actasmpattern := actasmpattern + c; c := current_scanner.asmgetchar; end; - gettoken := AS_HEXNUM; + actasmtoken := AS_HEXNUM; exit; end; ',' : begin - gettoken := AS_COMMA; + actasmtoken := AS_COMMA; c:=current_scanner.asmgetchar; exit; end; '(' : begin - gettoken := AS_LPAREN; + actasmtoken := AS_LPAREN; c:=current_scanner.asmgetchar; exit; end; ')' : begin - gettoken := AS_RPAREN; + actasmtoken := AS_RPAREN; c:=current_scanner.asmgetchar; exit; end; ':' : begin - gettoken := AS_COLON; + actasmtoken := AS_COLON; c:=current_scanner.asmgetchar; exit; end; { '.' : begin - gettoken := AS_DOT; + actasmtoken := AS_DOT; c:=current_scanner.asmgetchar; exit; end; } '+' : begin - gettoken := AS_PLUS; + actasmtoken := AS_PLUS; c:=current_scanner.asmgetchar; exit; end; '-' : begin - gettoken := AS_MINUS; + actasmtoken := AS_MINUS; c:=current_scanner.asmgetchar; exit; end; '*' : begin - gettoken := AS_STAR; + actasmtoken := AS_STAR; c:=current_scanner.asmgetchar; exit; end; '/' : begin - gettoken := AS_SLASH; + actasmtoken := AS_SLASH; c:=current_scanner.asmgetchar; exit; end; @@ -522,7 +444,7 @@ const if c <> '<' then Message(asmr_e_invalid_char_smaller); { still assume << } - gettoken := AS_SHL; + actasmtoken := AS_SHL; c := current_scanner.asmgetchar; exit; end; @@ -532,22 +454,22 @@ const if c <> '>' then Message(asmr_e_invalid_char_greater); { still assume << } - gettoken := AS_SHR; + actasmtoken := AS_SHR; c := current_scanner.asmgetchar; exit; end; '|' : begin - gettoken := AS_OR; + actasmtoken := AS_OR; c := current_scanner.asmgetchar; exit; end; '^' : begin - gettoken := AS_XOR; + actasmtoken := AS_XOR; c := current_scanner.asmgetchar; exit; end; '#' : begin - gettoken:=AS_APPT; + actasmtoken:=AS_APPT; c:=current_scanner.asmgetchar; exit; end; @@ -558,7 +480,7 @@ const actasmpattern := actasmpattern + c; c := current_scanner.asmgetchar; end; - gettoken := AS_BINNUM; + actasmtoken := AS_BINNUM; exit; end; { integer number } @@ -570,21 +492,21 @@ const actasmpattern := actasmpattern + c; c:= current_scanner.asmgetchar; end; - gettoken := AS_INTNUM; + actasmtoken := AS_INTNUM; exit; end; ';' : begin repeat c:=current_scanner.asmgetchar; - until c=newline; + until c=#10; firsttoken := TRUE; - gettoken:=AS_SEPARATOR; + actasmtoken:=AS_SEPARATOR; end; - '{',#13,newline : begin + '{',#13,#10 : begin c:=current_scanner.asmgetchar; firsttoken := TRUE; - gettoken:=AS_SEPARATOR; + actasmtoken:=AS_SEPARATOR; end; else begin @@ -600,61 +522,27 @@ const { Routines for the parsing } {---------------------------------------------------------------------} - procedure consume(t : tasmtoken); - - begin - if t<>actasmtoken then - Message(asmr_e_syntax_error); - actasmtoken:=gettoken; - { if the token must be ignored, then } - { get another token to parse. } - if actasmtoken = AS_NONE then - actasmtoken := gettoken; + 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 findregister(const s : string): tregister; - {*********************************************************************} - { FUNCTION findregister(s: string):tasmop; } - { Description: Determines if the s string is a valid register, } - { if so returns correct tregister token, or R_NO if not found. } - {*********************************************************************} - var - i: tregister; - begin - i.enum:=R_INTREGISTER; - i.number:=regnum_search(s); - if i.number=NR_NO then - begin - findregister.enum := R_NO; - for i.enum:=firstasmreg to lastasmreg do - if s = iasmregs[i.enum] then - begin - findregister := i; - exit; - end; - if s = 'A7' then - begin - findregister.enum := R_SP; - exit; - end; - end - else - findregister:=i; - end; - - - function findopcode(s: string; var opsize: topsize): tasmop; + function tm68kmotreader.findopcode(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 - i: tasmop; j: byte; op_size: string; begin @@ -678,18 +566,13 @@ const { delete everything starting from dot } delete(s,j,length(s)); end; - for i:=firstop to lastop do - if s = iasmops^[i] then - begin - findopcode:=i; - exit; - end; + result:=actopcode; end; - Function BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint; + Function tm68kmotreader.BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint; {*********************************************************************} { FUNCTION BuildExpression: longint } { Description: This routine calculates a constant expression to } @@ -806,11 +689,11 @@ const if assigned(sym) then begin case sym.typ of - varsym : + paravarsym, + localvarsym : begin - if sym.owner.symtabletype in [localsymtable,parasymtable] then - Message(asmr_e_no_local_or_para_allowed); - hs:=tvarsym(sym).mangledname; + Message(asmr_e_no_local_or_para_allowed); + hs:=tabstractvarsym(sym).mangledname; end; typedconstsym : hs:=ttypedconstsym(sym).mangledname; @@ -847,7 +730,7 @@ const Consume(AS_INTNUM); end; AS_BINNUM: begin - tempstr := tostr(ValBinary(actasmpattern)); + tempstr := tostr(ParseVal(actasmpattern,2)); if tempstr = '' then Message(asmr_e_error_converting_binary); expr:=expr+tempstr; @@ -855,14 +738,14 @@ const end; AS_HEXNUM: begin - tempstr := tostr(ValHexadecimal(actasmpattern)); + 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(ValOctal(actasmpattern)); + tempstr := tostr(ParseVal(actasmpattern,8)); if tempstr = '' then Message(asmr_e_error_converting_octal); expr:=expr+tempstr; @@ -898,7 +781,7 @@ const end; - Procedure BuildRealConstant(typ : tfloattype); + Procedure tm68kmotreader.BuildRealConstant(typ : tfloattype); {*********************************************************************} { PROCEDURE BuilRealConst } { Description: This routine calculates a constant expression to } @@ -1001,7 +884,7 @@ const end; - Procedure BuildConstant(maxvalue: longint); + Procedure tm68kmotreader.BuildConstant(maxvalue: longint); {*********************************************************************} { PROCEDURE BuildConstant } { Description: This routine takes care of parsing a DB,DD,or DW } @@ -1014,21 +897,17 @@ const { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } {*********************************************************************} var - strlength: byte; expr: string; - tempstr: string; value : longint; begin Repeat Case actasmtoken of AS_STRING: begin - if maxvalue = $ff then - strlength := 1 - else + 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); + Message(asmr_e_string_not_allowed_as_const); Consume(AS_STRING); Case actasmtoken of AS_COMMA: Consume(AS_COMMA); @@ -1074,26 +953,7 @@ const end; - - - - -{**************************************************************************** - Tm68kOperand -****************************************************************************} - -type - TM68kOperand=class(TOperand) - Procedure BuildOperand;override; - private - labeled : boolean; - Procedure BuildReference; - Function BuildRefExpression: longint; - Procedure BuildScaling; - end; - - - Procedure TM68kOperand.BuildScaling; + Procedure TM68kMotreader.BuildScaling(const oper:tm68koperand); {*********************************************************************} { Takes care of parsing expression starting from the scaling value } { up to and including possible field specifiers. } @@ -1105,14 +965,14 @@ type code: integer; begin Consume(AS_STAR); - if (opr.ref.scalefactor <> 0) - and (opr.ref.scalefactor <> 1) then + 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(ValHexadecimal(actasmpattern)); - AS_BINNUM: str := Tostr(ValBinary(actasmpattern)); - AS_OCTALNUM: str := Tostr(ValOctal(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; @@ -1121,17 +981,17 @@ type Message(asmr_e_wrong_scale_factor); if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then begin - opr.ref.scalefactor := l; + oper.opr.ref.scalefactor := l; end else begin Message(asmr_e_wrong_scale_factor); - opr.ref.scalefactor := 0; + oper.opr.ref.scalefactor := 0; end; - if opr.ref.index.enum = R_NO then + if oper.opr.ref.index = NR_NO then begin Message(asmr_e_wrong_base_index); - opr.ref.scalefactor := 0; + oper.opr.ref.scalefactor := 0; end; { Consume the scaling number } Consume(actasmtoken); @@ -1148,7 +1008,7 @@ type end; - Function TM68kOperand.BuildRefExpression: longint; + Function TM68kMotreader.BuildRefExpression: longint; {*********************************************************************} { FUNCTION BuildRefExpression: longint } { Description: This routine calculates a constant expression to } @@ -1245,7 +1105,7 @@ type Consume(AS_INTNUM); end; AS_BINNUM: begin - tempstr := Tostr(ValBinary(actasmpattern)); + tempstr := Tostr(ParseVal(actasmpattern,2)); if tempstr = '' then Message(asmr_e_error_converting_binary); expr:=expr+tempstr; @@ -1253,14 +1113,14 @@ type end; AS_HEXNUM: begin - tempstr := Tostr(ValHexadecimal(actasmpattern)); + 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(ValOctal(actasmpattern)); + tempstr := Tostr(ParseVal(actasmpattern,8)); if tempstr = '' then Message(asmr_e_error_converting_octal); expr:=expr+tempstr; @@ -1292,7 +1152,7 @@ type { EXIT CONDITION: On exit the routine should point to either the } { AS_COMMA or AS_SEPARATOR token. } {*********************************************************************} - procedure TM68kOperand.BuildReference; + procedure TM68kMotreader.BuildReference(const oper:tm68koperand); var l:longint; code: integer; @@ -1303,7 +1163,7 @@ type { // (reg ... // } AS_REGISTER: begin - opr.ref.base := findregister(actasmpattern); + oper.opr.ref.base := actasmregister; Consume(AS_REGISTER); { can either be a register or a right parenthesis } { // (reg) // } @@ -1313,10 +1173,10 @@ type Consume(AS_RPAREN); if actasmtoken = AS_PLUS then begin - if (opr.ref.direction <> dir_none) then + if (oper.opr.ref.direction <> dir_none) then Message(asmr_e_no_inc_and_dec_together) else - opr.ref.direction := dir_inc; + oper.opr.ref.direction := dir_inc; Consume(AS_PLUS); end; if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then @@ -1332,8 +1192,8 @@ type Consume(AS_COMMA); if actasmtoken = AS_REGISTER then begin - opr.ref.index := - findregister(actasmpattern); + oper.opr.ref.index := + actasmregister; Consume(AS_REGISTER); { check for scaling ... } case actasmtoken of @@ -1351,7 +1211,7 @@ type end; AS_STAR: begin - BuildScaling; + BuildScaling(oper); end; else begin @@ -1373,9 +1233,9 @@ type begin case actasmtoken of AS_INTNUM: str := actasmpattern; - AS_HEXNUM: str := Tostr(ValHexadecimal(actasmpattern)); - AS_BINNUM: str := Tostr(ValBinary(actasmpattern)); - AS_OCTALNUM: str := Tostr(ValOctal(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; @@ -1384,7 +1244,7 @@ type if code <> 0 then Message(asmr_e_invalid_reference_syntax) else - opr.ref.offset := l; + oper.opr.ref.offset := l; Consume(AS_RPAREN); if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then begin @@ -1407,46 +1267,44 @@ type - Procedure TM68kOperand.BuildOperand; + Procedure TM68kMotreader.BuildOperand(const oper:tm68koperand); {*********************************************************************} { EXIT CONDITION: On exit the routine should point to either the } { AS_COMMA or AS_SEPARATOR token. } {*********************************************************************} var tempstr: string; - expr: string; lab: tasmlabel; l : longint; i: Tsuperregister; r:Tregister; hl: tasmlabel; reg_one, reg_two: tregister; - reglist: Tsupregset; + regset: tcpuregisterset; begin - reglist := []; + regset := []; tempstr := ''; - expr := ''; case actasmtoken of { // Memory reference // } AS_LPAREN: begin - InitRef; - BuildReference; + Oper.InitRef; + BuildReference(oper); end; { // Constant expression // } AS_APPT: begin Consume(AS_APPT); - if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then + if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then Message(asmr_e_invalid_operand_type); { identifiers are handled by BuildExpression } - opr.typ := OPR_CONSTANT; - opr.val :=BuildExpression(true,@tempstr); + oper.opr.typ := OPR_CONSTANT; + oper.opr.val :=BuildExpression(true,@tempstr); if tempstr<>'' then begin - l:=opr.val; - opr.typ := OPR_SYMBOL; - opr.symofs := l; - opr.symbol := objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_FUNCTION); + l:=oper.opr.val; + oper.opr.typ := OPR_SYMBOL; + oper.opr.symofs := l; + oper.opr.symbol := objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_FUNCTION); end; end; { // Constant memory offset . // } @@ -1454,21 +1312,21 @@ type AS_HEXNUM,AS_INTNUM, AS_BINNUM,AS_OCTALNUM,AS_PLUS: begin - InitRef; - opr.ref.offset:=BuildRefExpression; - BuildReference; + Oper.InitRef; + oper.opr.ref.offset:=BuildRefExpression; + BuildReference(oper); end; { // A constant expression, or a Variable ref. // } AS_ID: begin - InitRef; + Oper.InitRef; if actasmpattern[1] = '@' then { // Label or Special symbol reference // } begin if actasmpattern = '@RESULT' then - SetUpResult + oper.SetUpResult else if actasmpattern = 'SELF' then - SetUpSelf + oper.SetUpSelf else if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then Message(asmr_w_CODE_and_DATA_not_supported) @@ -1478,10 +1336,10 @@ type if actasmpattern = '' then Message(asmr_e_null_label_ref_not_allowed); CreateLocalLabel(actasmpattern,lab,false); - opr.typ := OPR_SYMBOL; - opr.symbol := lab; - opr.symofs := 0; - labeled := TRUE; + oper.opr.typ := OPR_SYMBOL; + oper.opr.symbol := lab; + oper.opr.symofs := 0; +// labeled := TRUE; end; Consume(AS_ID); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then @@ -1494,9 +1352,9 @@ type { is it a constant ? } if SearchIConstant(actasmpattern,l) then begin - InitRef; - opr.ref.offset:=BuildRefExpression; - BuildReference; + Oper.InitRef; + oper.opr.ref.offset:=BuildRefExpression; + BuildReference(oper); end else { is it a label variable ? } begin @@ -1505,33 +1363,21 @@ type { emit it as a label. } if SearchLabel(actasmpattern,hl,false) then begin - opr.typ := OPR_SYMBOL; - opr.symbol := hl; - opr.symofs := 0; - labeled := TRUE; + oper.opr.typ := OPR_SYMBOL; + oper.opr.symbol := hl; + oper.opr.symofs := 0; +// labeled := TRUE; Consume(AS_ID); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then Message(asmr_e_syntax_error); end else - { is it a normal variable ? } - if (cs_compilesystem in aktmoduleswitches) then - begin - if not SetupDirectVar(expr) then - begin - { not found, finally ... add it anyways ... } - Message1(asmr_w_id_supposed_external,expr); - opr.ref.symbol:=objectlibrary.newasmsymbol(expr,AB_EXTERNAL,AT_FUNCTION); - end; - end - else - Message1(sym_e_unknown_id,actasmpattern); + Message1(sym_e_unknown_id,actasmpattern); - expr := actasmpattern; Consume(AS_ID); case actasmtoken of AS_LPAREN: { indexing } - BuildReference; + BuildReference(oper); AS_SEPARATOR,AS_COMMA: ; else Message(asmr_e_syntax_error); @@ -1545,19 +1391,19 @@ type Consume(AS_MINUS); if actasmtoken = AS_LPAREN then begin - InitRef; + Oper.InitRef; { indicate pre-decrement mode } - opr.ref.direction := dir_dec; - BuildReference; + oper.opr.ref.direction := dir_dec; + BuildReference(oper); end else if actasmtoken in [AS_OCTALNUM,AS_HEXNUM,AS_BINNUM,AS_INTNUM] then begin - InitRef; - opr.ref.offset:=BuildRefExpression; + Oper.InitRef; + oper.opr.ref.offset:=BuildRefExpression; { negate because was preceded by a negative sign! } - opr.ref.offset:=-opr.ref.offset; - BuildReference; + oper.opr.ref.offset:=-oper.opr.ref.offset; + BuildReference(oper); end else begin @@ -1574,20 +1420,20 @@ type { // Simple register // } if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then begin - if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then + if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then Message(asmr_e_invalid_operand_type); - opr.typ := OPR_REGISTER; - opr.reg := findregister(tempstr); + oper.opr.typ := OPR_REGISTER; + oper.opr.reg := actasmregister; end else { HERE WE MUST HANDLE THE SPECIAL CASE OF MOVEM AND FMOVEM } { // Individual register listing // } if (actasmtoken = AS_SLASH) then begin - r:=findregister(tempstr); - if r.enum<>R_INTREGISTER then + r:=actasmregister; + if getregtype(r)<>R_INTREGISTER then internalerror(200302191); - reglist := [r.number shr 8]; + include(regset,getsupreg(r)); Consume(AS_SLASH); if actasmtoken = AS_REGISTER then begin @@ -1595,11 +1441,10 @@ type begin case actasmtoken of AS_REGISTER: begin - r:=findregister(tempstr); - if r.enum<>R_INTREGISTER then - internalerror(200302191); - reglist := reglist + [r.number shr 8]; - Consume(AS_REGISTER); + if getregtype(r)<>R_INTREGISTER then + internalerror(200302191); + include(regset,getsupreg(r)); + Consume(AS_REGISTER); end; AS_SLASH: Consume(AS_SLASH); AS_SEPARATOR,AS_COMMA: break; @@ -1610,8 +1455,8 @@ type end; end; { end case } end; { end while } - opr.typ:= OPR_REGLIST; - opr.reglist := reglist; + oper.opr.typ:= OPR_regset; + oper.opr.regset := regset; end else { error recovery ... } @@ -1626,7 +1471,7 @@ type if (actasmtoken = AS_MINUS) then begin Consume(AS_MINUS); - reg_one:=findregister(tempstr); + reg_one:=actasmregister; if actasmtoken <> AS_REGISTER then begin Message(asmr_e_invalid_reg_list_in_movem); @@ -1636,15 +1481,15 @@ type else begin { determine the register range ... } - reg_two:=findregister(actasmpattern); - if reg_two.enum<>R_INTREGISTER then + reg_two:=actasmregister; + if getregtype(reg_two)<>R_INTREGISTER then internalerror(200302191); - if reg_one.enum > reg_two.enum then - for i:=reg_two.number shr 8 to reg_one.number shr 8 do - reglist:=reglist+[i] + if getsupreg(reg_one) > getsupreg(reg_two) then + for i:=getsupreg(reg_two) to getsupreg(reg_one) do + include(regset,i) else - for i:=reg_one.number shr 8 to reg_two.number shr 8 do - reglist:=reglist+[i]; + for i:=getsupreg(reg_one) to getsupreg(reg_two) do + include(regset,i); Consume(AS_REGISTER); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then begin @@ -1653,8 +1498,8 @@ type Consume(actasmtoken); end; { set up instruction } - opr.typ:= OPR_REGLIST; - opr.reglist := reglist; + oper.opr.typ:= OPR_regset; + oper.opr.regset := regset; end; end else @@ -1667,11 +1512,11 @@ type if (actasmtoken = AS_REGISTER) then begin { set up old field, since register is valid } - opr.typ := OPR_REGISTER; - opr.reg := findregister(tempstr); + oper.opr.typ := OPR_REGISTER; + oper.opr.reg := actasmregister; Inc(operandnum); - opr.typ := OPR_REGISTER; - opr.reg := findregister(actasmpattern); + oper.opr.typ := OPR_REGISTER; + oper.opr.reg := actasmregister; Consume(AS_REGISTER); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then begin @@ -1706,9 +1551,7 @@ type - - - Procedure BuildStringConstant(asciiz: boolean); + Procedure tm68kmotreader.BuildStringConstant(asciiz: boolean); {*********************************************************************} { PROCEDURE BuildStringConstant } { Description: Takes care of a ASCII, or ASCIIZ directive. } @@ -1747,333 +1590,7 @@ type end; -{***************************************************************************** - TM68kInstruction -*****************************************************************************} - - type - TM68kInstruction=class(TInstruction) - procedure InitOperands;override; - procedure ConcatInstruction(p : taasmoutput);override; - Procedure ConcatLabeledInstr(p : taasmoutput); - end; - - procedure TM68kInstruction.InitOperands; - var - i : longint; - begin - for i:=1 to max_operands do - Operands[i]:=TM68kOperand.Create; - end; - - - procedure TM68kInstruction.ConcatInstruction(p : taasmoutput); - var - fits : boolean; - begin - fits := FALSE; - { setup specific opcodetions for first pass } - - { Setup special operands } - { Convert to general form as to conform to the m68k opcode table } - if (opcode = A_ADDA) or (opcode = A_ADDI) - then opcode := A_ADD - else - { CMPM excluded because of GAS v1.34 BUG } - if (opcode = A_CMPA) or - (opcode = A_CMPI) then - opcode := A_CMP - else - if opcode = A_EORI then - opcode := A_EOR - else - if opcode = A_MOVEA then - opcode := A_MOVE - else - if opcode = A_ORI then - opcode := A_OR - else - if (opcode = A_SUBA) or (opcode = A_SUBI) then - opcode := A_SUB; - - { Setup operand types } - -(* - in opcode <> A_MOVEM then - begin - - while not(fits) do - begin - { set the opcodetion cache, if the opcodetion } - { occurs the first time } - if (it[i].i=opcode) and (ins_cache[opcode]=-1) then - ins_cache[opcode]:=i; - - if (it[i].i=opcode) and (instr.ops=it[i].ops) then - begin - { first fit } - case instr.ops of - 0 : begin - fits:=true; - break; - end; - 1 : - begin - if (optyp1 and it[i].o1)<>0 then - begin - fits:=true; - break; - end; - end; - 2 : if ((optyp1 and it[i].o1)<>0) and - ((optyp2 and it[i].o2)<>0) then - begin - fits:=true; - break; - end - 3 : if ((optyp1 and it[i].o1)<>0) and - ((optyp2 and it[i].o2)<>0) and - ((optyp3 and it[i].o3)<>0) then - begin - fits:=true; - break; - end; - end; { end case } - end; { endif } - if it[i].i=A_NONE then - begin - { NO MATCH! } - Message(asmr_e_invalid_combination_opcode_and_operand); - exit; - end; - inc(i); - end; { end while } - *) - fits:=TRUE; - - { We add the opcode to the opcode linked list } - if fits then - begin - case ops of - 0: - if opsize <> S_NO then - p.concat((taicpu.op_none(opcode,opsize))) - else - p.concat((taicpu.op_none(opcode,S_NO))); - 1: begin - case operands[1].opr.typ of - OPR_SYMBOL: - begin - p.concat((taicpu.op_sym_ofs(opcode, - opsize, operands[1].opr.symbol,operands[1].opr.symofs))); - end; - OPR_CONSTANT: - begin - p.concat((taicpu.op_const(opcode, - opsize, operands[1].opr.val))); - end; - OPR_REGISTER: - p.concat((taicpu.op_reg(opcode,opsize,operands[1].opr.reg))); - OPR_REFERENCE: - if opsize <> S_NO then - begin - p.concat((taicpu.op_ref(opcode, - opsize,operands[1].opr.ref))); - end - else - begin - { special jmp and call case with } - { symbolic references. } - if opcode in [A_BSR,A_JMP,A_JSR,A_BRA,A_PEA] then - begin - p.concat((taicpu.op_ref(opcode, - S_NO,operands[1].opr.ref))); - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - OPR_NONE: - Message(asmr_e_invalid_opcode_and_operand); - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; - end; - 2: begin - { source } - case operands[1].opr.typ of - { reg,reg } - { reg,ref } - OPR_REGISTER: - begin - case operands[2].opr.typ of - OPR_REGISTER: - begin - p.concat((taicpu.op_reg_reg(opcode, - opsize,operands[1].opr.reg,operands[2].opr.reg))); - end; - OPR_REFERENCE: - p.concat((taicpu.op_reg_ref(opcode, - opsize,operands[1].opr.reg,operands[2].opr.ref))); - else { else case } - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REGISTER } - end; - { reglist, ref } - OPR_REGLIST: - begin - case operands[2].opr.typ of - OPR_REFERENCE : - p.concat((taicpu.op_reglist_ref(opcode, - opsize,operands[1].opr.reglist,operands[2].opr.ref))); - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REGLIST } - end; - - { const,reg } - { const,const } - { const,ref } - OPR_CONSTANT: - case operands[2].opr.typ of - { constant, constant does not have a specific size. } - OPR_CONSTANT: - p.concat((taicpu.op_const_const(opcode, - S_NO,operands[1].opr.val,operands[2].opr.val))); - OPR_REFERENCE: - begin - p.concat((taicpu.op_const_ref(opcode, - opsize,operands[1].opr.val, - operands[2].opr.ref))) - end; - OPR_REGISTER: - begin - p.concat((taicpu.op_const_reg(opcode, - opsize,operands[1].opr.val, - operands[2].opr.reg))) - end; - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_CONSTANT } - { ref,reg } - { ref,ref } - OPR_REFERENCE: - case operands[2].opr.typ of - OPR_REGISTER: - begin - p.concat((taicpu.op_ref_reg(opcode, - opsize,operands[1].opr.ref, - operands[2].opr.reg))); - end; - OPR_REGLIST: - begin - p.concat((taicpu.op_ref_reglist(opcode, - opsize,operands[1].opr.ref, - operands[2].opr.reglist))); - end; - OPR_REFERENCE: { special opcodes } - p.concat((taicpu.op_ref_ref(opcode, - opsize,operands[1].opr.ref, - operands[2].opr.ref))); - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REFERENCE } - OPR_SYMBOL: case operands[2].opr.typ of - OPR_REFERENCE: - begin - p.concat((taicpu.op_sym_ofs_ref(opcode, - opsize,operands[1].opr.symbol,operands[1].opr.symofs, - operands[2].opr.ref))) - end; - OPR_REGISTER: - begin - p.concat((taicpu.op_sym_ofs_reg(opcode, - opsize,operands[1].opr.symbol,operands[1].opr.symofs, - operands[2].opr.reg))) - end; - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_SYMBOL } - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end first operand case } - end; - 3: begin - if (opcode = A_DIVSL) or (opcode = A_DIVUL) or (opcode = A_MULU) - or (opcode = A_MULS) or (opcode = A_DIVS) or (opcode = A_DIVU) then - begin - if (operands[1].opr.typ <> OPR_REGISTER) - or (operands[2].opr.typ <> OPR_REGISTER) - or (operands[3].opr.typ <> OPR_REGISTER) then - begin - Message(asmr_e_invalid_opcode_and_operand); - end - else - begin - p.concat((taicpu. op_reg_reg_reg(opcode,opsize, - operands[1].opr.reg,operands[2].opr.reg,operands[3].opr.reg))); - end; - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end case } - end; - end; - - - procedure TM68kInstruction.ConcatLabeledInstr(p : taasmoutput); - begin - if ((opcode >= A_BCC) and (opcode <= A_BVS)) or - (opcode = A_BRA) or (opcode = A_BSR) or - (opcode = A_JMP) or (opcode = A_JSR) or - ((opcode >= A_FBEQ) and (opcode <= A_FBNGLE)) then - begin - if ops > 2 then - Message(asmr_e_invalid_opcode_and_operand) - else if operands[1].opr.typ <> OPR_SYMBOL then - Message(asmr_e_invalid_opcode_and_operand) - else if (operands[1].opr.typ = OPR_SYMBOL) and - (ops = 1) then - if assigned(operands[1].opr.symbol) and - (operands[1].opr.symofs=0) then - p.concat(taicpu.op_sym(opcode,S_NO, - operands[1].opr.symbol)) - else - Message(asmr_e_invalid_opcode_and_operand); - end - else if ((opcode >= A_DBCC) and (opcode <= A_DBF)) - or ((opcode >= A_FDBEQ) and (opcode <= A_FDBNGLE)) then - begin - if (ops<>2) or - (operands[1].opr.typ <> OPR_REGISTER) or - (operands[2].opr.typ <> OPR_SYMBOL) or - (operands[2].opr.symofs <> 0) then - Message(asmr_e_invalid_opcode_and_operand) - else - p.concat(taicpu.op_reg_sym(opcode,opsize,operands[1].opr.reg, - operands[2].opr.symbol)); - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - - - - Procedure TM68kReader.BuildOpCode(instr:Tm68kinstruction); + Procedure TM68kmotReader.BuildOpCode(instr:Tm68kinstruction); {*********************************************************************} { PROCEDURE BuildOpcode; } { Description: Parses the intel opcode and operands, and writes it } @@ -2082,13 +1599,9 @@ type { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } { On ENTRY: Token should point to AS_OPCODE } {*********************************************************************} - var asmtok: tasmop; - expr: string; + var operandnum : longint; begin - expr := ''; - asmtok := A_NONE; { assmume no prefix } - { // opcode // } { allow for newline as in gas styled syntax } { under DOS you get two AS_SEPARATOR !! } @@ -2104,7 +1617,7 @@ type end else begin - Instr.opcode := findopcode(actasmpattern,opsize); + Instr.opcode := findopcode(actasmpattern,instr.opsize); Consume(AS_OPCODE); { // Zero operand opcode ? // } if actasmtoken = AS_SEPARATOR then @@ -2127,7 +1640,7 @@ type { // End of asm operands for this opcode // } AS_SEPARATOR: ; else - Instr.Operands[operandnum].BuildOperand; + BuildOperand(Instr.Operands[operandnum] as tm68koperand); end; { end case } end; { end while } end; @@ -2135,12 +1648,10 @@ type - function tm68kreader.Assemble: tlinkedlist; + function tm68kmotreader.Assemble: tlinkedlist; var hl: tasmlabel; - labelptr,nextlabel : tasmlabel; - commname : string; - instr : TM68kInstruction; + instr : TM68kInstruction; begin Message(asmr_d_start_reading); firsttoken := TRUE; @@ -2155,7 +1666,7 @@ type { setup label linked list } LocalLabelList:=TLocalLabelList.Create; c:=current_scanner.asmgetchar; - actasmtoken:=gettoken; + gettoken; while actasmtoken<>AS_END do begin case actasmtoken of @@ -2188,7 +1699,7 @@ type AS_DD: begin Consume(AS_DD); - BuildConstant($ffffffff); + BuildConstant(longint($ffffffff)); end; AS_XDEF: begin @@ -2207,7 +1718,7 @@ type end; AS_OPCODE: begin - instr:=TM68kInstruction.Create; + instr:=TM68kInstruction.Create(tm68koperand); BuildOpcode(instr); { instr.AddReferenceSizes;} { instr.SetInstructionOpsize;} @@ -2266,6 +1777,14 @@ const casmreader : tm68kmotreader; ); + asmmode_m68k_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : tm68kmotreader; + ); + begin - RegisterAsmMode(asmmode_i386_intel_info); + RegisterAsmMode(asmmode_m68k_mot_info); + RegisterAsmMode(asmmode_m68k_standard_info); end.