ra68kmot.pas 69 KB

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