ra68kmot.pas 68 KB

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