ra68kmot.pas 64 KB

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