ra68kmot.pas 64 KB

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