ra68kmot.pas 68 KB

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