2
0

ra68kmot.pas 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791
  1. {
  2. Copyright (c) 1998-2000 by Carl Eric Codere
  3. This unit does the parsing process for the motorola inline assembler
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit ra68kmot;
  18. {$i fpcdefs.inc}
  19. {**********************************************************************}
  20. { WARNING }
  21. {**********************************************************************}
  22. { Any modification in the order or removal of terms in the tables }
  23. { in m68k.pas and asmo68k.pas will BREAK the code in this unit, }
  24. { unless the appropriate changes are made to this unit. Addition }
  25. { of terms though, will not change the code herein. }
  26. {**********************************************************************}
  27. {---------------------------------------------------------------------------}
  28. { LEFT TO DO }
  29. {---------------------------------------------------------------------------}
  30. { o Add support for sized indexing such as in d0.l }
  31. { presently only (an,dn) is supported for indexing -- }
  32. { size defaults to LONG. }
  33. { o Add support for MC68020 opcodes. }
  34. { o Add support for MC68020 adressing modes. }
  35. { o Add operand checking with m68k opcode table in ConcatOpCode }
  36. { o Add Floating point support }
  37. {---------------------------------------------------------------------------}
  38. interface
  39. uses
  40. cutils,
  41. globtype,cclasses,cpubase,
  42. symconst,
  43. aasmbase,
  44. rabase,rasm,ra68k,rautils;
  45. type
  46. tasmtoken = (
  47. AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_HEXNUM,AS_OCTALNUM,
  48. AS_BINNUM,AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN,
  49. AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,AS_INTNUM,
  50. AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_APPT,AS_REALNUM,
  51. AS_ALIGN,
  52. {------------------ Assembler directives --------------------}
  53. AS_DB,AS_DW,AS_DD,AS_XDEF,AS_END,
  54. {------------------ Assembler Operators --------------------}
  55. AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR);
  56. tasmtokenset = set of tasmtoken;
  57. tasmkeyword = string[10];
  58. tm68kmotreader = class(tasmreader)
  59. actasmtoken : tasmtoken;
  60. prevasmtoken : tasmtoken;
  61. procedure SetupTables;
  62. function Assemble: tlinkedlist;override;
  63. function is_asmopcode(const s: string) : boolean;
  64. Function is_asmdirective(const s: string):boolean;
  65. function is_register(const s:string):boolean;
  66. procedure GetToken;
  67. function consume(t : tasmtoken):boolean;
  68. function try_to_consume(t : tasmtoken):boolean;
  69. procedure consume_all_until(tokens : tasmtokenset);
  70. function findopcode(const s: string; var opsize: topsize): tasmop;
  71. Function BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint;
  72. Procedure BuildConstant(maxvalue: longint);
  73. Procedure BuildRealConstant(typ : tfloattype);
  74. Procedure BuildScaling(const oper:tm68koperand);
  75. Function BuildRefExpression: longint;
  76. procedure BuildReference(const oper:tm68koperand);
  77. procedure BuildRegList(const oper:tm68koperand);
  78. procedure BuildRegPair(const oper:tm68koperand);
  79. Procedure BuildOperand(const oper:tm68koperand);
  80. Procedure BuildOpCode(instr:Tm68kinstruction);
  81. end;
  82. Implementation
  83. uses
  84. { global }
  85. globals,verbose,
  86. systems,
  87. { aasm }
  88. cpuinfo,aasmtai,aasmdata,aasmcpu,
  89. cgbase,cgutils,
  90. { symtable }
  91. symbase,symtype,symsym,symdef,symtable,
  92. { pass 1 }
  93. nbas,
  94. { parser }
  95. scanner,ag68kgas,
  96. itcpugas
  97. ;
  98. const
  99. firstdirective = AS_DB;
  100. lastdirective = AS_END;
  101. firstoperator = AS_MOD;
  102. lastoperator = AS_XOR;
  103. _count_asmdirectives = longint(lastdirective)-longint(firstdirective);
  104. _count_asmoperators = longint(lastoperator)-longint(firstoperator);
  105. _asmdirectives : array[0.._count_asmdirectives] of tasmkeyword =
  106. ('DC.B','DC.W','DC.L','XDEF','END');
  107. { problems with shl,shr,not,and,or and xor, they are }
  108. { context sensitive. }
  109. _asmoperators : array[0.._count_asmoperators] of tasmkeyword = (
  110. 'MOD','SHL','SHR','NOT','AND','OR','XOR');
  111. token2str : array[tasmtoken] of tasmkeyword=(
  112. 'NONE','LABEL','LLABEL','STRING','HEXNUM','OCTALNUM',
  113. 'BINNUM',',','[',']','(',
  114. ')',':','.','+','-','*','INTNUM',
  115. 'SEPARATOR','ID','REGISTER','OPCODE','/','APPT','REALNUM',
  116. 'ALIGN',
  117. {------------------ Assembler directives --------------------}
  118. 'DB','DW','DD','XDEF','END',
  119. {------------------ Assembler Operators --------------------}
  120. 'MOD','SHL','SHR','NOT','AND','OR','XOR');
  121. const
  122. firsttoken : boolean = TRUE;
  123. operandnum : byte = 0;
  124. procedure tm68kmotreader.SetupTables;
  125. { creates uppercased symbol tables for speed access }
  126. var
  127. i : tasmop;
  128. Begin
  129. { opcodes }
  130. iasmops:=TFPHashList.create;
  131. for i:=firstop to lastop do
  132. iasmops.Add(upper(gas_op2str[i]),Pointer(PtrInt(i)));
  133. end;
  134. {---------------------------------------------------------------------}
  135. { Routines for the tokenizing }
  136. {---------------------------------------------------------------------}
  137. function tm68kmotreader.is_asmopcode(const s: string):boolean;
  138. var
  139. hs : string;
  140. j : byte;
  141. begin
  142. is_asmopcode:=false;
  143. { first of all we remove the suffix }
  144. j:=pos('.',s);
  145. if j>0 then
  146. hs:=copy(s,1,j-1)
  147. else
  148. hs:=s;
  149. { Search opcodes }
  150. actopcode:=tasmop(PtrUInt(iasmops.Find(hs)));
  151. { Also filter the helper opcodes, they can't be valid
  152. while reading an assembly source }
  153. if not (actopcode in
  154. [A_NONE, A_LABEL, A_DBXX, A_SXX, A_BXX, A_FBXX]) then
  155. begin
  156. actasmtoken:=AS_OPCODE;
  157. result:=TRUE;
  158. exit;
  159. end;
  160. end;
  161. Function tm68kmotreader.is_asmdirective(const s: string):boolean;
  162. var
  163. i:byte;
  164. begin
  165. result:=false;
  166. for i:=0 to _count_asmdirectives do
  167. begin
  168. if s=_asmdirectives[i] then
  169. begin
  170. actasmtoken := tasmtoken(longint(firstdirective)+i);
  171. result:=true;
  172. exit;
  173. end;
  174. end;
  175. end;
  176. function tm68kmotreader.is_register(const s:string):boolean;
  177. begin
  178. result:=false;
  179. actasmregister:=std_regnum_search(lower(s));
  180. if actasmregister<>NR_NO then
  181. begin
  182. result:=true;
  183. actasmtoken:=AS_REGISTER;
  184. end;
  185. { reg found?
  186. possible aliases are always 2 char
  187. }
  188. if result or (length(s)<>2) then
  189. exit;
  190. if lower(s)='sp' then
  191. actasmregister:=NR_STACK_POINTER_REG;
  192. if lower(s)='fp' then
  193. actasmregister:=NR_FRAME_POINTER_REG;
  194. if actasmregister<>NR_NO then
  195. begin
  196. result:=true;
  197. actasmtoken:=AS_REGISTER;
  198. end;
  199. end;
  200. Procedure tm68kmotreader.GetToken;
  201. {*********************************************************************}
  202. { FUNCTION GetToken: tinteltoken; }
  203. { Description: This routine returns intel assembler tokens and }
  204. { does some minor syntax error checking. }
  205. {*********************************************************************}
  206. var
  207. token: tasmtoken;
  208. forcelabel: boolean;
  209. begin
  210. c:=scanner.c;
  211. forcelabel := FALSE;
  212. actasmpattern :='';
  213. {* INIT TOKEN TO NOTHING *}
  214. token := AS_NONE;
  215. { while space and tab , continue scan... }
  216. while c in [' ',#9] do
  217. c:=current_scanner.asmgetchar;
  218. if not (c in [#10,#13,'{',';','(','/']) then
  219. current_scanner.gettokenpos;
  220. { Possiblities for first token in a statement: }
  221. { Local Label, Label, Directive, Prefix or Opcode.... }
  222. if firsttoken and not (c in [#10,#13,'{',';','(','/']) then
  223. begin
  224. firsttoken := FALSE;
  225. if c = '@' then
  226. begin
  227. token := AS_LLABEL; { this is a local label }
  228. { Let us point to the next character }
  229. c := current_scanner.asmgetchar;
  230. end;
  231. while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do
  232. begin
  233. { if there is an at_sign, then this must absolutely be a label }
  234. if c = '@' then forcelabel:=TRUE;
  235. actasmpattern := actasmpattern + c;
  236. c := current_scanner.asmgetchar;
  237. end;
  238. uppervar(actasmpattern);
  239. if c = ':' then
  240. begin
  241. case token of
  242. AS_NONE: token := AS_LABEL;
  243. AS_LLABEL: ; { do nothing }
  244. end; { end case }
  245. { let us point to the next character }
  246. c := current_scanner.asmgetchar;
  247. actasmtoken := token;
  248. exit;
  249. end;
  250. { Are we trying to create an identifier with }
  251. { an at-sign...? }
  252. if forcelabel then
  253. Message(asmr_e_none_label_contain_at);
  254. If is_asmopcode(actasmpattern) then
  255. exit;
  256. if is_asmdirective(actasmpattern) then
  257. exit
  258. else
  259. begin
  260. actasmtoken := AS_NONE;
  261. Message1(asmr_e_invalid_or_missing_opcode,actasmpattern);
  262. end;
  263. end
  264. else { else firsttoken }
  265. { Here we must handle all possible cases }
  266. begin
  267. case c of
  268. '@': { possiblities : - local label reference , such as in jmp @local1 }
  269. { - @Result, @Code or @Data special variables. }
  270. begin
  271. actasmpattern := c;
  272. c:= current_scanner.asmgetchar;
  273. while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do
  274. begin
  275. actasmpattern := actasmpattern + c;
  276. c := current_scanner.asmgetchar;
  277. end;
  278. uppervar(actasmpattern);
  279. actasmtoken := AS_ID;
  280. exit;
  281. end;
  282. { identifier, register, opcode, prefix or directive }
  283. 'A'..'Z','a'..'z','_': begin
  284. actasmpattern := c;
  285. c:= current_scanner.asmgetchar;
  286. while c in ['A'..'Z','a'..'z','0'..'9','_','.'] do
  287. begin
  288. actasmpattern := actasmpattern + c;
  289. c := current_scanner.asmgetchar;
  290. end;
  291. uppervar(actasmpattern);
  292. { this isn't the first token, so it can't be an
  293. opcode }
  294. { Actually, it's possible, since @label: OPCODE foo,bar
  295. is valid and was supported in 0.99/1.0 FPC for 68k,
  296. the amunits package is full of such code. (KB) }
  297. if is_asmopcode(actasmpattern) then
  298. exit;
  299. if is_register(actasmpattern) then
  300. exit;
  301. if is_asmdirective(actasmpattern) then
  302. exit;
  303. { this is surely an identifier }
  304. actasmtoken := AS_ID;
  305. exit;
  306. end;
  307. { override operator... not supported }
  308. '&': begin
  309. c:=current_scanner.asmgetchar;
  310. actasmtoken := AS_AND;
  311. end;
  312. { string or character }
  313. '''' :
  314. begin
  315. actasmpattern:='';
  316. while true do
  317. begin
  318. if c = '''' then
  319. begin
  320. c:=current_scanner.asmgetchar;
  321. if c=#10 then
  322. begin
  323. Message(scan_f_string_exceeds_line);
  324. break;
  325. end;
  326. repeat
  327. if c=''''then
  328. begin
  329. c:=current_scanner.asmgetchar;
  330. if c='''' then
  331. begin
  332. actasmpattern:=actasmpattern+'''';
  333. c:=current_scanner.asmgetchar;
  334. if c=#10 then
  335. begin
  336. Message(scan_f_string_exceeds_line);
  337. break;
  338. end;
  339. end
  340. else break;
  341. end
  342. else
  343. begin
  344. actasmpattern:=actasmpattern+c;
  345. c:=current_scanner.asmgetchar;
  346. if c=#10 then
  347. begin
  348. Message(scan_f_string_exceeds_line);
  349. break
  350. end;
  351. end;
  352. until false; { end repeat }
  353. end
  354. else break; { end if }
  355. end; { end while }
  356. token:=AS_STRING;
  357. actasmtoken := token;
  358. exit;
  359. end;
  360. '$' : begin
  361. c:=current_scanner.asmgetchar;
  362. while c in ['0'..'9','A'..'F','a'..'f'] do
  363. begin
  364. actasmpattern := actasmpattern + c;
  365. c := current_scanner.asmgetchar;
  366. end;
  367. actasmtoken := AS_HEXNUM;
  368. exit;
  369. end;
  370. ',' : begin
  371. actasmtoken := AS_COMMA;
  372. c:=current_scanner.asmgetchar;
  373. exit;
  374. end;
  375. '(' : begin
  376. c:=current_scanner.asmgetchar;
  377. if c='*' then
  378. begin
  379. current_scanner.skipoldtpcomment(true);
  380. GetToken;
  381. end
  382. else
  383. actasmtoken:=AS_LPAREN;
  384. exit;
  385. end;
  386. ')' : begin
  387. actasmtoken := AS_RPAREN;
  388. c:=current_scanner.asmgetchar;
  389. exit;
  390. end;
  391. ':' : begin
  392. actasmtoken := AS_COLON;
  393. c:=current_scanner.asmgetchar;
  394. exit;
  395. end;
  396. { '.' : begin
  397. actasmtoken := AS_DOT;
  398. c:=current_scanner.asmgetchar;
  399. exit;
  400. end; }
  401. '+' : begin
  402. actasmtoken := AS_PLUS;
  403. c:=current_scanner.asmgetchar;
  404. exit;
  405. end;
  406. '-' : begin
  407. actasmtoken := AS_MINUS;
  408. c:=current_scanner.asmgetchar;
  409. exit;
  410. end;
  411. '*' : begin
  412. actasmtoken := AS_STAR;
  413. c:=current_scanner.asmgetchar;
  414. exit;
  415. end;
  416. '/' : begin
  417. c:=current_scanner.asmgetchar;
  418. if c='/' then
  419. begin
  420. current_scanner.skipdelphicomment;
  421. GetToken;
  422. end
  423. else
  424. actasmtoken := AS_SLASH;
  425. exit;
  426. end;
  427. '<' : begin
  428. c := current_scanner.asmgetchar;
  429. { invalid characters }
  430. if c <> '<' then
  431. Message(asmr_e_invalid_char_smaller);
  432. { still assume << }
  433. actasmtoken := AS_SHL;
  434. c := current_scanner.asmgetchar;
  435. exit;
  436. end;
  437. '>' : begin
  438. c := current_scanner.asmgetchar;
  439. { invalid characters }
  440. if c <> '>' then
  441. Message(asmr_e_invalid_char_greater);
  442. { still assume << }
  443. actasmtoken := AS_SHR;
  444. c := current_scanner.asmgetchar;
  445. exit;
  446. end;
  447. '|' : begin
  448. actasmtoken := AS_OR;
  449. c := current_scanner.asmgetchar;
  450. exit;
  451. end;
  452. '^' : begin
  453. actasmtoken := AS_XOR;
  454. c := current_scanner.asmgetchar;
  455. exit;
  456. end;
  457. '#' : begin
  458. actasmtoken:=AS_APPT;
  459. c:=current_scanner.asmgetchar;
  460. exit;
  461. end;
  462. '%' : begin
  463. c:=current_scanner.asmgetchar;
  464. while c in ['0','1'] do
  465. begin
  466. actasmpattern := actasmpattern + c;
  467. c := current_scanner.asmgetchar;
  468. end;
  469. actasmtoken := AS_BINNUM;
  470. exit;
  471. end;
  472. { integer number }
  473. '0'..'9': begin
  474. actasmpattern := c;
  475. c := current_scanner.asmgetchar;
  476. while c in ['0'..'9'] do
  477. begin
  478. actasmpattern := actasmpattern + c;
  479. c:= current_scanner.asmgetchar;
  480. end;
  481. actasmtoken := AS_INTNUM;
  482. exit;
  483. end;
  484. ';' : begin
  485. repeat
  486. c:=current_scanner.asmgetchar;
  487. until c=#10;
  488. firsttoken := TRUE;
  489. actasmtoken:=AS_SEPARATOR;
  490. end;
  491. '{' : begin
  492. current_scanner.skipcomment(true);
  493. GetToken;
  494. end;
  495. #13,#10 : begin
  496. current_scanner.linebreak;
  497. c:=current_scanner.asmgetchar;
  498. firsttoken := TRUE;
  499. actasmtoken:=AS_SEPARATOR;
  500. end;
  501. else
  502. current_scanner.illegal_char(c);
  503. end; { end case }
  504. end; { end else if }
  505. end;
  506. {---------------------------------------------------------------------}
  507. { Routines for the parsing }
  508. {---------------------------------------------------------------------}
  509. function tm68kmotreader.consume(t : tasmtoken):boolean;
  510. begin
  511. Consume:=true;
  512. if t<>actasmtoken then
  513. begin
  514. Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
  515. Consume:=false;
  516. end;
  517. repeat
  518. gettoken;
  519. until actasmtoken<>AS_NONE;
  520. end;
  521. function tm68kmotreader.try_to_consume(t : tasmtoken):boolean;
  522. begin
  523. try_to_consume:=t=actasmtoken;
  524. if try_to_consume then
  525. Consume(actasmtoken);
  526. end;
  527. procedure tm68kmotreader.consume_all_until(tokens : tasmtokenset);
  528. begin
  529. while not (actasmtoken in tokens) do
  530. Consume(actasmtoken);
  531. end;
  532. function tm68kmotreader.findopcode(const s: string; var opsize: topsize): tasmop;
  533. {*********************************************************************}
  534. { FUNCTION findopcode(s: string): tasmop; }
  535. { Description: Determines if the s string is a valid opcode }
  536. { if so returns correct tasmop token. }
  537. {*********************************************************************}
  538. var
  539. j: longint;
  540. begin
  541. j:=pos('.',s);
  542. if (j <> 0) and (j < length(s)) then
  543. begin
  544. case s[j+1] of
  545. { For the motorola only opsize size is used to }
  546. { determine the size of the operands. }
  547. 'B': opsize := S_B;
  548. 'W': opsize := S_W;
  549. 'L': opsize := S_L;
  550. 'S': opsize := S_FS;
  551. 'D': opsize := S_FD;
  552. 'X': opsize := S_FX;
  553. else
  554. Message1(asmr_e_unknown_opcode,s);
  555. end;
  556. end;
  557. result:=actopcode;
  558. end;
  559. Function tm68kmotreader.BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint;
  560. {*********************************************************************}
  561. { FUNCTION BuildExpression: longint }
  562. { Description: This routine calculates a constant expression to }
  563. { a given value. The return value is the value calculated from }
  564. { the expression. }
  565. { The following tokens (not strings) are recognized: }
  566. { (,),SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
  567. {*********************************************************************}
  568. { ENTRY: On entry the token should be any valid expression token. }
  569. { EXIT: On Exit the token points to either COMMA or SEPARATOR }
  570. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  571. { invalid tokens. }
  572. {*********************************************************************}
  573. var expr: string;
  574. hs, tempstr: string;
  575. sym : tsym;
  576. srsymtable : TSymtable;
  577. hl : tasmlabel;
  578. l : tcgint;
  579. errorflag: boolean;
  580. begin
  581. BuildExpression:=0;
  582. errorflag := FALSE;
  583. expr := '';
  584. tempstr := '';
  585. if allow_symbol then
  586. asmsym^:='';
  587. Repeat
  588. Case actasmtoken of
  589. AS_LPAREN: begin
  590. Consume(AS_LPAREN);
  591. expr := expr + '(';
  592. end;
  593. AS_RPAREN: begin
  594. Consume(AS_RPAREN);
  595. expr := expr + ')';
  596. end;
  597. AS_SHL: begin
  598. Consume(AS_SHL);
  599. expr := expr + '<';
  600. end;
  601. AS_SHR: begin
  602. Consume(AS_SHR);
  603. expr := expr + '>';
  604. end;
  605. AS_SLASH: begin
  606. Consume(AS_SLASH);
  607. expr := expr + '/';
  608. end;
  609. AS_MOD: begin
  610. Consume(AS_MOD);
  611. expr := expr + '%';
  612. end;
  613. AS_STAR: begin
  614. Consume(AS_STAR);
  615. expr := expr + '*';
  616. end;
  617. AS_PLUS: begin
  618. Consume(AS_PLUS);
  619. expr := expr + '+';
  620. end;
  621. AS_MINUS: begin
  622. Consume(AS_MINUS);
  623. expr := expr + '-';
  624. end;
  625. AS_AND: begin
  626. Consume(AS_AND);
  627. expr := expr + '&';
  628. end;
  629. AS_NOT: begin
  630. Consume(AS_NOT);
  631. expr := expr + '~';
  632. end;
  633. AS_XOR: begin
  634. Consume(AS_XOR);
  635. expr := expr + '^';
  636. end;
  637. AS_OR: begin
  638. Consume(AS_OR);
  639. expr := expr + '|';
  640. end;
  641. AS_ID: begin
  642. if SearchIConstant(actasmpattern,l) then
  643. begin
  644. str(l, tempstr);
  645. expr := expr + tempstr;
  646. Consume(AS_ID);
  647. End else
  648. if not allow_symbol then
  649. begin
  650. Message(asmr_e_syn_constant);
  651. l := 0;
  652. End else
  653. begin
  654. hs:='';
  655. if (expr[Length(expr)]='+') then
  656. Delete(expr,Length(expr),1)
  657. else if expr<>'' then
  658. begin
  659. Message(asmr_e_invalid_constant_expression);
  660. break;
  661. End;
  662. tempstr:=actasmpattern;
  663. consume(AS_ID);
  664. if (length(tempstr)>1) and (tempstr[1]='@') then
  665. begin
  666. CreateLocalLabel(tempstr,hl,false);
  667. hs:=hl.name
  668. end
  669. else if SearchLabel(tempstr,hl,false) then
  670. hs:=hl.name
  671. else
  672. begin
  673. asmsearchsym(tempstr,sym,srsymtable);
  674. if assigned(sym) then
  675. begin
  676. case sym.typ of
  677. paravarsym,
  678. localvarsym :
  679. begin
  680. Message(asmr_e_no_local_or_para_allowed);
  681. hs:=tabstractvarsym(sym).mangledname;
  682. end;
  683. staticvarsym :
  684. hs:=tstaticvarsym(sym).mangledname;
  685. procsym :
  686. begin
  687. if tprocsym(sym).procdeflist.count>1 then
  688. Message(asmr_w_calling_overload_func);
  689. hs:=tprocdef(tprocsym(sym).procdeflist[0]).mangledname;
  690. end;
  691. typesym :
  692. begin
  693. if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then
  694. Message(asmr_e_wrong_sym_type);
  695. end;
  696. else
  697. Message(asmr_e_wrong_sym_type);
  698. end;
  699. end
  700. else
  701. Message1(sym_e_unknown_id,tempstr);
  702. end;
  703. { symbol found? }
  704. if hs<>'' then
  705. begin
  706. if asmsym^='' then
  707. asmsym^:=hs
  708. else
  709. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  710. end;
  711. end;
  712. end;
  713. AS_INTNUM: begin
  714. expr := expr + actasmpattern;
  715. Consume(AS_INTNUM);
  716. end;
  717. AS_BINNUM: begin
  718. tempstr := tostr(ParseVal(actasmpattern,2));
  719. if tempstr = '' then
  720. Message(asmr_e_error_converting_binary);
  721. expr:=expr+tempstr;
  722. Consume(AS_BINNUM);
  723. end;
  724. AS_HEXNUM: begin
  725. tempstr := tostr(ParseVal(actasmpattern,16));
  726. if tempstr = '' then
  727. Message(asmr_e_error_converting_hexadecimal);
  728. expr:=expr+tempstr;
  729. Consume(AS_HEXNUM);
  730. end;
  731. AS_OCTALNUM: begin
  732. tempstr := tostr(ParseVal(actasmpattern,8));
  733. if tempstr = '' then
  734. Message(asmr_e_error_converting_octal);
  735. expr:=expr+tempstr;
  736. Consume(AS_OCTALNUM);
  737. end;
  738. { go to next term }
  739. AS_COMMA: begin
  740. if not ErrorFlag then
  741. BuildExpression := CalculateExpression(expr)
  742. else
  743. BuildExpression := 0;
  744. Exit;
  745. end;
  746. { go to next symbol }
  747. AS_SEPARATOR: begin
  748. if not ErrorFlag then
  749. BuildExpression := CalculateExpression(expr)
  750. else
  751. BuildExpression := 0;
  752. Exit;
  753. end;
  754. else
  755. begin
  756. { only write error once. }
  757. if not errorflag then
  758. Message(asmr_e_invalid_constant_expression);
  759. { consume tokens until we find COMMA or SEPARATOR }
  760. Consume(actasmtoken);
  761. errorflag := TRUE;
  762. End;
  763. end;
  764. Until false;
  765. end;
  766. Procedure tm68kmotreader.BuildRealConstant(typ : tfloattype);
  767. {*********************************************************************}
  768. { PROCEDURE BuilRealConst }
  769. { Description: This routine calculates a constant expression to }
  770. { a given value. The return value is the value calculated from }
  771. { the expression. }
  772. { The following tokens (not strings) are recognized: }
  773. { +/-,numbers and real numbers }
  774. {*********************************************************************}
  775. { ENTRY: On entry the token should be any valid expression token. }
  776. { EXIT: On Exit the token points to either COMMA or SEPARATOR }
  777. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  778. { invalid tokens. }
  779. {*********************************************************************}
  780. var expr: string;
  781. r : extended;
  782. code : word;
  783. negativ : boolean;
  784. errorflag: boolean;
  785. begin
  786. errorflag := FALSE;
  787. Repeat
  788. negativ:=false;
  789. expr := '';
  790. if actasmtoken=AS_PLUS then Consume(AS_PLUS)
  791. else if actasmtoken=AS_MINUS then
  792. begin
  793. negativ:=true;
  794. consume(AS_MINUS);
  795. end;
  796. Case actasmtoken of
  797. AS_INTNUM: begin
  798. expr := actasmpattern;
  799. Consume(AS_INTNUM);
  800. end;
  801. AS_REALNUM: begin
  802. expr := actasmpattern;
  803. { in ATT syntax you have 0d in front of the real }
  804. { should this be forced ? yes i think so, as to }
  805. { conform to gas as much as possible. }
  806. if (expr[1]='0') and (upper(expr[2])='D') then
  807. expr:=copy(expr,3,255);
  808. Consume(AS_REALNUM);
  809. end;
  810. AS_BINNUM: begin
  811. { checking for real constants with this should use }
  812. { real DECODING otherwise the compiler will crash! }
  813. Message(asmr_e_invalid_float_expr);
  814. expr:='0.0';
  815. Consume(AS_BINNUM);
  816. end;
  817. AS_HEXNUM: begin
  818. { checking for real constants with this should use }
  819. { real DECODING otherwise the compiler will crash! }
  820. Message(asmr_e_invalid_float_expr);
  821. expr:='0.0';
  822. Consume(AS_HEXNUM);
  823. end;
  824. AS_OCTALNUM: begin
  825. { checking for real constants with this should use }
  826. { real DECODING otherwise the compiler will crash! }
  827. { xxxToDec using reals could be a solution, but the }
  828. { problem is that these will crash the m68k compiler }
  829. { when compiling -- because of lack of good fpu }
  830. { support. }
  831. Message(asmr_e_invalid_float_expr);
  832. expr:='0.0';
  833. Consume(AS_OCTALNUM);
  834. end;
  835. else
  836. begin
  837. { only write error once. }
  838. if not errorflag then
  839. Message(asmr_e_invalid_float_expr);
  840. { consume tokens until we find COMMA or SEPARATOR }
  841. Consume(actasmtoken);
  842. errorflag := TRUE;
  843. End;
  844. end;
  845. { go to next term }
  846. if (actasmtoken=AS_COMMA) or (actasmtoken=AS_SEPARATOR) then
  847. begin
  848. if negativ then expr:='-'+expr;
  849. val(expr,r,code);
  850. if code<>0 then
  851. begin
  852. r:=0;
  853. Message(asmr_e_invalid_float_expr);
  854. ConcatRealConstant(curlist,r,typ);
  855. End
  856. else
  857. begin
  858. ConcatRealConstant(curlist,r,typ);
  859. End;
  860. end
  861. else
  862. Message(asmr_e_invalid_float_expr);
  863. Until actasmtoken=AS_SEPARATOR;
  864. end;
  865. Procedure tm68kmotreader.BuildConstant(maxvalue: longint);
  866. {*********************************************************************}
  867. { PROCEDURE BuildConstant }
  868. { Description: This routine takes care of parsing a DB,DD,or DW }
  869. { line and adding those to the assembler node. Expressions, range- }
  870. { checking are fullly taken care of. }
  871. { maxvalue: $ff -> indicates that this is a DB node. }
  872. { $ffff -> indicates that this is a DW node. }
  873. { $ffffffff -> indicates that this is a DD node. }
  874. {*********************************************************************}
  875. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  876. {*********************************************************************}
  877. var
  878. expr: string;
  879. value : longint;
  880. begin
  881. Repeat
  882. Case actasmtoken of
  883. AS_STRING: begin
  884. if maxvalue <> $ff then
  885. Message(asmr_e_string_not_allowed_as_const);
  886. expr := actasmpattern;
  887. if length(expr) > 1 then
  888. Message(asmr_e_string_not_allowed_as_const);
  889. Consume(AS_STRING);
  890. Case actasmtoken of
  891. AS_COMMA: Consume(AS_COMMA);
  892. AS_SEPARATOR: ;
  893. else
  894. Message(asmr_e_invalid_string_expression);
  895. end; { end case }
  896. ConcatString(curlist,expr);
  897. end;
  898. AS_INTNUM,AS_BINNUM,
  899. AS_OCTALNUM,AS_HEXNUM:
  900. begin
  901. value:=BuildExpression(false,nil);
  902. ConcatConstant(curlist,value,maxvalue);
  903. end;
  904. AS_ID:
  905. begin
  906. value:=BuildExpression(false,nil);
  907. if value > maxvalue then
  908. begin
  909. Message(asmr_e_constant_out_of_bounds);
  910. { assuming a value of maxvalue }
  911. value := maxvalue;
  912. end;
  913. ConcatConstant(curlist,value,maxvalue);
  914. end;
  915. { These terms can start an assembler expression }
  916. AS_PLUS,AS_MINUS,AS_LPAREN,AS_NOT: begin
  917. value := BuildExpression(false,nil);
  918. ConcatConstant(curlist,value,maxvalue);
  919. end;
  920. AS_COMMA: begin
  921. Consume(AS_COMMA);
  922. END;
  923. AS_SEPARATOR: ;
  924. else
  925. begin
  926. Message(asmr_e_syntax_error);
  927. end;
  928. end; { end case }
  929. Until actasmtoken = AS_SEPARATOR;
  930. end;
  931. Procedure TM68kMotreader.BuildScaling(const oper:tm68koperand);
  932. {*********************************************************************}
  933. { Takes care of parsing expression starting from the scaling value }
  934. { up to and including possible field specifiers. }
  935. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR }
  936. { or AS_COMMA. On entry should point to the AS_STAR token. }
  937. {*********************************************************************}
  938. var str:string;
  939. l: longint;
  940. code: integer;
  941. begin
  942. str:='';
  943. Consume(AS_STAR);
  944. if (oper.opr.ref.scalefactor <> 0)
  945. and (oper.opr.ref.scalefactor <> 1) then
  946. Message(asmr_e_wrong_base_index);
  947. case actasmtoken of
  948. AS_INTNUM: str := actasmpattern;
  949. AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16));
  950. AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2));
  951. AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8));
  952. else
  953. Message(asmr_e_syntax_error);
  954. end;
  955. val(str, l, code);
  956. if code <> 0 then
  957. Message(asmr_e_wrong_scale_factor);
  958. if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then
  959. begin
  960. oper.opr.ref.scalefactor := l;
  961. end
  962. else
  963. begin
  964. Message(asmr_e_wrong_scale_factor);
  965. oper.opr.ref.scalefactor := 0;
  966. end;
  967. if oper.opr.ref.index = NR_NO then
  968. begin
  969. Message(asmr_e_wrong_base_index);
  970. oper.opr.ref.scalefactor := 0;
  971. end;
  972. { Consume the scaling number }
  973. Consume(actasmtoken);
  974. if actasmtoken = AS_RPAREN then
  975. Consume(AS_RPAREN)
  976. else
  977. Message(asmr_e_wrong_scale_factor);
  978. { // .Field.Field ... or separator/comma // }
  979. if actasmtoken in [AS_COMMA,AS_SEPARATOR] then
  980. begin
  981. end
  982. else
  983. Message(asmr_e_syntax_error);
  984. end;
  985. Function TM68kMotreader.BuildRefExpression: longint;
  986. {*********************************************************************}
  987. { FUNCTION BuildRefExpression: longint }
  988. { Description: This routine calculates a constant expression to }
  989. { a given value. The return value is the value calculated from }
  990. { the expression. }
  991. { The following tokens (not strings) are recognized: }
  992. { SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
  993. {*********************************************************************}
  994. { ENTRY: On entry the token should be any valid expression token. }
  995. { EXIT: On Exit the token points to the LPAREN token. }
  996. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  997. { invalid tokens. }
  998. {*********************************************************************}
  999. var
  1000. tempstr: string;
  1001. expr: string;
  1002. l : tcgint;
  1003. errorflag : boolean;
  1004. begin
  1005. BuildRefExpression := 0;
  1006. errorflag := FALSE;
  1007. expr := '';
  1008. repeat
  1009. tempstr := '';
  1010. case actasmtoken of
  1011. AS_RPAREN:
  1012. Message(asmr_e_syntax_error);
  1013. AS_SHL:
  1014. tempstr := '<';
  1015. AS_SHR:
  1016. tempstr := '>';
  1017. AS_SLASH:
  1018. tempstr := '/';
  1019. AS_MOD:
  1020. tempstr := '%';
  1021. AS_STAR:
  1022. tempstr := '*';
  1023. AS_PLUS:
  1024. tempstr := '+';
  1025. AS_MINUS:
  1026. tempstr := '-';
  1027. AS_AND:
  1028. tempstr := '&';
  1029. AS_NOT:
  1030. tempstr := '~';
  1031. AS_XOR:
  1032. tempstr := '^';
  1033. AS_OR:
  1034. tempstr := '|';
  1035. { End of reference }
  1036. AS_LPAREN:
  1037. begin
  1038. if not ErrorFlag then
  1039. BuildRefExpression := CalculateExpression(expr);
  1040. { no longer in an expression }
  1041. exit;
  1042. end;
  1043. AS_ID:
  1044. begin
  1045. if not SearchIConstant(actasmpattern,l) then
  1046. begin
  1047. Message(asmr_e_syn_constant);
  1048. l := 0;
  1049. end;
  1050. str(l, tempstr);
  1051. end;
  1052. AS_INTNUM:
  1053. tempstr := actasmpattern;
  1054. AS_BINNUM:
  1055. begin
  1056. tempstr := Tostr(ParseVal(actasmpattern,2));
  1057. if tempstr = '' then
  1058. Message(asmr_e_error_converting_binary);
  1059. end;
  1060. AS_HEXNUM:
  1061. begin
  1062. tempstr := Tostr(ParseVal(actasmpattern,16));
  1063. if tempstr = '' then
  1064. Message(asmr_e_error_converting_hexadecimal);
  1065. end;
  1066. AS_OCTALNUM:
  1067. begin
  1068. tempstr := Tostr(ParseVal(actasmpattern,8));
  1069. if tempstr = '' then
  1070. Message(asmr_e_error_converting_octal);
  1071. end;
  1072. else
  1073. begin
  1074. { write error only once. }
  1075. if not errorflag then
  1076. Message(asmr_e_invalid_constant_expression);
  1077. if actasmtoken in [AS_COMMA,AS_SEPARATOR] then exit;
  1078. { consume tokens until we find COMMA or SEPARATOR }
  1079. errorflag := true;
  1080. end;
  1081. end;
  1082. if tempstr <> '' then
  1083. expr := expr + tempstr;
  1084. Consume(actasmtoken);
  1085. until false;
  1086. end;
  1087. {*********************************************************************}
  1088. { PROCEDURE BuildBracketExpression }
  1089. { Description: This routine builds up an expression after a LPAREN }
  1090. { token is encountered. }
  1091. { On entry actasmtoken should be equal to AS_LPAREN }
  1092. {*********************************************************************}
  1093. { EXIT CONDITION: On exit the routine should point to either the }
  1094. { AS_COMMA or AS_SEPARATOR token. }
  1095. {*********************************************************************}
  1096. procedure TM68kMotreader.BuildReference(const oper:tm68koperand);
  1097. var
  1098. l:longint;
  1099. code: integer;
  1100. str: string;
  1101. begin
  1102. str:='';
  1103. Consume(AS_LPAREN);
  1104. case actasmtoken of
  1105. { // (reg ... // }
  1106. AS_REGISTER:
  1107. begin
  1108. oper.opr.ref.base := actasmregister;
  1109. Consume(AS_REGISTER);
  1110. { can either be a register or a right parenthesis }
  1111. { // (reg) // }
  1112. { // (reg)+ // }
  1113. if actasmtoken=AS_RPAREN then
  1114. begin
  1115. Consume(AS_RPAREN);
  1116. if actasmtoken = AS_PLUS then
  1117. begin
  1118. if (oper.opr.ref.direction <> dir_none) then
  1119. Message(asmr_e_no_inc_and_dec_together)
  1120. else
  1121. oper.opr.ref.direction := dir_inc;
  1122. Consume(AS_PLUS);
  1123. end;
  1124. if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then
  1125. begin
  1126. Message(asmr_e_invalid_reference_syntax);
  1127. { error recovery ... }
  1128. while actasmtoken <> AS_SEPARATOR do
  1129. Consume(actasmtoken);
  1130. end;
  1131. exit;
  1132. end;
  1133. { // (reg,reg .. // }
  1134. Consume(AS_COMMA);
  1135. if actasmtoken = AS_REGISTER then
  1136. begin
  1137. oper.opr.ref.index :=
  1138. actasmregister;
  1139. Consume(AS_REGISTER);
  1140. { check for scaling ... }
  1141. case actasmtoken of
  1142. AS_RPAREN:
  1143. begin
  1144. Consume(AS_RPAREN);
  1145. if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then
  1146. begin
  1147. { error recovery ... }
  1148. Message(asmr_e_invalid_reference_syntax);
  1149. while actasmtoken <> AS_SEPARATOR do
  1150. Consume(actasmtoken);
  1151. end;
  1152. exit;
  1153. end;
  1154. AS_STAR:
  1155. begin
  1156. BuildScaling(oper);
  1157. end;
  1158. else
  1159. begin
  1160. Message(asmr_e_invalid_reference_syntax);
  1161. while (actasmtoken <> AS_SEPARATOR) do
  1162. Consume(actasmtoken);
  1163. end;
  1164. end; { end case }
  1165. end
  1166. else
  1167. begin
  1168. Message(asmr_e_invalid_reference_syntax);
  1169. while (actasmtoken <> AS_SEPARATOR) do
  1170. Consume(actasmtoken);
  1171. end;
  1172. end;
  1173. AS_HEXNUM,AS_OCTALNUM, { direct address }
  1174. AS_BINNUM,AS_INTNUM:
  1175. begin
  1176. case actasmtoken of
  1177. AS_INTNUM: str := actasmpattern;
  1178. AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16));
  1179. AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2));
  1180. AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8));
  1181. else
  1182. Message(asmr_e_syntax_error);
  1183. end;
  1184. Consume(actasmtoken);
  1185. val(str, l, code);
  1186. if code <> 0 then
  1187. Message(asmr_e_invalid_reference_syntax)
  1188. else
  1189. oper.opr.ref.offset := l;
  1190. Consume(AS_RPAREN);
  1191. if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then
  1192. begin
  1193. { error recovery ... }
  1194. Message(asmr_e_invalid_reference_syntax);
  1195. while actasmtoken <> AS_SEPARATOR do
  1196. Consume(actasmtoken);
  1197. end;
  1198. exit;
  1199. end;
  1200. else
  1201. begin
  1202. Message(asmr_e_invalid_reference_syntax);
  1203. while (actasmtoken <> AS_SEPARATOR) do
  1204. Consume(actasmtoken);
  1205. end;
  1206. end;
  1207. end;
  1208. procedure tm68kmotreader.BuildRegList(const oper:tm68koperand);
  1209. {*********************************************************************}
  1210. { EXIT CONDITION: On exit the routine should point to either the }
  1211. { AS_COMMA or AS_SEPARATOR token. }
  1212. {*********************************************************************}
  1213. var
  1214. i: Tsuperregister;
  1215. reg_one, reg_two: tregister;
  1216. rs_one, rs_two: tsuperregister;
  1217. addrregset,dataregset,fpuregset: tcpuregisterset;
  1218. errorflag, first: boolean;
  1219. begin
  1220. dataregset := [];
  1221. addrregset := [];
  1222. fpuregset := [];
  1223. { 1., try to consume a register list
  1224. 2., if successful, add the register list
  1225. 3., if not possible, then we have a standalone register, add
  1226. 4., repeat until we dont have a slash any more }
  1227. errorflag:=false;
  1228. first:=true;
  1229. repeat
  1230. reg_one:=actasmregister;
  1231. rs_one:=getsupreg(reg_one);
  1232. if not (first or try_to_consume(AS_REGISTER)) then
  1233. begin
  1234. errorflag:=true;
  1235. break;
  1236. end;
  1237. first:=false;
  1238. { try to consume a register list }
  1239. if try_to_consume(AS_MINUS) then
  1240. begin
  1241. reg_two:=actasmregister;
  1242. rs_two:=getsupreg(reg_two);
  1243. if (not try_to_consume(AS_REGISTER)) or
  1244. (rs_one >= rs_two) or
  1245. (getregtype(reg_one) <> getregtype(reg_two)) then
  1246. begin
  1247. errorflag:=true;
  1248. break;
  1249. end;
  1250. end
  1251. else
  1252. begin
  1253. { nope, we have a single element "list" }
  1254. reg_two:=reg_one;
  1255. rs_two:=getsupreg(reg_two);
  1256. end;
  1257. case getregtype(reg_one) of
  1258. R_INTREGISTER:
  1259. for i:=getsupreg(reg_one) to getsupreg(reg_two) do
  1260. include(dataregset,i);
  1261. R_ADDRESSREGISTER:
  1262. for i:=getsupreg(reg_one) to getsupreg(reg_two) do
  1263. include(addrregset,i);
  1264. R_FPUREGISTER:
  1265. for i:=getsupreg(reg_one) to getsupreg(reg_two) do
  1266. include(fpuregset,i);
  1267. else
  1268. internalerror(201611041);
  1269. end;
  1270. until not try_to_consume(AS_SLASH);
  1271. errorflag:=errorflag or
  1272. (((dataregset <> []) or (addrregset <> [])) and (fpuregset <> [])) or
  1273. (not (actasmtoken in [AS_SEPARATOR,AS_COMMA]));
  1274. if errorflag then
  1275. begin
  1276. Message(asmr_e_invalid_reg_list_in_movem_or_fmovem);
  1277. consume_all_until([AS_SEPARATOR,AS_COMMA]);
  1278. end
  1279. else
  1280. begin
  1281. oper.opr.typ:= OPR_REGSET;
  1282. oper.opr.regsetdata := dataregset;
  1283. oper.opr.regsetaddr := addrregset;
  1284. oper.opr.regsetfpu := fpuregset;
  1285. end;
  1286. end;
  1287. procedure tm68kmotreader.BuildRegPair(const oper:tm68koperand);
  1288. {*********************************************************************}
  1289. { EXIT CONDITION: On exit the routine should point to either the }
  1290. { AS_COMMA or AS_SEPARATOR token. }
  1291. {*********************************************************************}
  1292. begin
  1293. oper.opr.typ := OPR_REGPAIR;
  1294. oper.opr.reghi := actasmregister;
  1295. Consume(AS_COLON);
  1296. if not try_to_consume(AS_REGISTER) then
  1297. begin
  1298. Message(asmr_e_invalid_reg_list_for_opcode);
  1299. consume_all_until([AS_SEPARATOR,AS_COMMA]);
  1300. end
  1301. else
  1302. oper.opr.reglo:=actasmregister;
  1303. end;
  1304. Procedure TM68kMotreader.BuildOperand(const oper:tm68koperand);
  1305. {*********************************************************************}
  1306. { EXIT CONDITION: On exit the routine should point to either the }
  1307. { AS_COMMA or AS_SEPARATOR token. }
  1308. {*********************************************************************}
  1309. var
  1310. expr: string;
  1311. tempstr: string;
  1312. lab: tasmlabel;
  1313. l : tcgint;
  1314. hl: tasmlabel;
  1315. p: pointer;
  1316. begin
  1317. case actasmtoken of
  1318. { // Memory reference // }
  1319. AS_LPAREN:
  1320. begin
  1321. Oper.InitRef;
  1322. BuildReference(oper);
  1323. end;
  1324. { // Constant expression // }
  1325. AS_APPT: begin
  1326. Consume(AS_APPT);
  1327. if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1328. Message(asmr_e_invalid_operand_type);
  1329. { identifiers are handled by BuildExpression }
  1330. oper.opr.typ := OPR_CONSTANT;
  1331. oper.opr.val :=BuildExpression(true,@tempstr);
  1332. if tempstr<>'' then
  1333. begin
  1334. l:=oper.opr.val;
  1335. oper.opr.typ := OPR_SYMBOL;
  1336. oper.opr.symofs := l;
  1337. oper.opr.symbol := current_asmdata.RefAsmSymbol(tempstr,AT_FUNCTION);
  1338. end;
  1339. end;
  1340. { // Constant memory offset . // }
  1341. { // This must absolutely be followed by ( // }
  1342. AS_HEXNUM,AS_INTNUM,
  1343. AS_BINNUM,AS_OCTALNUM,AS_PLUS:
  1344. begin
  1345. Oper.InitRef;
  1346. oper.opr.ref.offset:=BuildRefExpression;
  1347. BuildReference(oper);
  1348. end;
  1349. { // A constant expression, or a Variable ref. // }
  1350. AS_ID: begin
  1351. if actasmpattern[1] = '@' then
  1352. { // Label or Special symbol reference // }
  1353. begin
  1354. if actasmpattern = '@RESULT' then
  1355. oper.SetUpResult
  1356. else
  1357. if actasmpattern = 'SELF' then
  1358. oper.SetUpSelf
  1359. else
  1360. if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
  1361. Message(asmr_w_CODE_and_DATA_not_supported)
  1362. else
  1363. begin
  1364. delete(actasmpattern,1,1);
  1365. if actasmpattern = '' then
  1366. Message(asmr_e_null_label_ref_not_allowed);
  1367. CreateLocalLabel(actasmpattern,lab,false);
  1368. oper.opr.typ := OPR_SYMBOL;
  1369. oper.opr.symbol := lab;
  1370. oper.opr.symofs := 0;
  1371. end;
  1372. Consume(AS_ID);
  1373. if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
  1374. Message(asmr_e_syntax_error);
  1375. end
  1376. { probably a variable or normal expression }
  1377. { or a procedure (such as in CALL ID) }
  1378. else
  1379. begin
  1380. { is it a constant ? }
  1381. if SearchIConstant(actasmpattern,l) then
  1382. begin
  1383. Oper.InitRef;
  1384. oper.opr.ref.offset:=BuildRefExpression;
  1385. BuildReference(oper);
  1386. end
  1387. else { is it a label variable ? }
  1388. { // ID[ , ID.Field.Field or simple ID // }
  1389. { check if this is a label, if so then }
  1390. { emit it as a label. }
  1391. if SearchLabel(actasmpattern,hl,false) then
  1392. begin
  1393. oper.opr.typ := OPR_SYMBOL;
  1394. oper.opr.symbol := hl;
  1395. oper.opr.symofs := 0;
  1396. Consume(AS_ID);
  1397. if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
  1398. Message(asmr_e_syntax_error);
  1399. end
  1400. else begin
  1401. expr:=actasmpattern;
  1402. Consume(AS_ID);
  1403. { typecasting? }
  1404. if SearchType(expr,l) then
  1405. begin
  1406. oper.hastype:=true;
  1407. oper.typesize:=l;
  1408. case actasmtoken of
  1409. AS_LPAREN :
  1410. begin
  1411. { Support Type([Reference]) }
  1412. Consume(AS_LPAREN);
  1413. BuildOperand(oper{,true});
  1414. Consume(AS_RPAREN);
  1415. end;
  1416. AS_LBRACKET :
  1417. begin
  1418. { Support Var.Type[Index] }
  1419. { Convert @label.Byte[1] to reference }
  1420. if oper.opr.typ=OPR_SYMBOL then
  1421. oper.initref;
  1422. end;
  1423. end;
  1424. end
  1425. else
  1426. begin
  1427. if not oper.SetupVar(expr,false) then
  1428. begin
  1429. { not a variable, check special variables.. }
  1430. if expr = 'SELF' then
  1431. oper.SetupSelf
  1432. else begin
  1433. Message1(sym_e_unknown_id,expr);
  1434. end;
  1435. expr:='';
  1436. end;
  1437. end;
  1438. // Message1(sym_e_unknown_id,actasmpattern);
  1439. end;
  1440. case actasmtoken of
  1441. AS_LPAREN: { indexing }
  1442. BuildReference(oper);
  1443. AS_SEPARATOR,AS_COMMA: begin
  1444. end;
  1445. else
  1446. Message(asmr_e_syntax_error);
  1447. end;
  1448. end;
  1449. end;
  1450. { // Pre-decrement mode reference or constant mem offset. // }
  1451. AS_MINUS: begin
  1452. Consume(AS_MINUS);
  1453. if actasmtoken = AS_LPAREN then
  1454. begin
  1455. Oper.InitRef;
  1456. { indicate pre-decrement mode }
  1457. oper.opr.ref.direction := dir_dec;
  1458. BuildReference(oper);
  1459. end
  1460. else
  1461. if actasmtoken in [AS_OCTALNUM,AS_HEXNUM,AS_BINNUM,AS_INTNUM] then
  1462. begin
  1463. Oper.InitRef;
  1464. oper.opr.ref.offset:=BuildRefExpression;
  1465. { negate because was preceded by a negative sign! }
  1466. oper.opr.ref.offset:=-oper.opr.ref.offset;
  1467. BuildReference(oper);
  1468. end
  1469. else
  1470. begin
  1471. Message(asmr_e_syntax_error);
  1472. while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do
  1473. Consume(actasmtoken);
  1474. end;
  1475. end;
  1476. { // Register, a variable reference or a constant reference // }
  1477. AS_REGISTER: begin
  1478. Consume(AS_REGISTER);
  1479. case actasmtoken of
  1480. AS_SEPARATOR, AS_COMMA:
  1481. begin
  1482. { // Simple register // }
  1483. if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
  1484. Message(asmr_e_invalid_operand_type);
  1485. oper.opr.typ := OPR_REGISTER;
  1486. oper.opr.reg := actasmregister;
  1487. end;
  1488. AS_SLASH, AS_MINUS:
  1489. { // Register listing // }
  1490. BuildRegList(oper);
  1491. AS_COLON:
  1492. { // Register pair // }
  1493. BuildRegPair(oper);
  1494. else
  1495. Message(asmr_e_invalid_register);
  1496. end;
  1497. end;
  1498. AS_SEPARATOR, AS_COMMA: ;
  1499. else
  1500. begin
  1501. Message(asmr_e_invalid_opcode_and_operand);
  1502. Consume(actasmtoken);
  1503. end;
  1504. end; { end case }
  1505. end;
  1506. Procedure TM68kmotReader.BuildOpCode(instr:Tm68kinstruction);
  1507. {*********************************************************************}
  1508. { PROCEDURE BuildOpcode; }
  1509. { Description: Parses the intel opcode and operands, and writes it }
  1510. { in the TInstruction object. }
  1511. {*********************************************************************}
  1512. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  1513. { On ENTRY: Token should point to AS_OPCODE }
  1514. {*********************************************************************}
  1515. var
  1516. operandnum : longint;
  1517. begin
  1518. { // opcode // }
  1519. { allow for newline as in gas styled syntax }
  1520. { under DOS you get two AS_SEPARATOR !! }
  1521. while actasmtoken=AS_SEPARATOR do
  1522. Consume(AS_SEPARATOR);
  1523. if (actasmtoken <> AS_OPCODE) then
  1524. begin
  1525. Message(asmr_e_invalid_or_missing_opcode);
  1526. { error recovery }
  1527. While not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do
  1528. Consume(actasmtoken);
  1529. exit;
  1530. end
  1531. else
  1532. begin
  1533. Instr.opcode := findopcode(actasmpattern,instr.opsize);
  1534. Consume(AS_OPCODE);
  1535. { // Zero operand opcode ? // }
  1536. if actasmtoken = AS_SEPARATOR then
  1537. exit
  1538. else
  1539. operandnum := 1;
  1540. end;
  1541. While actasmtoken <> AS_SEPARATOR do
  1542. begin
  1543. case actasmtoken of
  1544. { // Operand delimiter // }
  1545. AS_COMMA: begin
  1546. if operandnum > Max_Operands then
  1547. Message(asmr_e_too_many_operands)
  1548. else
  1549. Inc(operandnum);
  1550. Consume(AS_COMMA);
  1551. end;
  1552. { // End of asm operands for this opcode // }
  1553. AS_SEPARATOR: ;
  1554. else
  1555. BuildOperand(Instr.Operands[operandnum] as tm68koperand);
  1556. end; { end case }
  1557. end; { end while }
  1558. instr.Ops:=operandnum;
  1559. end;
  1560. function tm68kmotreader.Assemble: tlinkedlist;
  1561. var
  1562. hl: tasmlabel;
  1563. instr : TM68kInstruction;
  1564. begin
  1565. //Message(asmr_d_start_reading);
  1566. firsttoken := TRUE;
  1567. operandnum := 0;
  1568. { sets up all opcode and register tables in uppercase }
  1569. if not _asmsorted then
  1570. begin
  1571. SetupTables;
  1572. _asmsorted := TRUE;
  1573. end;
  1574. curlist:=TAsmList.Create;
  1575. gettoken;
  1576. while actasmtoken<>AS_END do
  1577. begin
  1578. case actasmtoken of
  1579. AS_LLABEL:
  1580. begin
  1581. if CreateLocalLabel(actasmpattern,hl,true) then
  1582. ConcatLabel(curlist,hl);
  1583. Consume(AS_LLABEL);
  1584. end;
  1585. AS_LABEL:
  1586. begin
  1587. { when looking for Pascal labels, these must }
  1588. { be in uppercase. }
  1589. if SearchLabel(upper(actasmpattern),hl,true) then
  1590. ConcatLabel(curlist,hl)
  1591. else
  1592. Message1(asmr_e_unknown_label_identifier,actasmpattern);
  1593. Consume(AS_LABEL);
  1594. end;
  1595. AS_DW:
  1596. begin
  1597. Consume(AS_DW);
  1598. BuildConstant($ffff);
  1599. end;
  1600. AS_DB:
  1601. begin
  1602. Consume(AS_DB);
  1603. BuildConstant($ff);
  1604. end;
  1605. AS_DD:
  1606. begin
  1607. Consume(AS_DD);
  1608. BuildConstant(longint($ffffffff));
  1609. end;
  1610. AS_XDEF:
  1611. begin
  1612. Consume(AS_XDEF);
  1613. if actasmtoken=AS_ID then
  1614. ConcatPublic(curlist,actasmpattern);
  1615. Consume(AS_ID);
  1616. if actasmtoken<>AS_SEPARATOR then
  1617. Consume(AS_SEPARATOR);
  1618. end;
  1619. AS_ALIGN:
  1620. begin
  1621. Message(asmr_w_align_not_supported);
  1622. while actasmtoken <> AS_SEPARATOR do
  1623. Consume(actasmtoken);
  1624. end;
  1625. AS_OPCODE:
  1626. begin
  1627. instr:=TM68kInstruction.Create(tm68koperand);
  1628. BuildOpcode(instr);
  1629. // instr.AddReferenceSizes;
  1630. // instr.SetInstructionOpsize;
  1631. // instr.CheckOperandSizes;
  1632. if instr.labeled then
  1633. instr.ConcatLabeledInstr(curlist)
  1634. else begin
  1635. instr.ConcatInstruction(curlist);
  1636. end;
  1637. instr.Free;
  1638. end;
  1639. AS_SEPARATOR:
  1640. begin
  1641. Consume(AS_SEPARATOR);
  1642. { let us go back to the first operand }
  1643. operandnum := 0;
  1644. end;
  1645. AS_END:
  1646. { end assembly block }
  1647. ;
  1648. else
  1649. begin
  1650. Message(asmr_e_syntax_error);
  1651. { error recovery }
  1652. Consume(actasmtoken);
  1653. end;
  1654. end; { end case }
  1655. end; { end while }
  1656. { Check LocalLabelList }
  1657. checklocallabels;
  1658. assemble:=curlist;
  1659. //Message(asmr_d_finish_reading);
  1660. end;
  1661. {*****************************************************************************
  1662. Initialize
  1663. *****************************************************************************}
  1664. const
  1665. asmmode_m68k_mot_info : tasmmodeinfo =
  1666. (
  1667. id : asmmode_m68k_mot;
  1668. idtxt : 'MOTOROLA';
  1669. casmreader : tm68kmotreader;
  1670. );
  1671. asmmode_m68k_standard_info : tasmmodeinfo =
  1672. (
  1673. id : asmmode_standard;
  1674. idtxt : 'STANDARD';
  1675. casmreader : tm68kmotreader;
  1676. );
  1677. begin
  1678. RegisterAsmMode(asmmode_m68k_mot_info);
  1679. RegisterAsmMode(asmmode_m68k_standard_info);
  1680. end.