ra68kmot.pas 70 KB

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