ra68kmot.pas 67 KB

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