ra386att.pas 56 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Carl Eric Codere and Peter Vreman
  4. Does the parsing for the AT&T styled inline assembler.
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {$ifdef TP}
  19. {$N+,E+}
  20. {$endif TP}
  21. Unit Ra386att;
  22. Interface
  23. uses
  24. tree;
  25. function assemble: ptree;
  26. Implementation
  27. Uses
  28. globtype,
  29. strings,cobjects,systems,verbose,globals,
  30. files,aasm,types,symconst,symtable,scanner,cpubase,
  31. {$ifdef NEWCG}
  32. cgbase,
  33. {$else}
  34. hcodegen,
  35. {$endif}
  36. rautils,ra386;
  37. type
  38. tasmtoken = (
  39. AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
  40. AS_REALNUM,AS_COMMA,AS_LPAREN,
  41. AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,
  42. AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_DOLLAR,
  43. {------------------ Assembler directives --------------------}
  44. AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL,
  45. AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII,
  46. AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,
  47. AS_DATA,AS_TEXT,AS_END,
  48. {------------------ Assembler Operators --------------------}
  49. AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR);
  50. tasmkeyword = string[10];
  51. const
  52. { These tokens should be modified accordingly to the modifications }
  53. { in the different enumerations. }
  54. firstdirective = AS_DB;
  55. lastdirective = AS_END;
  56. _count_asmprefixes = 5;
  57. _count_asmspecialops = 25;
  58. _count_asmoverrides = 3;
  59. token2str : array[tasmtoken] of tasmkeyword=(
  60. '','Label','LLabel','string','integer',
  61. 'float',',','(',
  62. ')',':','.','+','-','*',
  63. ';','identifier','register','opcode','/','$',
  64. '.byte','.word','.long','.quad','.globl',
  65. '.align','.balign','.p2align','.ascii',
  66. '.asciz','.lcomm','.comm','.single','.double','.tfloat',
  67. '.data','.text','END',
  68. '%','<<','>>','!','&','|','^','~');
  69. const
  70. newline = #10;
  71. firsttoken : boolean = TRUE;
  72. var
  73. _asmsorted : boolean;
  74. curlist : paasmoutput;
  75. c : char;
  76. actasmtoken : tasmtoken;
  77. prevasmtoken : tasmtoken;
  78. actasmpattern : string;
  79. actopcode : tasmop;
  80. actasmregister : tregister;
  81. actopsize : topsize;
  82. actcondition : tasmcond;
  83. iasmops : Pdictionary;
  84. iasmregs : ^reg2strtable;
  85. Procedure SetupTables;
  86. { creates uppercased symbol tables for speed access }
  87. var
  88. i : tasmop;
  89. j : tregister;
  90. str2opentry: pstr2opentry;
  91. Begin
  92. { opcodes }
  93. new(iasmops,init);
  94. for i:=firstop to lastop do
  95. begin
  96. new(str2opentry,initname(upper(att_op2str[i])));
  97. str2opentry^.op:=i;
  98. iasmops^.insert(str2opentry);
  99. end;
  100. { registers }
  101. new(iasmregs);
  102. for j:=firstreg to lastreg do
  103. iasmregs^[j] := upper(att_reg2str[j]);
  104. end;
  105. {---------------------------------------------------------------------}
  106. { Routines for the tokenizing }
  107. {---------------------------------------------------------------------}
  108. function is_asmopcode(const s: string):boolean;
  109. const
  110. { We need first to check the long prefixes, else we get probs
  111. with things like movsbl }
  112. att_sizesuffixstr : array[0..9] of string[2] = (
  113. '','BW','BL','WL','B','W','L','S','Q','T'
  114. );
  115. att_sizesuffix : array[0..9] of topsize = (
  116. S_NO,S_BW,S_BL,S_WL,S_B,S_W,S_L,S_FS,S_IQ,S_FX
  117. );
  118. att_sizefpusuffix : array[0..9] of topsize = (
  119. S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_FL,S_FS,S_IQ,S_FX
  120. );
  121. att_sizefpuintsuffix : array[0..9] of topsize = (
  122. S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO
  123. );
  124. var
  125. str2opentry: pstr2opentry;
  126. i : tasmop;
  127. cond : string[4];
  128. cnd : tasmcond;
  129. len,
  130. j,
  131. sufidx : longint;
  132. Begin
  133. is_asmopcode:=FALSE;
  134. actopcode:=A_None;
  135. actcondition:=C_None;
  136. actopsize:=S_NO;
  137. { search for all possible suffixes }
  138. for sufidx:=low(att_sizesuffixstr) to high(att_sizesuffixstr) do
  139. begin
  140. len:=length(s)-length(att_sizesuffixstr[sufidx]);
  141. if copy(s,len+1,length(att_sizesuffixstr[sufidx]))=att_sizesuffixstr[sufidx] then
  142. begin
  143. { here we search the entire table... }
  144. str2opentry:=nil;
  145. if {(length(s)>0) and} (len>0) then
  146. str2opentry:=pstr2opentry(iasmops^.search(copy(s,1,len)));
  147. if assigned(str2opentry) then
  148. begin
  149. actopcode:=str2opentry^.op;
  150. if att_needsuffix[actopcode]=attsufFPU then
  151. actopsize:=att_sizefpusuffix[sufidx]
  152. else if att_needsuffix[actopcode]=attsufFPUint then
  153. actopsize:=att_sizefpuintsuffix[sufidx]
  154. else
  155. actopsize:=att_sizesuffix[sufidx];
  156. actasmtoken:=AS_OPCODE;
  157. is_asmopcode:=TRUE;
  158. exit;
  159. end;
  160. { not found, check condition opcodes }
  161. j:=0;
  162. while (j<CondAsmOps) do
  163. begin
  164. if Copy(s,1,Length(CondAsmOpStr[j]))=CondAsmOpStr[j] then
  165. begin
  166. cond:=Copy(s,Length(CondAsmOpStr[j])+1,len-Length(CondAsmOpStr[j]));
  167. if cond<>'' then
  168. begin
  169. for cnd:=low(TasmCond) to high(TasmCond) do
  170. if Cond=Upper(cond2str[cnd]) then
  171. begin
  172. actopcode:=CondASmOp[j];
  173. if att_needsuffix[actopcode]=attsufFPU then
  174. actopsize:=att_sizefpusuffix[sufidx]
  175. else if att_needsuffix[actopcode]=attsufFPUint then
  176. actopsize:=att_sizefpuintsuffix[sufidx]
  177. else
  178. actopsize:=att_sizesuffix[sufidx];
  179. actcondition:=cnd;
  180. actasmtoken:=AS_OPCODE;
  181. is_asmopcode:=TRUE;
  182. exit;
  183. end;
  184. end;
  185. end;
  186. inc(j);
  187. end;
  188. end;
  189. end;
  190. end;
  191. Function is_asmdirective(const s: string):boolean;
  192. var
  193. i : tasmtoken;
  194. hs : string;
  195. Begin
  196. { GNU as is also not casesensitive with this }
  197. hs:=lower(s);
  198. for i:=firstdirective to lastdirective do
  199. if hs=token2str[i] then
  200. begin
  201. actasmtoken:=i;
  202. is_asmdirective:=true;
  203. exit;
  204. end;
  205. is_asmdirective:=false;
  206. end;
  207. Function is_register(const s: string):boolean;
  208. Var
  209. i : tregister;
  210. Begin
  211. actasmregister:=R_NO;
  212. for i:=firstreg to lastreg do
  213. if s=iasmregs^[i] then
  214. begin
  215. actasmtoken:=AS_REGISTER;
  216. actasmregister:=i;
  217. is_register:=true;
  218. exit;
  219. end;
  220. is_register:=false;
  221. end;
  222. Function is_locallabel(const s: string):boolean;
  223. begin
  224. is_locallabel:=(length(s)>=2) and (s[1]='.') and (s[2]='L');
  225. end;
  226. Procedure GetToken;
  227. var
  228. len : longint;
  229. begin
  230. { save old token and reset new token }
  231. prevasmtoken:=actasmtoken;
  232. actasmtoken:=AS_NONE;
  233. { reset }
  234. actasmpattern:='';
  235. { while space and tab , continue scan... }
  236. while c in [' ',#9] do
  237. c:=current_scanner^.asmgetchar;
  238. { get token pos }
  239. if not (c in [newline,#13,'{',';']) then
  240. current_scanner^.gettokenpos;
  241. { Local Label, Label, Directive, Prefix or Opcode }
  242. if firsttoken and not(c in [newline,#13,'{',';']) then
  243. begin
  244. firsttoken:=FALSE;
  245. len:=0;
  246. { directive or local label }
  247. if c = '.' then
  248. begin
  249. inc(len);
  250. actasmpattern[len]:=c;
  251. { Let us point to the next character }
  252. c:=current_scanner^.asmgetchar;
  253. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  254. begin
  255. inc(len);
  256. actasmpattern[len]:=c;
  257. c:=current_scanner^.asmgetchar;
  258. end;
  259. actasmpattern[0]:=chr(len);
  260. { this is a local label... }
  261. if (c=':') and is_locallabel(actasmpattern) then
  262. Begin
  263. { local variables are case sensitive }
  264. actasmtoken:=AS_LLABEL;
  265. c:=current_scanner^.asmgetchar;
  266. firsttoken:=true;
  267. exit;
  268. end
  269. { must be a directive }
  270. else
  271. Begin
  272. { directives are case sensitive!! }
  273. if is_asmdirective(actasmpattern) then
  274. exit;
  275. Message1(asmr_e_not_directive_or_local_symbol,actasmpattern);
  276. end;
  277. end;
  278. { only opcodes and global labels are allowed now. }
  279. while c in ['A'..'Z','a'..'z','0'..'9','_'] do
  280. begin
  281. inc(len);
  282. actasmpattern[len]:=c;
  283. c:=current_scanner^.asmgetchar;
  284. end;
  285. actasmpattern[0]:=chr(len);
  286. { Label ? }
  287. if c = ':' then
  288. begin
  289. actasmtoken:=AS_LABEL;
  290. { let us point to the next character }
  291. c:=current_scanner^.asmgetchar;
  292. firsttoken:=true;
  293. exit;
  294. end;
  295. { Opcode ? }
  296. If is_asmopcode(upper(actasmpattern)) then
  297. Begin
  298. uppervar(actasmpattern);
  299. exit;
  300. end;
  301. { End of assemblerblock ? }
  302. if upper(actasmpattern) = 'END' then
  303. begin
  304. actasmtoken:=AS_END;
  305. exit;
  306. end;
  307. message1(asmr_e_unknown_opcode,actasmpattern);
  308. actasmtoken:=AS_NONE;
  309. end
  310. else { else firsttoken }
  311. { Here we must handle all possible cases }
  312. begin
  313. case c of
  314. '.' : { possiblities : - local label reference , such as in jmp @local1 }
  315. { - field of object/record }
  316. { - directive. }
  317. begin
  318. if (prevasmtoken=AS_ID) then
  319. begin
  320. c:=current_scanner^.asmgetchar;
  321. actasmtoken:=AS_DOT;
  322. exit;
  323. end;
  324. actasmpattern:=c;
  325. c:=current_scanner^.asmgetchar;
  326. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  327. begin
  328. actasmpattern:=actasmpattern + c;
  329. c:=current_scanner^.asmgetchar;
  330. end;
  331. if is_asmdirective(actasmpattern) then
  332. exit;
  333. { local label references and directives }
  334. { are case sensitive }
  335. actasmtoken:=AS_ID;
  336. exit;
  337. end;
  338. { identifier, register, prefix or directive }
  339. '_','A'..'Z','a'..'z':
  340. begin
  341. len:=0;
  342. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  343. begin
  344. inc(len);
  345. actasmpattern[len]:=c;
  346. c:=current_scanner^.asmgetchar;
  347. end;
  348. actasmpattern[0]:=chr(len);
  349. uppervar(actasmpattern);
  350. { Opcode, can only be when the previous was a prefix }
  351. If is_prefix(actopcode) and is_asmopcode(upper(actasmpattern)) then
  352. Begin
  353. uppervar(actasmpattern);
  354. exit;
  355. end;
  356. { check for end which is a reserved word unlike the opcodes }
  357. if actasmpattern = 'END' then
  358. Begin
  359. actasmtoken:=AS_END;
  360. exit;
  361. end;
  362. actasmtoken:=AS_ID;
  363. exit;
  364. end;
  365. '%' : { register or modulo }
  366. begin
  367. len:=1;
  368. actasmpattern[len]:='%';
  369. c:=current_scanner^.asmgetchar;
  370. while c in ['a'..'z','A'..'Z','0'..'9'] do
  371. Begin
  372. inc(len);
  373. actasmpattern[len]:=c;
  374. c:=current_scanner^.asmgetchar;
  375. end;
  376. actasmpattern[0]:=chr(len);
  377. uppervar(actasmpattern);
  378. if (actasmpattern = '%ST') and (c='(') then
  379. Begin
  380. actasmpattern:=actasmpattern+c;
  381. c:=current_scanner^.asmgetchar;
  382. if c in ['0'..'9'] then
  383. actasmpattern:=actasmpattern + c
  384. else
  385. Message(asmr_e_invalid_fpu_register);
  386. c:=current_scanner^.asmgetchar;
  387. if c <> ')' then
  388. Message(asmr_e_invalid_fpu_register)
  389. else
  390. Begin
  391. actasmpattern:=actasmpattern + c;
  392. c:=current_scanner^.asmgetchar; { let us point to next character. }
  393. end;
  394. end;
  395. if is_register(actasmpattern) then
  396. exit;
  397. Message(asmr_w_modulo_not_supported);
  398. end;
  399. '1'..'9': { integer number }
  400. begin
  401. len:=0;
  402. while c in ['0'..'9'] do
  403. Begin
  404. inc(len);
  405. actasmpattern[len]:=c;
  406. c:=current_scanner^.asmgetchar;
  407. end;
  408. actasmpattern[0]:=chr(len);
  409. actasmpattern:=tostr(ValDecimal(actasmpattern));
  410. actasmtoken:=AS_INTNUM;
  411. exit;
  412. end;
  413. '0' : { octal,hexa,real or binary number. }
  414. begin
  415. actasmpattern:=c;
  416. c:=current_scanner^.asmgetchar;
  417. case upcase(c) of
  418. 'B': { binary }
  419. Begin
  420. c:=current_scanner^.asmgetchar;
  421. while c in ['0','1'] do
  422. Begin
  423. actasmpattern:=actasmpattern + c;
  424. c:=current_scanner^.asmgetchar;
  425. end;
  426. actasmpattern:=tostr(ValBinary(actasmpattern));
  427. actasmtoken:=AS_INTNUM;
  428. exit;
  429. end;
  430. 'D': { real }
  431. Begin
  432. c:=current_scanner^.asmgetchar;
  433. { get ridd of the 0d }
  434. if (c in ['+','-']) then
  435. begin
  436. actasmpattern:=c;
  437. c:=current_scanner^.asmgetchar;
  438. end
  439. else
  440. actasmpattern:='';
  441. while c in ['0'..'9'] do
  442. Begin
  443. actasmpattern:=actasmpattern + c;
  444. c:=current_scanner^.asmgetchar;
  445. end;
  446. if c='.' then
  447. begin
  448. actasmpattern:=actasmpattern + c;
  449. c:=current_scanner^.asmgetchar;
  450. while c in ['0'..'9'] do
  451. Begin
  452. actasmpattern:=actasmpattern + c;
  453. c:=current_scanner^.asmgetchar;
  454. end;
  455. if upcase(c) = 'E' then
  456. begin
  457. actasmpattern:=actasmpattern + c;
  458. c:=current_scanner^.asmgetchar;
  459. if (c in ['+','-']) then
  460. begin
  461. actasmpattern:=actasmpattern + c;
  462. c:=current_scanner^.asmgetchar;
  463. end;
  464. while c in ['0'..'9'] do
  465. Begin
  466. actasmpattern:=actasmpattern + c;
  467. c:=current_scanner^.asmgetchar;
  468. end;
  469. end;
  470. actasmtoken:=AS_REALNUM;
  471. exit;
  472. end
  473. else
  474. begin
  475. Message1(asmr_e_invalid_float_const,actasmpattern+c);
  476. actasmtoken:=AS_NONE;
  477. end;
  478. end;
  479. 'X': { hexadecimal }
  480. Begin
  481. c:=current_scanner^.asmgetchar;
  482. while c in ['0'..'9','a'..'f','A'..'F'] do
  483. Begin
  484. actasmpattern:=actasmpattern + c;
  485. c:=current_scanner^.asmgetchar;
  486. end;
  487. actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
  488. actasmtoken:=AS_INTNUM;
  489. exit;
  490. end;
  491. '1'..'7': { octal }
  492. begin
  493. actasmpattern:=actasmpattern + c;
  494. while c in ['0'..'7'] do
  495. Begin
  496. actasmpattern:=actasmpattern + c;
  497. c:=current_scanner^.asmgetchar;
  498. end;
  499. actasmpattern:=tostr(ValOctal(actasmpattern));
  500. actasmtoken:=AS_INTNUM;
  501. exit;
  502. end;
  503. else { octal number zero value...}
  504. Begin
  505. actasmpattern:=tostr(ValOctal(actasmpattern));
  506. actasmtoken:=AS_INTNUM;
  507. exit;
  508. end;
  509. end; { end case }
  510. end;
  511. '&' :
  512. begin
  513. c:=current_scanner^.asmgetchar;
  514. actasmtoken:=AS_AND;
  515. end;
  516. '''' : { char }
  517. begin
  518. actasmpattern:='';
  519. repeat
  520. c:=current_scanner^.asmgetchar;
  521. case c of
  522. '\' :
  523. begin
  524. { copy also the next char so \" is parsed correctly }
  525. c:=current_scanner^.asmgetchar;
  526. actasmpattern:=actasmpattern+c;
  527. end;
  528. '''' :
  529. begin
  530. c:=current_scanner^.asmgetchar;
  531. break;
  532. end;
  533. newline:
  534. Message(scan_f_string_exceeds_line);
  535. else
  536. actasmpattern:=actasmpattern+c;
  537. end;
  538. until false;
  539. actasmpattern:=EscapeToPascal(actasmpattern);
  540. actasmtoken:=AS_STRING;
  541. exit;
  542. end;
  543. '"' : { string }
  544. begin
  545. actasmpattern:='';
  546. repeat
  547. c:=current_scanner^.asmgetchar;
  548. case c of
  549. '\' :
  550. begin
  551. { copy also the next char so \" is parsed correctly }
  552. c:=current_scanner^.asmgetchar;
  553. actasmpattern:=actasmpattern+c;
  554. end;
  555. '"' :
  556. begin
  557. c:=current_scanner^.asmgetchar;
  558. break;
  559. end;
  560. newline:
  561. Message(scan_f_string_exceeds_line);
  562. else
  563. actasmpattern:=actasmpattern+c;
  564. end;
  565. until false;
  566. actasmpattern:=EscapeToPascal(actasmpattern);
  567. actasmtoken:=AS_STRING;
  568. exit;
  569. end;
  570. '$' :
  571. begin
  572. actasmtoken:=AS_DOLLAR;
  573. c:=current_scanner^.asmgetchar;
  574. exit;
  575. end;
  576. ',' :
  577. begin
  578. actasmtoken:=AS_COMMA;
  579. c:=current_scanner^.asmgetchar;
  580. exit;
  581. end;
  582. '<' :
  583. begin
  584. actasmtoken:=AS_SHL;
  585. c:=current_scanner^.asmgetchar;
  586. if c = '<' then
  587. c:=current_scanner^.asmgetchar;
  588. exit;
  589. end;
  590. '>' :
  591. begin
  592. actasmtoken:=AS_SHL;
  593. c:=current_scanner^.asmgetchar;
  594. if c = '>' then
  595. c:=current_scanner^.asmgetchar;
  596. exit;
  597. end;
  598. '|' :
  599. begin
  600. actasmtoken:=AS_OR;
  601. c:=current_scanner^.asmgetchar;
  602. exit;
  603. end;
  604. '^' :
  605. begin
  606. actasmtoken:=AS_XOR;
  607. c:=current_scanner^.asmgetchar;
  608. exit;
  609. end;
  610. '!' :
  611. begin
  612. Message(asmr_e_nor_not_supported);
  613. c:=current_scanner^.asmgetchar;
  614. actasmtoken:=AS_NONE;
  615. exit;
  616. end;
  617. '(' :
  618. begin
  619. actasmtoken:=AS_LPAREN;
  620. c:=current_scanner^.asmgetchar;
  621. exit;
  622. end;
  623. ')' :
  624. begin
  625. actasmtoken:=AS_RPAREN;
  626. c:=current_scanner^.asmgetchar;
  627. exit;
  628. end;
  629. ':' :
  630. begin
  631. actasmtoken:=AS_COLON;
  632. c:=current_scanner^.asmgetchar;
  633. exit;
  634. end;
  635. '+' :
  636. begin
  637. actasmtoken:=AS_PLUS;
  638. c:=current_scanner^.asmgetchar;
  639. exit;
  640. end;
  641. '-' :
  642. begin
  643. actasmtoken:=AS_MINUS;
  644. c:=current_scanner^.asmgetchar;
  645. exit;
  646. end;
  647. '*' :
  648. begin
  649. actasmtoken:=AS_STAR;
  650. c:=current_scanner^.asmgetchar;
  651. exit;
  652. end;
  653. '/' :
  654. begin
  655. c:=current_scanner^.asmgetchar;
  656. actasmtoken:=AS_SLASH;
  657. exit;
  658. end;
  659. '{',#13,newline,';' :
  660. begin
  661. { the comment is read by asmgetchar }
  662. c:=current_scanner^.asmgetchar;
  663. firsttoken:=TRUE;
  664. actasmtoken:=AS_SEPARATOR;
  665. exit;
  666. end;
  667. else
  668. Begin
  669. Message(scan_f_illegal_char);
  670. end;
  671. end;
  672. end;
  673. end;
  674. function consume(t : tasmtoken):boolean;
  675. begin
  676. Consume:=true;
  677. if t<>actasmtoken then
  678. begin
  679. Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
  680. Consume:=false;
  681. end;
  682. repeat
  683. gettoken;
  684. until actasmtoken<>AS_NONE;
  685. end;
  686. procedure RecoverConsume(allowcomma:boolean);
  687. begin
  688. While not (actasmtoken in [AS_SEPARATOR,AS_END]) do
  689. begin
  690. if allowcomma and (actasmtoken=AS_COMMA) then
  691. break;
  692. Consume(actasmtoken);
  693. end;
  694. end;
  695. {*****************************************************************************
  696. Parsing Helpers
  697. *****************************************************************************}
  698. Procedure BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
  699. { Description: This routine builds up a record offset after a AS_DOT }
  700. { token is encountered. }
  701. { On entry actasmtoken should be equal to AS_DOT }
  702. var
  703. s : string;
  704. Begin
  705. offset:=0;
  706. size:=0;
  707. s:=expr;
  708. while (actasmtoken=AS_DOT) do
  709. begin
  710. Consume(AS_DOT);
  711. if actasmtoken=AS_ID then
  712. s:=s+'.'+actasmpattern;
  713. if not Consume(AS_ID) then
  714. begin
  715. RecoverConsume(true);
  716. break;
  717. end;
  718. end;
  719. if not GetRecordOffsetSize(s,offset,size) then
  720. Message(asmr_e_building_record_offset);
  721. end;
  722. Procedure BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:longint;var asmsym:string);
  723. var
  724. hs,tempstr,expr : string;
  725. parenlevel,l,k : longint;
  726. errorflag : boolean;
  727. prevtok : tasmtoken;
  728. sym : psym;
  729. hl : PAsmLabel;
  730. Begin
  731. asmsym:='';
  732. value:=0;
  733. errorflag:=FALSE;
  734. tempstr:='';
  735. expr:='';
  736. parenlevel:=0;
  737. Repeat
  738. Case actasmtoken of
  739. AS_LPAREN:
  740. Begin
  741. { Exit if ref? }
  742. if allowref and (prevasmtoken in [AS_INTNUM,AS_ID]) then
  743. break;
  744. Consume(AS_LPAREN);
  745. expr:=expr + '(';
  746. inc(parenlevel);
  747. end;
  748. AS_RPAREN:
  749. Begin
  750. { end of ref ? }
  751. if (parenlevel=0) and betweenbracket then
  752. break;
  753. Consume(AS_RPAREN);
  754. expr:=expr + ')';
  755. dec(parenlevel);
  756. end;
  757. AS_SHL:
  758. Begin
  759. Consume(AS_SHL);
  760. expr:=expr + '<';
  761. end;
  762. AS_SHR:
  763. Begin
  764. Consume(AS_SHR);
  765. expr:=expr + '>';
  766. end;
  767. AS_SLASH:
  768. Begin
  769. Consume(AS_SLASH);
  770. expr:=expr + '/';
  771. end;
  772. AS_MOD:
  773. Begin
  774. Consume(AS_MOD);
  775. expr:=expr + '%';
  776. end;
  777. AS_STAR:
  778. Begin
  779. Consume(AS_STAR);
  780. expr:=expr + '*';
  781. end;
  782. AS_PLUS:
  783. Begin
  784. Consume(AS_PLUS);
  785. expr:=expr + '+';
  786. end;
  787. AS_MINUS:
  788. Begin
  789. Consume(AS_MINUS);
  790. expr:=expr + '-';
  791. end;
  792. AS_AND:
  793. Begin
  794. Consume(AS_AND);
  795. expr:=expr + '&';
  796. end;
  797. AS_NOT:
  798. Begin
  799. Consume(AS_NOT);
  800. expr:=expr + '~';
  801. end;
  802. AS_XOR:
  803. Begin
  804. Consume(AS_XOR);
  805. expr:=expr + '^';
  806. end;
  807. AS_OR:
  808. Begin
  809. Consume(AS_OR);
  810. expr:=expr + '|';
  811. end;
  812. AS_INTNUM:
  813. Begin
  814. expr:=expr + actasmpattern;
  815. Consume(AS_INTNUM);
  816. end;
  817. AS_DOLLAR:
  818. begin
  819. Consume(AS_DOLLAR);
  820. if actasmtoken<>AS_ID then
  821. Message(asmr_e_dollar_without_identifier);
  822. end;
  823. AS_STRING:
  824. Begin
  825. l:=0;
  826. case Length(actasmpattern) of
  827. 1 :
  828. l:=ord(actasmpattern[1]);
  829. 2 :
  830. l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
  831. 3 :
  832. l:=ord(actasmpattern[3]) +
  833. Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
  834. 4 :
  835. l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
  836. Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
  837. else
  838. Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
  839. end;
  840. str(l, tempstr);
  841. expr:=expr + tempstr;
  842. Consume(AS_STRING);
  843. end;
  844. AS_ID:
  845. Begin
  846. tempstr:=actasmpattern;
  847. prevtok:=prevasmtoken;
  848. consume(AS_ID);
  849. if actasmtoken=AS_DOT then
  850. begin
  851. BuildRecordOffsetSize(tempstr,l,k);
  852. str(l, tempstr);
  853. expr:=expr + tempstr;
  854. end
  855. else
  856. if SearchIConstant(tempstr,l) then
  857. begin
  858. str(l, tempstr);
  859. expr:=expr + tempstr;
  860. end
  861. else
  862. begin
  863. hs:='';
  864. if is_locallabel(tempstr) then
  865. begin
  866. CreateLocalLabel(tempstr,hl,false);
  867. hs:=hl^.name
  868. end
  869. else
  870. if SearchLabel(tempstr,hl,false) then
  871. hs:=hl^.name
  872. else
  873. begin
  874. getsym(tempstr,false);
  875. sym:=srsym;
  876. if assigned(sym) then
  877. begin
  878. case srsym^.typ of
  879. varsym :
  880. begin
  881. if sym^.owner^.symtabletype in [localsymtable,parasymtable] then
  882. Message(asmr_e_no_local_or_para_allowed);
  883. hs:=pvarsym(srsym)^.mangledname;
  884. end;
  885. typedconstsym :
  886. hs:=ptypedconstsym(srsym)^.mangledname;
  887. procsym :
  888. hs:=pprocsym(srsym)^.mangledname;
  889. else
  890. Message(asmr_e_wrong_sym_type);
  891. end;
  892. end
  893. else
  894. Message1(sym_e_unknown_id,tempstr);
  895. end;
  896. { symbol found? }
  897. if hs<>'' then
  898. begin
  899. if needofs and (prevtok<>AS_DOLLAR) then
  900. Message(asmr_e_need_offset);
  901. if asmsym='' then
  902. asmsym:=hs
  903. else
  904. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  905. if (expr='') or (expr[length(expr)]='+') then
  906. begin
  907. delete(expr,length(expr),1);
  908. if not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END]) then
  909. Message(asmr_e_only_add_relocatable_symbol);
  910. end
  911. else
  912. Message(asmr_e_only_add_relocatable_symbol);
  913. end
  914. else
  915. begin
  916. { Error recovery }
  917. if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
  918. delete(expr,length(expr),1);
  919. end;
  920. end;
  921. end;
  922. AS_END,
  923. AS_SEPARATOR,
  924. AS_COMMA:
  925. Begin
  926. break;
  927. end;
  928. else
  929. Begin
  930. { write error only once. }
  931. if not errorflag then
  932. Message(asmr_e_invalid_constant_expression);
  933. { consume tokens until we find COMMA or SEPARATOR }
  934. Consume(actasmtoken);
  935. errorflag:=TRUE;
  936. end;
  937. end;
  938. Until false;
  939. { calculate expression }
  940. if not ErrorFlag then
  941. value:=CalculateExpression(expr)
  942. else
  943. value:=0;
  944. end;
  945. Function BuildConstExpression(allowref,betweenbracket:boolean): longint;
  946. var
  947. l : longint;
  948. hs : string;
  949. begin
  950. BuildConstSymbolExpression(allowref,betweenbracket,false,l,hs);
  951. if hs<>'' then
  952. Message(asmr_e_relocatable_symbol_not_allowed);
  953. BuildConstExpression:=l;
  954. end;
  955. {****************************************************************************
  956. T386ATTOperand
  957. ****************************************************************************}
  958. type
  959. P386ATTOperand=^T386ATTOperand;
  960. T386ATTOperand=object(T386Operand)
  961. Procedure BuildOperand;virtual;
  962. private
  963. Procedure BuildReference;
  964. Procedure BuildConstant;
  965. end;
  966. Procedure T386ATTOperand.BuildReference;
  967. procedure Consume_RParen;
  968. begin
  969. if actasmtoken <> AS_RPAREN then
  970. Begin
  971. Message(asmr_e_invalid_reference_syntax);
  972. RecoverConsume(true);
  973. end
  974. else
  975. begin
  976. Consume(AS_RPAREN);
  977. if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
  978. Begin
  979. Message(asmr_e_invalid_reference_syntax);
  980. RecoverConsume(true);
  981. end;
  982. end;
  983. end;
  984. procedure Consume_Scale;
  985. var
  986. l : longint;
  987. begin
  988. { we have to process the scaling }
  989. l:=BuildConstExpression(false,true);
  990. if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) then
  991. opr.ref.scalefactor:=l
  992. else
  993. Begin
  994. Message(asmr_e_wrong_scale_factor);
  995. opr.ref.scalefactor:=0;
  996. end;
  997. end;
  998. Begin
  999. Consume(AS_LPAREN);
  1000. Case actasmtoken of
  1001. AS_INTNUM,
  1002. AS_MINUS,
  1003. AS_PLUS: { absolute offset, such as fs:(0x046c) }
  1004. Begin
  1005. { offset(offset) is invalid }
  1006. If opr.Ref.Offset <> 0 Then
  1007. Begin
  1008. Message(asmr_e_invalid_reference_syntax);
  1009. RecoverConsume(true);
  1010. End
  1011. Else
  1012. Begin
  1013. opr.Ref.Offset:=BuildConstExpression(false,true);
  1014. Consume_RParen;
  1015. end;
  1016. exit;
  1017. End;
  1018. AS_REGISTER: { (reg ... }
  1019. Begin
  1020. { Check if there is already a base (mostly ebp,esp) than this is
  1021. not allowed,becuase it will give crashing code }
  1022. if opr.ref.base<>R_NO then
  1023. Message(asmr_e_cannot_index_relative_var);
  1024. opr.ref.base:=actasmregister;
  1025. Consume(AS_REGISTER);
  1026. { can either be a register or a right parenthesis }
  1027. { (reg) }
  1028. if actasmtoken=AS_RPAREN then
  1029. Begin
  1030. Consume_RParen;
  1031. exit;
  1032. end;
  1033. { (reg,reg .. }
  1034. Consume(AS_COMMA);
  1035. if actasmtoken=AS_REGISTER then
  1036. Begin
  1037. opr.ref.index:=actasmregister;
  1038. Consume(AS_REGISTER);
  1039. { check for scaling ... }
  1040. case actasmtoken of
  1041. AS_RPAREN:
  1042. Begin
  1043. Consume_RParen;
  1044. exit;
  1045. end;
  1046. AS_COMMA:
  1047. Begin
  1048. Consume(AS_COMMA);
  1049. Consume_Scale;
  1050. Consume_RParen;
  1051. end;
  1052. else
  1053. Begin
  1054. Message(asmr_e_invalid_reference_syntax);
  1055. RecoverConsume(false);
  1056. end;
  1057. end; { end case }
  1058. end
  1059. else
  1060. Begin
  1061. Message(asmr_e_invalid_reference_syntax);
  1062. RecoverConsume(false);
  1063. end;
  1064. end; {end case }
  1065. AS_COMMA: { (, ... can either be scaling, or index }
  1066. Begin
  1067. Consume(AS_COMMA);
  1068. { Index }
  1069. if (actasmtoken=AS_REGISTER) then
  1070. Begin
  1071. opr.ref.index:=actasmregister;
  1072. Consume(AS_REGISTER);
  1073. { check for scaling ... }
  1074. case actasmtoken of
  1075. AS_RPAREN:
  1076. Begin
  1077. Consume_RParen;
  1078. exit;
  1079. end;
  1080. AS_COMMA:
  1081. Begin
  1082. Consume(AS_COMMA);
  1083. Consume_Scale;
  1084. Consume_RParen;
  1085. end;
  1086. else
  1087. Begin
  1088. Message(asmr_e_invalid_reference_syntax);
  1089. RecoverConsume(false);
  1090. end;
  1091. end; {end case }
  1092. end
  1093. { Scaling }
  1094. else
  1095. Begin
  1096. Consume_Scale;
  1097. Consume_RParen;
  1098. exit;
  1099. end;
  1100. end;
  1101. else
  1102. Begin
  1103. Message(asmr_e_invalid_reference_syntax);
  1104. RecoverConsume(false);
  1105. end;
  1106. end;
  1107. end;
  1108. Procedure T386ATTOperand.BuildConstant;
  1109. var
  1110. l : longint;
  1111. tempstr : string;
  1112. begin
  1113. BuildConstSymbolExpression(false,false,true,l,tempstr);
  1114. if tempstr<>'' then
  1115. begin
  1116. opr.typ:=OPR_SYMBOL;
  1117. opr.symofs:=l;
  1118. opr.symbol:=newasmsymbol(tempstr);
  1119. end
  1120. else
  1121. begin
  1122. opr.typ:=OPR_CONSTANT;
  1123. opr.val:=l;
  1124. end;
  1125. end;
  1126. Procedure T386ATTOperand.BuildOperand;
  1127. var
  1128. expr : string;
  1129. procedure AddLabelOperand(hl:pasmlabel);
  1130. begin
  1131. if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
  1132. is_calljmp(actopcode) then
  1133. begin
  1134. opr.typ:=OPR_SYMBOL;
  1135. opr.symbol:=hl;
  1136. end
  1137. else
  1138. begin
  1139. InitRef;
  1140. opr.ref.symbol:=hl;
  1141. end;
  1142. end;
  1143. procedure MaybeRecordOffset;
  1144. var
  1145. hasdot : boolean;
  1146. l,
  1147. toffset,
  1148. tsize : longint;
  1149. begin
  1150. if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
  1151. exit;
  1152. l:=0;
  1153. hasdot:=(actasmtoken=AS_DOT);
  1154. if hasdot then
  1155. begin
  1156. if expr<>'' then
  1157. begin
  1158. BuildRecordOffsetSize(expr,toffset,tsize);
  1159. inc(l,toffset);
  1160. SetSize(tsize,true);
  1161. end;
  1162. end;
  1163. if actasmtoken in [AS_PLUS,AS_MINUS] then
  1164. inc(l,BuildConstExpression(true,false));
  1165. if opr.typ=OPR_REFERENCE then
  1166. begin
  1167. if hasdot and (opr.ref.options=ref_parafixup) then
  1168. Message(asmr_e_cannot_access_field_directly_for_parameters);
  1169. inc(opr.ref.offset,l)
  1170. end
  1171. else
  1172. inc(opr.val,l);
  1173. end;
  1174. function MaybeBuildReference:boolean;
  1175. { Try to create a reference, if not a reference is found then false
  1176. is returned }
  1177. begin
  1178. MaybeBuildReference:=true;
  1179. case actasmtoken of
  1180. AS_INTNUM,
  1181. AS_MINUS,
  1182. AS_PLUS:
  1183. Begin
  1184. opr.ref.offset:=BuildConstExpression(True,False);
  1185. if actasmtoken<>AS_LPAREN then
  1186. Message(asmr_e_invalid_reference_syntax)
  1187. else
  1188. BuildReference;
  1189. end;
  1190. AS_LPAREN:
  1191. BuildReference;
  1192. AS_ID: { only a variable is allowed ... }
  1193. Begin
  1194. if not SetupVar(actasmpattern,false) then
  1195. Message(asmr_e_invalid_reference_syntax);
  1196. Consume(AS_ID);
  1197. case actasmtoken of
  1198. AS_END,
  1199. AS_SEPARATOR,
  1200. AS_COMMA: ;
  1201. AS_LPAREN: BuildReference;
  1202. else
  1203. Begin
  1204. Message(asmr_e_invalid_reference_syntax);
  1205. Consume(actasmtoken);
  1206. end;
  1207. end; {end case }
  1208. end;
  1209. else
  1210. MaybeBuildReference:=false;
  1211. end; { end case }
  1212. end;
  1213. var
  1214. tempreg : tregister;
  1215. hl : PAsmLabel;
  1216. l : longint;
  1217. Begin
  1218. expr:='';
  1219. case actasmtoken of
  1220. AS_LPAREN: { Memory reference or constant expression }
  1221. Begin
  1222. InitRef;
  1223. BuildReference;
  1224. end;
  1225. AS_DOLLAR: { Constant expression }
  1226. Begin
  1227. Consume(AS_DOLLAR);
  1228. BuildConstant;
  1229. end;
  1230. AS_INTNUM,
  1231. AS_MINUS,
  1232. AS_PLUS:
  1233. Begin
  1234. { Constant memory offset }
  1235. { This must absolutely be followed by ( }
  1236. InitRef;
  1237. opr.ref.offset:=BuildConstExpression(True,False);
  1238. if actasmtoken<>AS_LPAREN then
  1239. Message(asmr_e_invalid_reference_syntax)
  1240. else
  1241. BuildReference;
  1242. end;
  1243. AS_STAR: { Call from memory address }
  1244. Begin
  1245. Consume(AS_STAR);
  1246. if actasmtoken=AS_REGISTER then
  1247. begin
  1248. opr.typ:=OPR_REGISTER;
  1249. opr.reg:=actasmregister;
  1250. size:=reg_2_opsize[actasmregister];
  1251. Consume(AS_REGISTER);
  1252. end
  1253. else
  1254. begin
  1255. InitRef;
  1256. if not MaybeBuildReference then
  1257. Message(asmr_e_syn_operand);
  1258. end;
  1259. { this is only allowed for call's and jmp's }
  1260. if not is_calljmp(actopcode) then
  1261. Message(asmr_e_syn_operand);
  1262. end;
  1263. AS_ID: { A constant expression, or a Variable ref. }
  1264. Begin
  1265. { Local Label ? }
  1266. if is_locallabel(actasmpattern) then
  1267. begin
  1268. CreateLocalLabel(actasmpattern,hl,false);
  1269. Consume(AS_ID);
  1270. AddLabelOperand(hl);
  1271. end
  1272. else
  1273. { Check for label }
  1274. if SearchLabel(actasmpattern,hl,false) then
  1275. begin
  1276. Consume(AS_ID);
  1277. AddLabelOperand(hl);
  1278. end
  1279. else
  1280. { probably a variable or normal expression }
  1281. { or a procedure (such as in CALL ID) }
  1282. Begin
  1283. { is it a constant ? }
  1284. if SearchIConstant(actasmpattern,l) then
  1285. Begin
  1286. if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1287. Message(asmr_e_invalid_operand_type);
  1288. BuildConstant;
  1289. end
  1290. else
  1291. begin
  1292. InitRef;
  1293. if SetupVar(actasmpattern,false) then
  1294. begin
  1295. expr:=actasmpattern;
  1296. Consume(AS_ID);
  1297. MaybeRecordOffset;
  1298. { add a constant expression? }
  1299. if (actasmtoken=AS_PLUS) then
  1300. begin
  1301. l:=BuildConstExpression(true,false);
  1302. if opr.typ=OPR_CONSTANT then
  1303. inc(opr.val,l)
  1304. else
  1305. inc(opr.ref.offset,l);
  1306. end
  1307. end
  1308. else
  1309. Begin
  1310. { look for special symbols ... }
  1311. if actasmpattern = '__RESULT' then
  1312. SetUpResult
  1313. else
  1314. if actasmpattern = '__SELF' then
  1315. SetupSelf
  1316. else
  1317. if actasmpattern = '__OLDEBP' then
  1318. SetupOldEBP
  1319. else
  1320. { check for direct symbolic names }
  1321. { only if compiling the system unit }
  1322. if (cs_compilesystem in aktmoduleswitches) then
  1323. begin
  1324. if not SetupDirectVar(actasmpattern) then
  1325. Begin
  1326. { not found, finally ... add it anyways ... }
  1327. Message1(asmr_w_id_supposed_external,actasmpattern);
  1328. opr.ref.symbol:=newasmsymbol(actasmpattern);
  1329. end;
  1330. end
  1331. else
  1332. Message1(sym_e_unknown_id,actasmpattern);
  1333. Consume(AS_ID);
  1334. end;
  1335. end;
  1336. end;
  1337. { Do we have a indexing reference, then parse it also }
  1338. if actasmtoken=AS_LPAREN then
  1339. begin
  1340. if (opr.typ=OPR_CONSTANT) then
  1341. begin
  1342. l:=opr.val;
  1343. opr.typ:=OPR_REFERENCE;
  1344. reset_reference(opr.Ref);
  1345. opr.Ref.Offset:=l;
  1346. end;
  1347. BuildReference;
  1348. end;
  1349. end;
  1350. AS_REGISTER: { Register, a variable reference or a constant reference }
  1351. Begin
  1352. { save the type of register used. }
  1353. tempreg:=actasmregister;
  1354. Consume(AS_REGISTER);
  1355. if actasmtoken = AS_COLON then
  1356. Begin
  1357. Consume(AS_COLON);
  1358. InitRef;
  1359. opr.ref.segment:=tempreg;
  1360. { This must absolutely be followed by a reference }
  1361. if not MaybeBuildReference then
  1362. Begin
  1363. Message(asmr_e_invalid_seg_override);
  1364. Consume(actasmtoken);
  1365. end;
  1366. end
  1367. { Simple register }
  1368. else if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
  1369. Begin
  1370. if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then
  1371. Message(asmr_e_invalid_operand_type);
  1372. opr.typ:=OPR_REGISTER;
  1373. opr.reg:=tempreg;
  1374. size:=reg_2_opsize[tempreg];
  1375. end
  1376. else
  1377. Message(asmr_e_syn_operand);
  1378. end;
  1379. AS_END,
  1380. AS_SEPARATOR,
  1381. AS_COMMA: ;
  1382. else
  1383. Begin
  1384. Message(asmr_e_syn_operand);
  1385. Consume(actasmtoken);
  1386. end;
  1387. end; { end case }
  1388. end;
  1389. {*****************************************************************************
  1390. T386ATTInstruction
  1391. *****************************************************************************}
  1392. type
  1393. P386AttInstruction=^T386AttInstruction;
  1394. T386AttInstruction=object(T386Instruction)
  1395. procedure InitOperands;virtual;
  1396. procedure BuildOpcode;virtual;
  1397. end;
  1398. procedure T386AttInstruction.InitOperands;
  1399. var
  1400. i : longint;
  1401. begin
  1402. for i:=1to 3 do
  1403. Operands[i]:=new(P386AttOperand,Init);
  1404. end;
  1405. Procedure T386AttInstruction.BuildOpCode;
  1406. var
  1407. operandnum : longint;
  1408. PrefixOp,OverrideOp: tasmop;
  1409. Begin
  1410. PrefixOp:=A_None;
  1411. OverrideOp:=A_None;
  1412. { prefix seg opcode / prefix opcode }
  1413. repeat
  1414. if is_prefix(actopcode) then
  1415. begin
  1416. PrefixOp:=ActOpcode;
  1417. opcode:=ActOpcode;
  1418. condition:=ActCondition;
  1419. opsize:=ActOpsize;
  1420. ConcatInstruction(curlist);
  1421. Consume(AS_OPCODE);
  1422. end
  1423. else
  1424. if is_override(actopcode) then
  1425. begin
  1426. OverrideOp:=ActOpcode;
  1427. opcode:=ActOpcode;
  1428. condition:=ActCondition;
  1429. opsize:=ActOpsize;
  1430. ConcatInstruction(curlist);
  1431. Consume(AS_OPCODE);
  1432. end
  1433. else
  1434. break;
  1435. { allow for newline as in gas styled syntax }
  1436. while actasmtoken=AS_SEPARATOR do
  1437. Consume(AS_SEPARATOR);
  1438. until (actasmtoken<>AS_OPCODE);
  1439. { opcode }
  1440. if (actasmtoken <> AS_OPCODE) then
  1441. Begin
  1442. Message(asmr_e_invalid_or_missing_opcode);
  1443. RecoverConsume(true);
  1444. exit;
  1445. end;
  1446. { Fill the instr object with the current state }
  1447. Opcode:=ActOpcode;
  1448. condition:=ActCondition;
  1449. opsize:=ActOpsize;
  1450. { Valid combination of prefix/override and instruction ? }
  1451. if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then
  1452. Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern);
  1453. if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then
  1454. Message1(asmr_e_invalid_override_and_opcode,actasmpattern);
  1455. { We are reading operands, so opcode will be an AS_ID }
  1456. operandnum:=1;
  1457. Consume(AS_OPCODE);
  1458. { Zero operand opcode ? }
  1459. if actasmtoken in [AS_SEPARATOR,AS_END] then
  1460. begin
  1461. operandnum:=0;
  1462. exit;
  1463. end;
  1464. { Read the operands }
  1465. repeat
  1466. case actasmtoken of
  1467. AS_COMMA: { Operand delimiter }
  1468. Begin
  1469. if operandnum > MaxOperands then
  1470. Message(asmr_e_too_many_operands)
  1471. else
  1472. Inc(operandnum);
  1473. Consume(AS_COMMA);
  1474. end;
  1475. AS_SEPARATOR,
  1476. AS_END : { End of asm operands for this opcode }
  1477. begin
  1478. break;
  1479. end;
  1480. else
  1481. Operands[operandnum]^.BuildOperand;
  1482. end; { end case }
  1483. until false;
  1484. Ops:=operandnum;
  1485. end;
  1486. Procedure BuildConstant(maxvalue: longint);
  1487. var
  1488. asmsym,
  1489. expr: string;
  1490. value : longint;
  1491. Begin
  1492. Repeat
  1493. Case actasmtoken of
  1494. AS_STRING:
  1495. Begin
  1496. expr:=actasmpattern;
  1497. if length(expr) > 1 then
  1498. Message(asmr_e_string_not_allowed_as_const);
  1499. Consume(AS_STRING);
  1500. Case actasmtoken of
  1501. AS_COMMA: Consume(AS_COMMA);
  1502. AS_END,
  1503. AS_SEPARATOR: ;
  1504. else
  1505. Message(asmr_e_invalid_string_expression);
  1506. end; { end case }
  1507. ConcatString(curlist,expr);
  1508. end;
  1509. AS_INTNUM,
  1510. AS_PLUS,
  1511. AS_MINUS,
  1512. AS_LPAREN,
  1513. AS_NOT,
  1514. AS_ID :
  1515. Begin
  1516. BuildConstSymbolExpression(false,false,false,value,asmsym);
  1517. if asmsym<>'' then
  1518. begin
  1519. if maxvalue<>longint($ffffffff) then
  1520. Message(asmr_w_32bit_const_for_address);
  1521. ConcatConstSymbol(curlist,asmsym,value)
  1522. end
  1523. else
  1524. ConcatConstant(curlist,value,maxvalue);
  1525. end;
  1526. AS_COMMA:
  1527. Consume(AS_COMMA);
  1528. AS_END,
  1529. AS_SEPARATOR:
  1530. break;
  1531. else
  1532. begin
  1533. Message(asmr_e_syn_constant);
  1534. RecoverConsume(false);
  1535. end
  1536. end; { end case }
  1537. Until false;
  1538. end;
  1539. Procedure BuildRealConstant(typ : tfloattype);
  1540. var
  1541. expr : string;
  1542. r : bestreal;
  1543. code : integer;
  1544. negativ : boolean;
  1545. errorflag: boolean;
  1546. Begin
  1547. errorflag:=FALSE;
  1548. Repeat
  1549. negativ:=false;
  1550. expr:='';
  1551. if actasmtoken=AS_PLUS then
  1552. Consume(AS_PLUS)
  1553. else
  1554. if actasmtoken=AS_MINUS then
  1555. begin
  1556. negativ:=true;
  1557. consume(AS_MINUS);
  1558. end;
  1559. Case actasmtoken of
  1560. AS_INTNUM:
  1561. Begin
  1562. expr:=actasmpattern;
  1563. Consume(AS_INTNUM);
  1564. if negativ then
  1565. expr:='-'+expr;
  1566. val(expr,r,code);
  1567. if code<>0 then
  1568. Begin
  1569. r:=0;
  1570. Message(asmr_e_invalid_float_expr);
  1571. End;
  1572. ConcatRealConstant(curlist,r,typ);
  1573. end;
  1574. AS_REALNUM:
  1575. Begin
  1576. expr:=actasmpattern;
  1577. Consume(AS_REALNUM);
  1578. { in ATT syntax you have 0d in front of the real }
  1579. { should this be forced ? yes i think so, as to }
  1580. { conform to gas as much as possible. }
  1581. if (expr[1]='0') and (upper(expr[2])='D') then
  1582. Delete(expr,1,2);
  1583. if negativ then
  1584. expr:='-'+expr;
  1585. val(expr,r,code);
  1586. if code<>0 then
  1587. Begin
  1588. r:=0;
  1589. Message(asmr_e_invalid_float_expr);
  1590. End;
  1591. ConcatRealConstant(curlist,r,typ);
  1592. end;
  1593. AS_COMMA:
  1594. begin
  1595. Consume(AS_COMMA);
  1596. end;
  1597. AS_END,
  1598. AS_SEPARATOR:
  1599. begin
  1600. break;
  1601. end;
  1602. else
  1603. Begin
  1604. Consume(actasmtoken);
  1605. if not errorflag then
  1606. Message(asmr_e_invalid_float_expr);
  1607. errorflag:=TRUE;
  1608. end;
  1609. end;
  1610. Until false;
  1611. end;
  1612. Procedure BuildStringConstant(asciiz: boolean);
  1613. var
  1614. expr: string;
  1615. errorflag : boolean;
  1616. Begin
  1617. errorflag:=FALSE;
  1618. Repeat
  1619. Case actasmtoken of
  1620. AS_STRING:
  1621. Begin
  1622. expr:=actasmpattern;
  1623. if asciiz then
  1624. expr:=expr+#0;
  1625. ConcatPasString(curlist,expr);
  1626. Consume(AS_STRING);
  1627. end;
  1628. AS_COMMA:
  1629. begin
  1630. Consume(AS_COMMA);
  1631. end;
  1632. AS_END,
  1633. AS_SEPARATOR:
  1634. begin
  1635. break;
  1636. end;
  1637. else
  1638. Begin
  1639. Consume(actasmtoken);
  1640. if not errorflag then
  1641. Message(asmr_e_invalid_string_expression);
  1642. errorflag:=TRUE;
  1643. end;
  1644. end;
  1645. Until false;
  1646. end;
  1647. Function Assemble: Ptree;
  1648. Var
  1649. hl : PAsmLabel;
  1650. commname : string;
  1651. lastsec : tsection;
  1652. l1,l2 : longint;
  1653. instr : T386ATTInstruction;
  1654. Begin
  1655. Message1(asmr_d_start_reading,'AT&T');
  1656. firsttoken:=TRUE;
  1657. if assigned(procinfo^.returntype.def) and
  1658. (is_fpu(procinfo^.returntype.def) or
  1659. ret_in_acc(procinfo^.returntype.def)) then
  1660. procinfo^.funcret_state:=vs_assigned;
  1661. { sets up all opcode and register tables in uppercase }
  1662. if not _asmsorted then
  1663. Begin
  1664. SetupTables;
  1665. _asmsorted:=TRUE;
  1666. end;
  1667. curlist:=new(paasmoutput,init);
  1668. lastsec:=sec_code;
  1669. { setup label linked list }
  1670. new(LocalLabelList,Init);
  1671. { start tokenizer }
  1672. c:=current_scanner^.asmgetchar;
  1673. gettoken;
  1674. { main loop }
  1675. repeat
  1676. case actasmtoken of
  1677. AS_LLABEL:
  1678. Begin
  1679. if CreateLocalLabel(actasmpattern,hl,true) then
  1680. ConcatLabel(curlist,hl);
  1681. Consume(AS_LLABEL);
  1682. end;
  1683. AS_LABEL:
  1684. Begin
  1685. if SearchLabel(upper(actasmpattern),hl,true) then
  1686. ConcatLabel(curlist,hl)
  1687. else
  1688. Message1(asmr_e_unknown_label_identifier,actasmpattern);
  1689. Consume(AS_LABEL);
  1690. end;
  1691. AS_DW:
  1692. Begin
  1693. Consume(AS_DW);
  1694. BuildConstant($ffff);
  1695. end;
  1696. AS_DATA:
  1697. Begin
  1698. curlist^.Concat(new(pai_section,init(sec_data)));
  1699. lastsec:=sec_data;
  1700. Consume(AS_DATA);
  1701. end;
  1702. AS_TEXT:
  1703. Begin
  1704. curlist^.Concat(new(pai_section,init(sec_code)));
  1705. lastsec:=sec_code;
  1706. Consume(AS_TEXT);
  1707. end;
  1708. AS_DB:
  1709. Begin
  1710. Consume(AS_DB);
  1711. BuildConstant($ff);
  1712. end;
  1713. AS_DD:
  1714. Begin
  1715. Consume(AS_DD);
  1716. BuildConstant($ffffffff);
  1717. end;
  1718. AS_DQ:
  1719. Begin
  1720. Consume(AS_DQ);
  1721. BuildRealConstant(s64comp);
  1722. end;
  1723. AS_SINGLE:
  1724. Begin
  1725. Consume(AS_SINGLE);
  1726. BuildRealConstant(s32real);
  1727. end;
  1728. AS_DOUBLE:
  1729. Begin
  1730. Consume(AS_DOUBLE);
  1731. BuildRealConstant(s64real);
  1732. end;
  1733. AS_EXTENDED:
  1734. Begin
  1735. Consume(AS_EXTENDED);
  1736. BuildRealConstant(s80real);
  1737. end;
  1738. AS_GLOBAL:
  1739. Begin
  1740. Consume(AS_GLOBAL);
  1741. if actasmtoken=AS_ID then
  1742. ConcatPublic(curlist,actasmpattern);
  1743. Consume(AS_ID);
  1744. if actasmtoken<>AS_SEPARATOR then
  1745. Consume(AS_SEPARATOR);
  1746. end;
  1747. AS_ALIGN:
  1748. Begin
  1749. Consume(AS_ALIGN);
  1750. l1:=BuildConstExpression(false,false);
  1751. if (target_info.target in [target_i386_GO32V1,target_i386_GO32V2]) then
  1752. begin
  1753. l2:=1;
  1754. if (l1>=0) and (l1<=16) then
  1755. while (l1>0) do
  1756. begin
  1757. l2:=2*l2;
  1758. dec(l1);
  1759. end;
  1760. l1:=l2;
  1761. end;
  1762. ConcatAlign(curlist,l1);
  1763. Message(asmr_n_align_is_target_specific);
  1764. if actasmtoken<>AS_SEPARATOR then
  1765. Consume(AS_SEPARATOR);
  1766. end;
  1767. AS_BALIGN:
  1768. Begin
  1769. Consume(AS_BALIGN);
  1770. ConcatAlign(curlist,BuildConstExpression(false,false));
  1771. if actasmtoken<>AS_SEPARATOR then
  1772. Consume(AS_SEPARATOR);
  1773. end;
  1774. AS_P2ALIGN:
  1775. Begin
  1776. Consume(AS_P2ALIGN);
  1777. l1:=BuildConstExpression(false,false);
  1778. l2:=1;
  1779. if (l1>=0) and (l1<=16) then
  1780. while (l1>0) do
  1781. begin
  1782. l2:=2*l2;
  1783. dec(l1);
  1784. end;
  1785. l1:=l2;
  1786. ConcatAlign(curlist,l1);
  1787. if actasmtoken<>AS_SEPARATOR then
  1788. Consume(AS_SEPARATOR);
  1789. end;
  1790. AS_ASCIIZ:
  1791. Begin
  1792. Consume(AS_ASCIIZ);
  1793. BuildStringConstant(TRUE);
  1794. end;
  1795. AS_ASCII:
  1796. Begin
  1797. Consume(AS_ASCII);
  1798. BuildStringConstant(FALSE);
  1799. end;
  1800. AS_LCOMM:
  1801. Begin
  1802. Consume(AS_LCOMM);
  1803. commname:=actasmpattern;
  1804. Consume(AS_ID);
  1805. Consume(AS_COMMA);
  1806. ConcatLocalBss(commname,BuildConstExpression(false,false));
  1807. if actasmtoken<>AS_SEPARATOR then
  1808. Consume(AS_SEPARATOR);
  1809. end;
  1810. AS_COMM:
  1811. Begin
  1812. Consume(AS_COMM);
  1813. commname:=actasmpattern;
  1814. Consume(AS_ID);
  1815. Consume(AS_COMMA);
  1816. ConcatGlobalBss(commname,BuildConstExpression(false,false));
  1817. if actasmtoken<>AS_SEPARATOR then
  1818. Consume(AS_SEPARATOR);
  1819. end;
  1820. AS_OPCODE:
  1821. Begin
  1822. instr.init;
  1823. instr.BuildOpcode;
  1824. instr.AddReferenceSizes;
  1825. instr.SetInstructionOpsize;
  1826. instr.CheckOperandSizes;
  1827. instr.ConcatInstruction(curlist);
  1828. instr.done;
  1829. end;
  1830. AS_SEPARATOR:
  1831. Begin
  1832. Consume(AS_SEPARATOR);
  1833. end;
  1834. AS_END:
  1835. begin
  1836. break; { end assembly block }
  1837. end;
  1838. else
  1839. Begin
  1840. Message(asmr_e_syntax_error);
  1841. RecoverConsume(false);
  1842. end;
  1843. end;
  1844. until false;
  1845. { Check LocalLabelList }
  1846. LocalLabelList^.CheckEmitted;
  1847. dispose(LocalLabelList,Done);
  1848. { are we back in the code section? }
  1849. if lastsec<>sec_code then
  1850. begin
  1851. Message(asmr_w_assembler_code_not_returned_to_text);
  1852. curlist^.Concat(new(pai_section,init(sec_code)));
  1853. end;
  1854. { Return the list in an asmnode }
  1855. assemble:=genasmnode(curlist);
  1856. Message1(asmr_d_finish_reading,'AT&T');
  1857. end;
  1858. {*****************************************************************************
  1859. Initialize
  1860. *****************************************************************************}
  1861. var
  1862. old_exit : pointer;
  1863. procedure ra386att_exit;{$ifndef FPC}far;{$endif}
  1864. begin
  1865. if assigned(iasmops) then
  1866. dispose(iasmops,done);
  1867. if assigned(iasmregs) then
  1868. dispose(iasmregs);
  1869. exitproc:=old_exit;
  1870. end;
  1871. begin
  1872. old_exit:=exitproc;
  1873. exitproc:=@ra386att_exit;
  1874. end.
  1875. {
  1876. $Log$
  1877. Revision 1.78 2000-05-12 21:57:02 pierre
  1878. + use of a dictionary object
  1879. for faster opcode searching in assembler readers
  1880. implemented by Kovacs Attila Zoltan
  1881. Revision 1.77 2000/05/11 09:56:21 pierre
  1882. * fixed several compare problems between longints and
  1883. const > $80000000 that are treated as int64 constanst
  1884. by Delphi reported by Kovacs Attila Zoltan
  1885. Revision 1.76 2000/05/09 11:56:25 pierre
  1886. * Issue an error if opcode is not found
  1887. Revision 1.75 2000/05/08 13:23:03 peter
  1888. * fixed reference parsing
  1889. Revision 1.74 2000/04/29 12:51:33 peter
  1890. * fixed offset support intel reader, the gotoffset variable was not
  1891. always reset
  1892. * moved check for local/para to be only used for varsym
  1893. Revision 1.73 2000/04/04 13:48:44 pierre
  1894. + TOperand.SetCorrectSize virtual method added
  1895. to be able to change the suffix according to the instruction
  1896. (FIADD word ptr w need a s as ATT suffix
  1897. wheras FILD word ptr w need a w suffix :( )
  1898. Revision 1.72 2000/03/15 23:10:01 pierre
  1899. * fix for bug 848 (that still genrated wrong code)
  1900. + better testing for variables used in assembler
  1901. (gives an error if variable is not directly reachable !)
  1902. Revision 1.71 2000/02/09 13:23:01 peter
  1903. * log truncated
  1904. Revision 1.70 2000/01/28 09:41:39 peter
  1905. * fixed fpu suffix parsing for att reader
  1906. Revision 1.69 2000/01/21 10:10:25 daniel
  1907. * should work on linux also
  1908. Revision 1.68 2000/01/21 00:46:47 peter
  1909. * ifdef'd my previous fix as it broken a make cycle sometimes
  1910. Revision 1.67 2000/01/20 23:35:01 peter
  1911. * fixed fldl where suffix would get S_L instead of S_FL
  1912. Revision 1.66 2000/01/07 01:14:34 peter
  1913. * updated copyright to 2000
  1914. Revision 1.65 1999/12/12 12:57:59 peter
  1915. * allow para+offset
  1916. Revision 1.64 1999/11/30 10:40:52 peter
  1917. + ttype, tsymlist
  1918. Revision 1.63 1999/11/17 17:05:03 pierre
  1919. * Notes/hints changes
  1920. Revision 1.62 1999/11/09 23:06:46 peter
  1921. * esi_offset -> selfpointer_offset to be newcg compatible
  1922. * hcogegen -> cgbase fixes for newcg
  1923. Revision 1.61 1999/11/06 14:34:23 peter
  1924. * truncated log to 20 revs
  1925. Revision 1.60 1999/10/01 07:59:20 peter
  1926. * fixed object field parsing
  1927. Revision 1.59 1999/09/27 23:44:57 peter
  1928. * procinfo is now a pointer
  1929. * support for result setting in sub procedure
  1930. Revision 1.58 1999/09/08 16:04:01 peter
  1931. * better support for object fields and more error checks for
  1932. field accesses which create buggy code
  1933. Revision 1.57 1999/08/05 16:53:08 peter
  1934. * V_Fatal=1, all other V_ are also increased
  1935. * Check for local procedure when assigning procvar
  1936. * fixed comment parsing because directives
  1937. * oldtp mode directives better supported
  1938. * added some messages to errore.msg
  1939. Revision 1.56 1999/08/04 00:23:25 florian
  1940. * renamed i386asm and i386base to cpuasm and cpubase
  1941. Revision 1.55 1999/08/03 22:03:09 peter
  1942. * moved bitmask constants to sets
  1943. * some other type/const renamings
  1944. Revision 1.54 1999/07/24 11:17:12 peter
  1945. * suffix parsing for at&t fixed for things like movsbl
  1946. * string constants are now handle correctly and also allowed in
  1947. constant expressions
  1948. }