ra386att.pas 52 KB

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