ra386int.pas 58 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
  4. Does the parsing process for the intel 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. Unit Ra386int;
  19. {$i fpcdefs.inc}
  20. Interface
  21. uses
  22. node;
  23. function assemble: tnode;
  24. Implementation
  25. uses
  26. { common }
  27. cutils,cclasses,
  28. { global }
  29. globtype,globals,verbose,
  30. systems,
  31. { aasm }
  32. cpuinfo,cpubase,aasmbase,aasmtai,aasmcpu,
  33. { symtable }
  34. symconst,symbase,symtype,symsym,symtable,
  35. { pass 1 }
  36. nbas,
  37. { parser }
  38. rgobj,
  39. { register allocator }
  40. scanner,
  41. rautils,rax86,itx86int,
  42. { codegen }
  43. cginfo,cgbase,cgobj
  44. ;
  45. type
  46. tasmtoken = (
  47. AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
  48. AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN,
  49. AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,
  50. AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,
  51. {------------------ Assembler directives --------------------}
  52. AS_DB,AS_DW,AS_DD,AS_END,
  53. {------------------ Assembler Operators --------------------}
  54. AS_BYTE,AS_WORD,AS_DWORD,AS_QWORD,AS_TBYTE,AS_NEAR,AS_FAR,
  55. AS_HIGH,AS_LOW,AS_OFFSET,AS_SEG,AS_TYPE,AS_PTR,AS_MOD,AS_SHL,AS_SHR,AS_NOT,
  56. AS_AND,AS_OR,AS_XOR);
  57. tasmkeyword = string[6];
  58. const
  59. { These tokens should be modified accordingly to the modifications }
  60. { in the different enumerations. }
  61. firstdirective = AS_DB;
  62. lastdirective = AS_END;
  63. firstoperator = AS_BYTE;
  64. lastoperator = AS_XOR;
  65. _count_asmdirectives = longint(lastdirective)-longint(firstdirective);
  66. _count_asmoperators = longint(lastoperator)-longint(firstoperator);
  67. _asmdirectives : array[0.._count_asmdirectives] of tasmkeyword =
  68. ('DB','DW','DD','END');
  69. { problems with shl,shr,not,and,or and xor, they are }
  70. { context sensitive. }
  71. _asmoperators : array[0.._count_asmoperators] of tasmkeyword = (
  72. 'BYTE','WORD','DWORD','QWORD','TBYTE','NEAR','FAR','HIGH',
  73. 'LOW','OFFSET','SEG','TYPE','PTR','MOD','SHL','SHR','NOT','AND',
  74. 'OR','XOR');
  75. token2str : array[tasmtoken] of string[10] = (
  76. '','Label','LLabel','String','Integer',
  77. ',','[',']','(',
  78. ')',':','.','+','-','*',
  79. ';','identifier','register','opcode','/',
  80. '','','','END',
  81. '','','','','','','','',
  82. '','','','type','ptr','mod','shl','shr','not',
  83. 'and','or','xor'
  84. );
  85. const
  86. newline = #10;
  87. firsttoken : boolean = TRUE;
  88. var
  89. _asmsorted : boolean;
  90. inexpression : boolean;
  91. curlist : TAAsmoutput;
  92. c : char;
  93. prevasmtoken : tasmtoken;
  94. actasmtoken : tasmtoken;
  95. actasmpattern : string;
  96. actasmregister : tregister;
  97. actopcode : tasmop;
  98. actopsize : topsize;
  99. actcondition : tasmcond;
  100. iasmops : tdictionary;
  101. Procedure SetupTables;
  102. { creates uppercased symbol tables for speed access }
  103. var
  104. i : tasmop;
  105. str2opentry: tstr2opentry;
  106. Begin
  107. { opcodes }
  108. iasmops:=tdictionary.create;
  109. iasmops.delete_doubles:=true;
  110. for i:=firstop to lastop do
  111. begin
  112. str2opentry:=tstr2opentry.createname(upper(std_op2str[i]));
  113. str2opentry.op:=i;
  114. iasmops.insert(str2opentry);
  115. end;
  116. end;
  117. {---------------------------------------------------------------------}
  118. { Routines for the tokenizing }
  119. {---------------------------------------------------------------------}
  120. function is_asmopcode(const s: string):boolean;
  121. var
  122. str2opentry: tstr2opentry;
  123. cond : string[4];
  124. cnd : tasmcond;
  125. j: longint;
  126. Begin
  127. is_asmopcode:=FALSE;
  128. actopcode:=A_None;
  129. actcondition:=C_None;
  130. actopsize:=S_NO;
  131. str2opentry:=tstr2opentry(iasmops.search(s));
  132. if assigned(str2opentry) then
  133. begin
  134. actopcode:=str2opentry.op;
  135. actasmtoken:=AS_OPCODE;
  136. is_asmopcode:=TRUE;
  137. exit;
  138. end;
  139. { not found yet, 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,255);
  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. actcondition:=cnd;
  153. is_asmopcode:=TRUE;
  154. actasmtoken:=AS_OPCODE;
  155. exit
  156. end;
  157. end;
  158. end;
  159. inc(j);
  160. end;
  161. end;
  162. function is_asmoperator(const s: string):boolean;
  163. var
  164. i : longint;
  165. Begin
  166. for i:=0 to _count_asmoperators do
  167. if s=_asmoperators[i] then
  168. begin
  169. actasmtoken:=tasmtoken(longint(firstoperator)+i);
  170. is_asmoperator:=true;
  171. exit;
  172. end;
  173. is_asmoperator:=false;
  174. end;
  175. Function is_asmdirective(const s: string):boolean;
  176. var
  177. i : longint;
  178. Begin
  179. for i:=0 to _count_asmdirectives do
  180. if s=_asmdirectives[i] then
  181. begin
  182. actasmtoken:=tasmtoken(longint(firstdirective)+i);
  183. is_asmdirective:=true;
  184. exit;
  185. end;
  186. is_asmdirective:=false;
  187. end;
  188. function is_register(const s:string):boolean;
  189. begin
  190. is_register:=false;
  191. actasmregister:=masm_regnum_search(lower(s));
  192. if actasmregister<>NR_NO then
  193. begin
  194. is_register:=true;
  195. actasmtoken:=AS_REGISTER;
  196. end;
  197. end;
  198. function is_locallabel(const s:string):boolean;
  199. begin
  200. is_locallabel:=(length(s)>1) and (s[1]='@');
  201. end;
  202. Procedure GetToken;
  203. var
  204. len : longint;
  205. forcelabel : boolean;
  206. srsym : tsym;
  207. srsymtable : tsymtable;
  208. begin
  209. { save old token and reset new token }
  210. prevasmtoken:=actasmtoken;
  211. actasmtoken:=AS_NONE;
  212. { reset }
  213. forcelabel:=FALSE;
  214. actasmpattern:='';
  215. { while space and tab , continue scan... }
  216. while (c in [' ',#9]) do
  217. c:=current_scanner.asmgetchar;
  218. { get token pos }
  219. if not (c in [newline,#13,'{',';']) then
  220. current_scanner.gettokenpos;
  221. { Local Label, Label, Directive, Prefix or Opcode }
  222. if firsttoken and not (c in [newline,#13,'{',';']) then
  223. begin
  224. firsttoken:=FALSE;
  225. len:=0;
  226. while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
  227. begin
  228. { if there is an at_sign, then this must absolutely be a label }
  229. if c = '@' then
  230. forcelabel:=TRUE;
  231. inc(len);
  232. actasmpattern[len]:=c;
  233. c:=current_scanner.asmgetchar;
  234. end;
  235. actasmpattern[0]:=chr(len);
  236. uppervar(actasmpattern);
  237. { label ? }
  238. if c = ':' then
  239. begin
  240. if actasmpattern[1]='@' then
  241. actasmtoken:=AS_LLABEL
  242. else
  243. actasmtoken:=AS_LABEL;
  244. { let us point to the next character }
  245. c:=current_scanner.asmgetchar;
  246. firsttoken:=true;
  247. exit;
  248. end;
  249. { Are we trying to create an identifier with }
  250. { an at-sign...? }
  251. if forcelabel then
  252. Message(asmr_e_none_label_contain_at);
  253. { opcode ? }
  254. If is_asmopcode(actasmpattern) then
  255. Begin
  256. { check if we are in an expression }
  257. { then continue with asm directives }
  258. if not inexpression then
  259. exit;
  260. end;
  261. if is_asmdirective(actasmpattern) then
  262. exit;
  263. message1(asmr_e_unknown_opcode,actasmpattern);
  264. actasmtoken:=AS_NONE;
  265. exit;
  266. end
  267. else { else firsttoken }
  268. begin
  269. case c of
  270. '@' : { possiblities : - local label reference , such as in jmp @local1 }
  271. { - @Result, @Code or @Data special variables. }
  272. begin
  273. actasmpattern:=c;
  274. c:=current_scanner.asmgetchar;
  275. while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
  276. begin
  277. actasmpattern:=actasmpattern + c;
  278. c:=current_scanner.asmgetchar;
  279. end;
  280. uppervar(actasmpattern);
  281. actasmtoken:=AS_ID;
  282. exit;
  283. end;
  284. 'A'..'Z','a'..'z','_': { identifier, register, opcode, prefix or directive }
  285. begin
  286. actasmpattern:=c;
  287. c:=current_scanner.asmgetchar;
  288. while c in ['A'..'Z','a'..'z','0'..'9','_'] do
  289. begin
  290. actasmpattern:=actasmpattern + c;
  291. c:=current_scanner.asmgetchar;
  292. end;
  293. uppervar(actasmpattern);
  294. { after prefix we allow also a new opcode }
  295. If is_prefix(actopcode) and is_asmopcode(actasmpattern) then
  296. Begin
  297. { if we are not in a constant }
  298. { expression than this is an }
  299. { opcode. }
  300. if not inexpression then
  301. exit;
  302. end;
  303. { support st(X) for fpu registers }
  304. if (actasmpattern = 'ST') and (c='(') then
  305. Begin
  306. actasmpattern:=actasmpattern+c;
  307. c:=current_scanner.asmgetchar;
  308. if c in ['0'..'7'] then
  309. actasmpattern:=actasmpattern + c
  310. else
  311. Message(asmr_e_invalid_fpu_register);
  312. c:=current_scanner.asmgetchar;
  313. if c <> ')' then
  314. Message(asmr_e_invalid_fpu_register)
  315. else
  316. Begin
  317. actasmpattern:=actasmpattern + c;
  318. c:=current_scanner.asmgetchar;
  319. end;
  320. end;
  321. if is_register(actasmpattern) then
  322. exit;
  323. if is_asmdirective(actasmpattern) then
  324. exit;
  325. if is_asmoperator(actasmpattern) then
  326. exit;
  327. { if next is a '.' and this is a unitsym then we also need to
  328. parse the identifier }
  329. if (c='.') then
  330. begin
  331. searchsym(actasmpattern,srsym,srsymtable);
  332. if assigned(srsym) and
  333. (srsym.typ=unitsym) and
  334. (srsym.owner.unitid=0) then
  335. begin
  336. actasmpattern:=actasmpattern+c;
  337. c:=current_scanner.asmgetchar;
  338. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  339. begin
  340. actasmpattern:=actasmpattern + upcase(c);
  341. c:=current_scanner.asmgetchar;
  342. end;
  343. end;
  344. end;
  345. actasmtoken:=AS_ID;
  346. exit;
  347. end;
  348. '''' : { string or character }
  349. begin
  350. actasmpattern:='';
  351. current_scanner.in_asm_string:=true;
  352. repeat
  353. if c = '''' then
  354. begin
  355. c:=current_scanner.asmgetchar;
  356. if c=newline then
  357. begin
  358. Message(scan_f_string_exceeds_line);
  359. break;
  360. end;
  361. repeat
  362. if c='''' then
  363. begin
  364. c:=current_scanner.asmgetchar;
  365. if c='''' then
  366. begin
  367. actasmpattern:=actasmpattern+'''';
  368. c:=current_scanner.asmgetchar;
  369. if c=newline then
  370. begin
  371. Message(scan_f_string_exceeds_line);
  372. break;
  373. end;
  374. end
  375. else
  376. break;
  377. end
  378. else
  379. begin
  380. actasmpattern:=actasmpattern+c;
  381. c:=current_scanner.asmgetchar;
  382. if c=newline then
  383. begin
  384. Message(scan_f_string_exceeds_line);
  385. break
  386. end;
  387. end;
  388. until false; { end repeat }
  389. end
  390. else
  391. break; { end if }
  392. until false;
  393. current_scanner.in_asm_string:=false;
  394. actasmtoken:=AS_STRING;
  395. exit;
  396. end;
  397. '"' : { string or character }
  398. begin
  399. current_scanner.in_asm_string:=true;
  400. actasmpattern:='';
  401. repeat
  402. if c = '"' then
  403. begin
  404. c:=current_scanner.asmgetchar;
  405. if c=newline then
  406. begin
  407. Message(scan_f_string_exceeds_line);
  408. break;
  409. end;
  410. repeat
  411. if c='"' then
  412. begin
  413. c:=current_scanner.asmgetchar;
  414. if c='"' then
  415. begin
  416. actasmpattern:=actasmpattern+'"';
  417. c:=current_scanner.asmgetchar;
  418. if c=newline then
  419. begin
  420. Message(scan_f_string_exceeds_line);
  421. break;
  422. end;
  423. end
  424. else
  425. break;
  426. end
  427. else
  428. begin
  429. actasmpattern:=actasmpattern+c;
  430. c:=current_scanner.asmgetchar;
  431. if c=newline then
  432. begin
  433. Message(scan_f_string_exceeds_line);
  434. break
  435. end;
  436. end;
  437. until false; { end repeat }
  438. end
  439. else
  440. break; { end if }
  441. until false;
  442. current_scanner.in_asm_string:=false;
  443. actasmtoken:=AS_STRING;
  444. exit;
  445. end;
  446. '$' :
  447. begin
  448. c:=current_scanner.asmgetchar;
  449. while c in ['0'..'9','A'..'F','a'..'f'] do
  450. begin
  451. actasmpattern:=actasmpattern + c;
  452. c:=current_scanner.asmgetchar;
  453. end;
  454. actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
  455. actasmtoken:=AS_INTNUM;
  456. exit;
  457. end;
  458. ',' :
  459. begin
  460. actasmtoken:=AS_COMMA;
  461. c:=current_scanner.asmgetchar;
  462. exit;
  463. end;
  464. '[' :
  465. begin
  466. actasmtoken:=AS_LBRACKET;
  467. c:=current_scanner.asmgetchar;
  468. exit;
  469. end;
  470. ']' :
  471. begin
  472. actasmtoken:=AS_RBRACKET;
  473. c:=current_scanner.asmgetchar;
  474. exit;
  475. end;
  476. '(' :
  477. begin
  478. actasmtoken:=AS_LPAREN;
  479. c:=current_scanner.asmgetchar;
  480. exit;
  481. end;
  482. ')' :
  483. begin
  484. actasmtoken:=AS_RPAREN;
  485. c:=current_scanner.asmgetchar;
  486. exit;
  487. end;
  488. ':' :
  489. begin
  490. actasmtoken:=AS_COLON;
  491. c:=current_scanner.asmgetchar;
  492. exit;
  493. end;
  494. '.' :
  495. begin
  496. actasmtoken:=AS_DOT;
  497. c:=current_scanner.asmgetchar;
  498. exit;
  499. end;
  500. '+' :
  501. begin
  502. actasmtoken:=AS_PLUS;
  503. c:=current_scanner.asmgetchar;
  504. exit;
  505. end;
  506. '-' :
  507. begin
  508. actasmtoken:=AS_MINUS;
  509. c:=current_scanner.asmgetchar;
  510. exit;
  511. end;
  512. '*' :
  513. begin
  514. actasmtoken:=AS_STAR;
  515. c:=current_scanner.asmgetchar;
  516. exit;
  517. end;
  518. '/' :
  519. begin
  520. actasmtoken:=AS_SLASH;
  521. c:=current_scanner.asmgetchar;
  522. exit;
  523. end;
  524. '0'..'9':
  525. begin
  526. actasmpattern:=c;
  527. c:=current_scanner.asmgetchar;
  528. { Get the possible characters }
  529. while c in ['0'..'9','A'..'F','a'..'f'] do
  530. begin
  531. actasmpattern:=actasmpattern + c;
  532. c:=current_scanner.asmgetchar;
  533. end;
  534. { Get ending character }
  535. uppervar(actasmpattern);
  536. c:=upcase(c);
  537. { possibly a binary number. }
  538. if (actasmpattern[length(actasmpattern)] = 'B') and (c <> 'H') then
  539. Begin
  540. { Delete the last binary specifier }
  541. delete(actasmpattern,length(actasmpattern),1);
  542. actasmpattern:=tostr(ValBinary(actasmpattern));
  543. actasmtoken:=AS_INTNUM;
  544. exit;
  545. end
  546. else
  547. Begin
  548. case c of
  549. 'O' :
  550. Begin
  551. actasmpattern:=tostr(ValOctal(actasmpattern));
  552. actasmtoken:=AS_INTNUM;
  553. c:=current_scanner.asmgetchar;
  554. exit;
  555. end;
  556. 'H' :
  557. Begin
  558. actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
  559. actasmtoken:=AS_INTNUM;
  560. c:=current_scanner.asmgetchar;
  561. exit;
  562. end;
  563. else { must be an integer number }
  564. begin
  565. actasmpattern:=tostr(ValDecimal(actasmpattern));
  566. actasmtoken:=AS_INTNUM;
  567. exit;
  568. end;
  569. end;
  570. end;
  571. end;
  572. ';','{',#13,newline :
  573. begin
  574. c:=current_scanner.asmgetchar;
  575. firsttoken:=TRUE;
  576. actasmtoken:=AS_SEPARATOR;
  577. exit;
  578. end;
  579. else
  580. current_scanner.illegal_char(c);
  581. end;
  582. end;
  583. end;
  584. function consume(t : tasmtoken):boolean;
  585. begin
  586. Consume:=true;
  587. if t<>actasmtoken then
  588. begin
  589. Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
  590. Consume:=false;
  591. end;
  592. repeat
  593. gettoken;
  594. until actasmtoken<>AS_NONE;
  595. end;
  596. procedure RecoverConsume(allowcomma:boolean);
  597. begin
  598. While not (actasmtoken in [AS_SEPARATOR,AS_END]) do
  599. begin
  600. if allowcomma and (actasmtoken=AS_COMMA) then
  601. break;
  602. Consume(actasmtoken);
  603. end;
  604. end;
  605. {*****************************************************************************
  606. Parsing Helpers
  607. *****************************************************************************}
  608. Procedure BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
  609. { Description: This routine builds up a record offset after a AS_DOT }
  610. { token is encountered. }
  611. { On entry actasmtoken should be equal to AS_DOT }
  612. var
  613. s : string;
  614. Begin
  615. offset:=0;
  616. size:=0;
  617. s:=expr;
  618. while (actasmtoken=AS_DOT) do
  619. begin
  620. Consume(AS_DOT);
  621. if actasmtoken=AS_ID then
  622. s:=s+'.'+actasmpattern;
  623. if not Consume(AS_ID) then
  624. begin
  625. RecoverConsume(true);
  626. break;
  627. end;
  628. end;
  629. if not GetRecordOffsetSize(s,offset,size) then
  630. Message(asmr_e_building_record_offset);
  631. end;
  632. Procedure BuildConstSymbolExpression(needofs,exitreg:boolean;var value:longint;var asmsym:string);
  633. var
  634. tempstr,expr,hs : string;
  635. parenlevel,l,k : longint;
  636. errorflag : boolean;
  637. prevtok : tasmtoken;
  638. hl : tasmlabel;
  639. sym : tsym;
  640. srsymtable : tsymtable;
  641. Begin
  642. { reset }
  643. value:=0;
  644. asmsym:='';
  645. errorflag:=FALSE;
  646. tempstr:='';
  647. expr:='';
  648. inexpression:=TRUE;
  649. parenlevel:=0;
  650. Repeat
  651. Case actasmtoken of
  652. AS_LPAREN:
  653. Begin
  654. Consume(AS_LPAREN);
  655. expr:=expr + '(';
  656. inc(parenlevel);
  657. end;
  658. AS_RPAREN:
  659. Begin
  660. Consume(AS_RPAREN);
  661. expr:=expr + ')';
  662. dec(parenlevel);
  663. end;
  664. AS_SHL:
  665. Begin
  666. Consume(AS_SHL);
  667. expr:=expr + '<';
  668. end;
  669. AS_SHR:
  670. Begin
  671. Consume(AS_SHR);
  672. expr:=expr + '>';
  673. end;
  674. AS_SLASH:
  675. Begin
  676. Consume(AS_SLASH);
  677. expr:=expr + '/';
  678. end;
  679. AS_MOD:
  680. Begin
  681. Consume(AS_MOD);
  682. expr:=expr + '%';
  683. end;
  684. AS_STAR:
  685. Begin
  686. Consume(AS_STAR);
  687. if exitreg and (actasmtoken=AS_REGISTER) then
  688. break;
  689. expr:=expr + '*';
  690. end;
  691. AS_PLUS:
  692. Begin
  693. Consume(AS_PLUS);
  694. if exitreg and (actasmtoken=AS_REGISTER) then
  695. break;
  696. expr:=expr + '+';
  697. end;
  698. AS_MINUS:
  699. Begin
  700. Consume(AS_MINUS);
  701. expr:=expr + '-';
  702. end;
  703. AS_AND:
  704. Begin
  705. Consume(AS_AND);
  706. expr:=expr + '&';
  707. end;
  708. AS_NOT:
  709. Begin
  710. Consume(AS_NOT);
  711. expr:=expr + '~';
  712. end;
  713. AS_XOR:
  714. Begin
  715. Consume(AS_XOR);
  716. expr:=expr + '^';
  717. end;
  718. AS_OR:
  719. Begin
  720. Consume(AS_OR);
  721. expr:=expr + '|';
  722. end;
  723. AS_INTNUM:
  724. Begin
  725. expr:=expr + actasmpattern;
  726. Consume(AS_INTNUM);
  727. end;
  728. AS_OFFSET:
  729. begin
  730. Consume(AS_OFFSET);
  731. if actasmtoken<>AS_ID then
  732. Message(asmr_e_offset_without_identifier);
  733. end;
  734. AS_TYPE:
  735. begin
  736. l:=0;
  737. Consume(AS_TYPE);
  738. if actasmtoken<>AS_ID then
  739. Message(asmr_e_type_without_identifier)
  740. else
  741. begin
  742. tempstr:=actasmpattern;
  743. Consume(AS_ID);
  744. if actasmtoken=AS_DOT then
  745. BuildRecordOffsetSize(tempstr,k,l)
  746. else
  747. begin
  748. searchsym(tempstr,sym,srsymtable);
  749. if assigned(sym) then
  750. begin
  751. case sym.typ of
  752. varsym :
  753. l:=tvarsym(sym).getsize;
  754. typedconstsym :
  755. l:=ttypedconstsym(sym).getsize;
  756. typesym :
  757. l:=ttypesym(sym).restype.def.size;
  758. else
  759. Message(asmr_e_wrong_sym_type);
  760. end;
  761. end
  762. else
  763. Message1(sym_e_unknown_id,tempstr);
  764. end;
  765. end;
  766. str(l, tempstr);
  767. expr:=expr + tempstr;
  768. end;
  769. AS_STRING:
  770. Begin
  771. l:=0;
  772. case Length(actasmpattern) of
  773. 1 :
  774. l:=ord(actasmpattern[1]);
  775. 2 :
  776. l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
  777. 3 :
  778. l:=ord(actasmpattern[3]) +
  779. Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
  780. 4 :
  781. l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
  782. Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
  783. else
  784. Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
  785. end;
  786. str(l, tempstr);
  787. expr:=expr + tempstr;
  788. Consume(AS_STRING);
  789. end;
  790. AS_ID:
  791. Begin
  792. hs:='';
  793. tempstr:=actasmpattern;
  794. prevtok:=prevasmtoken;
  795. consume(AS_ID);
  796. if SearchIConstant(tempstr,l) then
  797. begin
  798. str(l, tempstr);
  799. expr:=expr + tempstr;
  800. end
  801. else
  802. begin
  803. if is_locallabel(tempstr) then
  804. begin
  805. CreateLocalLabel(tempstr,hl,false);
  806. hs:=hl.name
  807. end
  808. else
  809. if SearchLabel(tempstr,hl,false) then
  810. hs:=hl.name
  811. else
  812. begin
  813. searchsym(tempstr,sym,srsymtable);
  814. if assigned(sym) then
  815. begin
  816. case sym.typ of
  817. varsym :
  818. begin
  819. if sym.owner.symtabletype in [localsymtable,parasymtable] then
  820. Message(asmr_e_no_local_or_para_allowed);
  821. hs:=tvarsym(sym).mangledname;
  822. end;
  823. typedconstsym :
  824. hs:=ttypedconstsym(sym).mangledname;
  825. procsym :
  826. begin
  827. if Tprocsym(sym).procdef_count>1 then
  828. Message(asmr_w_calling_overload_func);
  829. hs:=tprocsym(sym).first_procdef.mangledname;
  830. end;
  831. typesym :
  832. begin
  833. if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
  834. Message(asmr_e_wrong_sym_type);
  835. end;
  836. else
  837. Message(asmr_e_wrong_sym_type);
  838. end;
  839. end
  840. else
  841. Message1(sym_e_unknown_id,tempstr);
  842. end;
  843. { symbol found? }
  844. if hs<>'' then
  845. begin
  846. if needofs and (prevtok<>AS_OFFSET) then
  847. Message(asmr_e_need_offset);
  848. if asmsym='' then
  849. asmsym:=hs
  850. else
  851. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  852. if (expr='') or (expr[length(expr)]='+') then
  853. begin
  854. { don't remove the + if there could be a record field }
  855. if actasmtoken<>AS_DOT then
  856. delete(expr,length(expr),1);
  857. end
  858. else
  859. Message(asmr_e_only_add_relocatable_symbol);
  860. end;
  861. if actasmtoken=AS_DOT then
  862. begin
  863. BuildRecordOffsetSize(tempstr,l,k);
  864. str(l, tempstr);
  865. expr:=expr + tempstr;
  866. end
  867. else
  868. begin
  869. if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
  870. delete(expr,length(expr),1);
  871. end;
  872. end;
  873. { check if there are wrong operator used like / or mod etc. }
  874. if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END,AS_RBRACKET]) then
  875. Message(asmr_e_only_add_relocatable_symbol);
  876. end;
  877. AS_END,
  878. AS_RBRACKET,
  879. AS_SEPARATOR,
  880. AS_COMMA:
  881. Begin
  882. break;
  883. end;
  884. else
  885. Begin
  886. { write error only once. }
  887. if not errorflag then
  888. Message(asmr_e_invalid_constant_expression);
  889. { consume tokens until we find COMMA or SEPARATOR }
  890. Consume(actasmtoken);
  891. errorflag:=TRUE;
  892. end;
  893. end;
  894. Until false;
  895. { calculate expression }
  896. if not ErrorFlag then
  897. value:=CalculateExpression(expr)
  898. else
  899. value:=0;
  900. { no longer in an expression }
  901. inexpression:=FALSE;
  902. end;
  903. Function BuildConstExpression:longint;
  904. var
  905. l : longint;
  906. hs : string;
  907. begin
  908. BuildConstSymbolExpression(false,false,l,hs);
  909. if hs<>'' then
  910. Message(asmr_e_relocatable_symbol_not_allowed);
  911. BuildConstExpression:=l;
  912. end;
  913. Function BuildRefConstExpression:longint;
  914. var
  915. l : longint;
  916. hs : string;
  917. begin
  918. BuildConstSymbolExpression(false,true,l,hs);
  919. if hs<>'' then
  920. Message(asmr_e_relocatable_symbol_not_allowed);
  921. BuildRefConstExpression:=l;
  922. end;
  923. {****************************************************************************
  924. T386IntelOperand
  925. ****************************************************************************}
  926. type
  927. T386IntelOperand=class(T386Operand)
  928. Procedure BuildOperand;override;
  929. private
  930. Procedure BuildReference;
  931. Procedure BuildConstant;
  932. end;
  933. Procedure T386IntelOperand.BuildReference;
  934. var
  935. k,l,scale : longint;
  936. tempstr2,
  937. tempstr,hs : string;
  938. code : integer;
  939. hreg,
  940. oldbase : tregister;
  941. GotStar,GotOffset,HadVar,
  942. GotPlus,Negative : boolean;
  943. Begin
  944. Consume(AS_LBRACKET);
  945. InitRef;
  946. GotStar:=false;
  947. GotPlus:=true;
  948. GotOffset:=false;
  949. Negative:=false;
  950. Scale:=0;
  951. repeat
  952. if GotOffset and (actasmtoken<>AS_ID) then
  953. Message(asmr_e_invalid_reference_syntax);
  954. Case actasmtoken of
  955. AS_ID: { Constant reference expression OR variable reference expression }
  956. Begin
  957. if not GotPlus then
  958. Message(asmr_e_invalid_reference_syntax);
  959. if actasmpattern[1] = '@' then
  960. Message(asmr_e_local_label_not_allowed_as_ref);
  961. GotStar:=false;
  962. GotPlus:=false;
  963. if SearchIConstant(actasmpattern,l) or
  964. SearchRecordType(actasmpattern) then
  965. begin
  966. l:=BuildRefConstExpression;
  967. GotPlus:=(prevasmtoken=AS_PLUS);
  968. GotStar:=(prevasmtoken=AS_STAR);
  969. if GotStar then
  970. opr.ref.scalefactor:=l
  971. else
  972. begin
  973. if negative then
  974. Dec(opr.ref.offset,l)
  975. else
  976. Inc(opr.ref.offset,l);
  977. end;
  978. end
  979. else
  980. Begin
  981. if hasvar and not GotOffset then
  982. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  983. HadVar:=hasvar and GotOffset;
  984. if negative then
  985. Message(asmr_e_only_add_relocatable_symbol);
  986. oldbase:=opr.ref.base;
  987. opr.ref.base:=NR_NO;
  988. tempstr:=actasmpattern;
  989. Consume(AS_ID);
  990. { typecasting? }
  991. if (actasmtoken=AS_LPAREN) and
  992. SearchType(tempstr) then
  993. begin
  994. hastype:=true;
  995. Consume(AS_LPAREN);
  996. tempstr2:=actasmpattern;
  997. Consume(AS_ID);
  998. Consume(AS_RPAREN);
  999. if not SetupVar(tempstr2,GotOffset) then
  1000. Message1(sym_e_unknown_id,tempstr2);
  1001. end
  1002. else
  1003. if not SetupVar(tempstr,GotOffset) then
  1004. Message1(sym_e_unknown_id,tempstr);
  1005. { record.field ? }
  1006. if actasmtoken=AS_DOT then
  1007. begin
  1008. BuildRecordOffsetSize(tempstr,l,k);
  1009. inc(opr.ref.offset,l);
  1010. end;
  1011. if GotOffset then
  1012. begin
  1013. if hasvar and (opr.ref.base=current_procinfo.framepointer) then
  1014. begin
  1015. opr.ref.base:=NR_NO;
  1016. hasvar:=hadvar;
  1017. end
  1018. else
  1019. begin
  1020. if hasvar and hadvar then
  1021. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1022. { should we allow ?? }
  1023. end;
  1024. end;
  1025. { is the base register loaded by the var ? }
  1026. if (opr.ref.base<>NR_NO) then
  1027. begin
  1028. { check if we can move the old base to the index register }
  1029. if (opr.ref.index<>NR_NO) then
  1030. Message(asmr_e_wrong_base_index)
  1031. else
  1032. opr.ref.index:=oldbase;
  1033. end
  1034. else
  1035. opr.ref.base:=oldbase;
  1036. { we can't have a Constant here so add the constant value to the
  1037. offset }
  1038. if opr.typ=OPR_CONSTANT then
  1039. begin
  1040. opr.typ:=OPR_REFERENCE;
  1041. inc(opr.ref.offset,opr.val);
  1042. end;
  1043. end;
  1044. GotOffset:=false;
  1045. end;
  1046. AS_PLUS :
  1047. Begin
  1048. Consume(AS_PLUS);
  1049. Negative:=false;
  1050. GotPlus:=true;
  1051. GotStar:=false;
  1052. Scale:=0;
  1053. end;
  1054. AS_MINUS :
  1055. begin
  1056. Consume(AS_MINUS);
  1057. Negative:=true;
  1058. GotPlus:=true;
  1059. GotStar:=false;
  1060. Scale:=0;
  1061. end;
  1062. AS_STAR : { Scaling, with eax*4 order }
  1063. begin
  1064. Consume(AS_STAR);
  1065. hs:='';
  1066. l:=0;
  1067. case actasmtoken of
  1068. AS_LPAREN :
  1069. l:=BuildConstExpression;
  1070. AS_INTNUM:
  1071. Begin
  1072. hs:=actasmpattern;
  1073. Consume(AS_INTNUM);
  1074. end;
  1075. AS_REGISTER :
  1076. begin
  1077. if opr.ref.scalefactor=0 then
  1078. if scale<>0 then
  1079. begin
  1080. opr.ref.scalefactor:=scale;
  1081. scale:=0;
  1082. end
  1083. else
  1084. Message(asmr_e_wrong_scale_factor);
  1085. end;
  1086. else
  1087. Message(asmr_e_invalid_reference_syntax);
  1088. end;
  1089. if actasmtoken<>AS_REGISTER then
  1090. begin
  1091. if hs<>'' then
  1092. val(hs,l,code);
  1093. opr.ref.scalefactor:=l;
  1094. if l>9 then
  1095. Message(asmr_e_wrong_scale_factor);
  1096. end;
  1097. GotPlus:=false;
  1098. GotStar:=false;
  1099. end;
  1100. AS_REGISTER :
  1101. begin
  1102. if not((GotPlus and (not Negative)) or
  1103. GotStar) then
  1104. Message(asmr_e_invalid_reference_syntax);
  1105. hreg:=actasmregister;
  1106. Consume(AS_REGISTER);
  1107. { this register will be the index:
  1108. 1. just read a *
  1109. 2. next token is a *
  1110. 3. base register is already used }
  1111. if (GotStar) or
  1112. (actasmtoken=AS_STAR) or
  1113. (opr.ref.base<>NR_NO) then
  1114. begin
  1115. if (opr.ref.index<>NR_NO) then
  1116. Message(asmr_e_multiple_index);
  1117. opr.ref.index:=hreg;
  1118. if scale<>0 then
  1119. begin
  1120. opr.ref.scalefactor:=scale;
  1121. scale:=0;
  1122. end;
  1123. end
  1124. else
  1125. opr.ref.base:=hreg;
  1126. GotPlus:=false;
  1127. GotStar:=false;
  1128. end;
  1129. AS_OFFSET :
  1130. begin
  1131. Consume(AS_OFFSET);
  1132. GotOffset:=true;
  1133. end;
  1134. AS_TYPE,
  1135. AS_NOT,
  1136. AS_STRING,
  1137. AS_INTNUM,
  1138. AS_LPAREN : { Constant reference expression }
  1139. begin
  1140. if not GotPlus and not GotStar then
  1141. Message(asmr_e_invalid_reference_syntax);
  1142. BuildConstSymbolExpression(true,true,l,tempstr);
  1143. if tempstr<>'' then
  1144. begin
  1145. if GotStar then
  1146. Message(asmr_e_only_add_relocatable_symbol);
  1147. if not assigned(opr.ref.symbol) then
  1148. opr.ref.symbol:=objectlibrary.newasmsymbol(tempstr)
  1149. else
  1150. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1151. end;
  1152. if GotStar then
  1153. opr.ref.scalefactor:=l
  1154. else if (prevasmtoken = AS_STAR) then
  1155. begin
  1156. if scale<>0 then
  1157. scale:=l*scale
  1158. else
  1159. scale:=l;
  1160. end
  1161. else
  1162. begin
  1163. if negative then
  1164. Dec(opr.ref.offset,l)
  1165. else
  1166. Inc(opr.ref.offset,l);
  1167. end;
  1168. GotPlus:=(prevasmtoken=AS_PLUS) or
  1169. (prevasmtoken=AS_MINUS);
  1170. if GotPlus then
  1171. negative := prevasmtoken = AS_MINUS;
  1172. GotStar:=(prevasmtoken=AS_STAR);
  1173. end;
  1174. AS_RBRACKET :
  1175. begin
  1176. if GotPlus or GotStar then
  1177. Message(asmr_e_invalid_reference_syntax);
  1178. Consume(AS_RBRACKET);
  1179. break;
  1180. end;
  1181. else
  1182. Begin
  1183. Message(asmr_e_invalid_reference_syntax);
  1184. RecoverConsume(true);
  1185. break;
  1186. end;
  1187. end;
  1188. until false;
  1189. end;
  1190. Procedure T386IntelOperand.BuildConstant;
  1191. var
  1192. l : longint;
  1193. tempstr : string;
  1194. begin
  1195. BuildConstSymbolExpression(true,false,l,tempstr);
  1196. if tempstr<>'' then
  1197. begin
  1198. opr.typ:=OPR_SYMBOL;
  1199. opr.symofs:=l;
  1200. opr.symbol:=objectlibrary.newasmsymbol(tempstr);
  1201. end
  1202. else
  1203. begin
  1204. opr.typ:=OPR_CONSTANT;
  1205. opr.val:=l;
  1206. end;
  1207. end;
  1208. Procedure T386IntelOperand.BuildOperand;
  1209. var
  1210. tempstr,
  1211. expr : string;
  1212. tempreg : tregister;
  1213. l : longint;
  1214. hl : tasmlabel;
  1215. procedure AddLabelOperand(hl:tasmlabel);
  1216. begin
  1217. if is_calljmp(actopcode) then
  1218. begin
  1219. opr.typ:=OPR_SYMBOL;
  1220. opr.symbol:=hl;
  1221. end
  1222. else
  1223. begin
  1224. InitRef;
  1225. opr.ref.symbol:=hl;
  1226. end;
  1227. end;
  1228. procedure MaybeRecordOffset;
  1229. var
  1230. l,
  1231. toffset,
  1232. tsize : longint;
  1233. begin
  1234. if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
  1235. exit;
  1236. l:=0;
  1237. if actasmtoken=AS_DOT then
  1238. begin
  1239. { if no type was specified before the [] then we expect the
  1240. first ID to be the type }
  1241. if expr='' then
  1242. begin
  1243. consume(AS_DOT);
  1244. if actasmtoken=AS_ID then
  1245. begin
  1246. expr:=actasmpattern;
  1247. consume(AS_ID);
  1248. { now the next one must the be the dot }
  1249. if actasmtoken<>AS_DOT then
  1250. begin
  1251. { if it is not a dot then we expect a constant
  1252. value as offset }
  1253. if not SearchIConstant(expr,l) then
  1254. Message(asmr_e_building_record_offset);
  1255. expr:='';
  1256. end;
  1257. end
  1258. else
  1259. Message(asmr_e_no_var_type_specified)
  1260. end;
  1261. if expr<>'' then
  1262. begin
  1263. BuildRecordOffsetSize(expr,toffset,tsize);
  1264. inc(l,toffset);
  1265. SetSize(tsize,true);
  1266. end;
  1267. end;
  1268. if actasmtoken in [AS_PLUS,AS_MINUS] then
  1269. inc(l,BuildConstExpression);
  1270. case opr.typ of
  1271. OPR_LOCAL :
  1272. begin
  1273. { don't allow direct access to fields of parameters, becuase that
  1274. will generate buggy code. Allow it only for explicit typecasting }
  1275. if (not hastype) and
  1276. (tvarsym(pointer(opr.ref.symbol)).owner.symtabletype=parasymtable) then
  1277. Message(asmr_e_cannot_access_field_directly_for_parameters);
  1278. inc(opr.localsymofs,l)
  1279. end;
  1280. OPR_CONSTANT :
  1281. inc(opr.val,l);
  1282. OPR_REFERENCE :
  1283. inc(opr.ref.offset,l);
  1284. else
  1285. internalerror(200309222);
  1286. end;
  1287. end;
  1288. Begin
  1289. expr:='';
  1290. case actasmtoken of
  1291. AS_OFFSET,
  1292. AS_TYPE,
  1293. AS_INTNUM,
  1294. AS_PLUS,
  1295. AS_MINUS,
  1296. AS_NOT,
  1297. AS_LPAREN,
  1298. AS_STRING :
  1299. Begin
  1300. if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1301. Message(asmr_e_invalid_operand_type);
  1302. BuildConstant;
  1303. end;
  1304. AS_ID : { A constant expression, or a Variable ref. }
  1305. Begin
  1306. { Label or Special symbol reference? }
  1307. if actasmpattern[1] = '@' then
  1308. Begin
  1309. if actasmpattern = '@RESULT' then
  1310. Begin
  1311. InitRef;
  1312. SetupResult;
  1313. Consume(AS_ID);
  1314. end
  1315. else
  1316. if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
  1317. begin
  1318. Message(asmr_w_CODE_and_DATA_not_supported);
  1319. Consume(AS_ID);
  1320. end
  1321. else
  1322. { Local Label }
  1323. begin
  1324. CreateLocalLabel(actasmpattern,hl,false);
  1325. Consume(AS_ID);
  1326. AddLabelOperand(hl);
  1327. if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
  1328. Message(asmr_e_syntax_error);
  1329. end;
  1330. end
  1331. else
  1332. { support result for delphi modes }
  1333. if (m_objpas in aktmodeswitches) and (actasmpattern='RESULT') then
  1334. begin
  1335. InitRef;
  1336. SetUpResult;
  1337. Consume(AS_ID);
  1338. end
  1339. { probably a variable or normal expression }
  1340. { or a procedure (such as in CALL ID) }
  1341. else
  1342. Begin
  1343. { is it a constant ? }
  1344. if SearchIConstant(actasmpattern,l) then
  1345. Begin
  1346. if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1347. Message(asmr_e_invalid_operand_type);
  1348. BuildConstant;
  1349. end
  1350. else
  1351. { Check for pascal label }
  1352. if SearchLabel(actasmpattern,hl,false) then
  1353. begin
  1354. Consume(AS_ID);
  1355. AddLabelOperand(hl);
  1356. if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
  1357. Message(asmr_e_syntax_error);
  1358. end
  1359. else
  1360. { is it a normal variable ? }
  1361. Begin
  1362. InitRef;
  1363. expr:=actasmpattern;
  1364. Consume(AS_ID);
  1365. { typecasting? }
  1366. if (actasmtoken=AS_LPAREN) and
  1367. SearchType(expr) then
  1368. begin
  1369. hastype:=true;
  1370. Consume(AS_LPAREN);
  1371. tempstr:=actasmpattern;
  1372. Consume(AS_ID);
  1373. Consume(AS_RPAREN);
  1374. if SetupVar(tempstr,false) then
  1375. begin
  1376. MaybeRecordOffset;
  1377. { add a constant expression? }
  1378. if (actasmtoken=AS_PLUS) then
  1379. begin
  1380. l:=BuildConstExpression;
  1381. if opr.typ=OPR_CONSTANT then
  1382. inc(opr.val,l)
  1383. else
  1384. inc(opr.ref.offset,l);
  1385. end
  1386. end
  1387. else
  1388. Message1(sym_e_unknown_id,tempstr);
  1389. end
  1390. else
  1391. begin
  1392. if SetupVar(expr,false) then
  1393. begin
  1394. MaybeRecordOffset;
  1395. { add a constant expression? }
  1396. if (actasmtoken=AS_PLUS) then
  1397. begin
  1398. l:=BuildConstExpression;
  1399. case opr.typ of
  1400. OPR_CONSTANT :
  1401. inc(opr.val,l);
  1402. OPR_LOCAL :
  1403. inc(opr.localsymofs,l);
  1404. OPR_REFERENCE :
  1405. inc(opr.ref.offset,l);
  1406. else
  1407. internalerror(200309203);
  1408. end;
  1409. end
  1410. end
  1411. else
  1412. Begin
  1413. { not a variable, check special variables.. }
  1414. if expr = 'SELF' then
  1415. SetupSelf
  1416. else
  1417. Message1(sym_e_unknown_id,expr);
  1418. end;
  1419. end;
  1420. end;
  1421. { handle references }
  1422. if actasmtoken=AS_LBRACKET then
  1423. begin
  1424. if opr.typ=OPR_CONSTANT then
  1425. begin
  1426. l:=opr.val;
  1427. opr.typ:=OPR_REFERENCE;
  1428. reference_reset(opr.ref);
  1429. opr.Ref.Offset:=l;
  1430. end;
  1431. BuildReference;
  1432. MaybeRecordOffset;
  1433. end;
  1434. end;
  1435. end;
  1436. AS_REGISTER : { Register, a variable reference or a constant reference }
  1437. begin
  1438. { save the type of register used. }
  1439. tempreg:=actasmregister;
  1440. Consume(AS_REGISTER);
  1441. if actasmtoken = AS_COLON then
  1442. Begin
  1443. Consume(AS_COLON);
  1444. InitRef;
  1445. opr.ref.segment:=tempreg;
  1446. BuildReference;
  1447. end
  1448. else
  1449. { Simple register }
  1450. begin
  1451. if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then
  1452. Message(asmr_e_invalid_operand_type);
  1453. opr.typ:=OPR_REGISTER;
  1454. opr.reg:=tempreg;
  1455. SetSize(tcgsize2size[cg.reg_cgsize(opr.reg)],true);
  1456. end;
  1457. end;
  1458. AS_LBRACKET: { a variable reference, register ref. or a constant reference }
  1459. Begin
  1460. InitRef;
  1461. BuildReference;
  1462. MaybeRecordOffset;
  1463. end;
  1464. AS_SEG :
  1465. Begin
  1466. Message(asmr_e_seg_not_supported);
  1467. Consume(actasmtoken);
  1468. end;
  1469. AS_SEPARATOR,
  1470. AS_END,
  1471. AS_COMMA: ;
  1472. else
  1473. Message(asmr_e_syn_operand);
  1474. end;
  1475. if not(actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
  1476. begin
  1477. Message(asmr_e_syntax_error);
  1478. RecoverConsume(true);
  1479. end;
  1480. end;
  1481. {*****************************************************************************
  1482. T386IntelInstruction
  1483. *****************************************************************************}
  1484. type
  1485. T386IntelInstruction=class(T386Instruction)
  1486. procedure InitOperands;override;
  1487. procedure BuildOpcode;override;
  1488. end;
  1489. procedure T386IntelInstruction.InitOperands;
  1490. var
  1491. i : longint;
  1492. begin
  1493. OpOrder:=op_intel;
  1494. for i:=1 to 3 do
  1495. Operands[i]:=T386IntelOperand.Create;
  1496. end;
  1497. Procedure T386IntelInstruction.BuildOpCode;
  1498. var
  1499. PrefixOp,OverrideOp: tasmop;
  1500. size,
  1501. operandnum : longint;
  1502. Begin
  1503. PrefixOp:=A_None;
  1504. OverrideOp:=A_None;
  1505. { prefix seg opcode / prefix opcode }
  1506. repeat
  1507. if is_prefix(actopcode) then
  1508. begin
  1509. PrefixOp:=ActOpcode;
  1510. opcode:=ActOpcode;
  1511. condition:=ActCondition;
  1512. opsize:=ActOpsize;
  1513. ConcatInstruction(curlist);
  1514. Consume(AS_OPCODE);
  1515. end
  1516. else
  1517. if is_override(actopcode) then
  1518. begin
  1519. OverrideOp:=ActOpcode;
  1520. opcode:=ActOpcode;
  1521. condition:=ActCondition;
  1522. opsize:=ActOpsize;
  1523. ConcatInstruction(curlist);
  1524. Consume(AS_OPCODE);
  1525. end
  1526. else
  1527. break;
  1528. { allow for newline after prefix or override }
  1529. while actasmtoken=AS_SEPARATOR do
  1530. Consume(AS_SEPARATOR);
  1531. until (actasmtoken<>AS_OPCODE);
  1532. { opcode }
  1533. if (actasmtoken <> AS_OPCODE) then
  1534. Begin
  1535. Message(asmr_e_invalid_or_missing_opcode);
  1536. RecoverConsume(false);
  1537. exit;
  1538. end;
  1539. { Fill the instr object with the current state }
  1540. Opcode:=ActOpcode;
  1541. condition:=ActCondition;
  1542. opsize:=ActOpsize;
  1543. { Valid combination of prefix/override and instruction ? }
  1544. if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then
  1545. Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern);
  1546. if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then
  1547. Message1(asmr_e_invalid_override_and_opcode,actasmpattern);
  1548. { We are reading operands, so opcode will be an AS_ID }
  1549. operandnum:=1;
  1550. Consume(AS_OPCODE);
  1551. { Zero operand opcode ? }
  1552. if actasmtoken in [AS_SEPARATOR,AS_END] then
  1553. begin
  1554. operandnum:=0;
  1555. exit;
  1556. end;
  1557. { Read Operands }
  1558. repeat
  1559. case actasmtoken of
  1560. { End of asm operands for this opcode }
  1561. AS_END,
  1562. AS_SEPARATOR :
  1563. break;
  1564. { Operand delimiter }
  1565. AS_COMMA :
  1566. Begin
  1567. if operandnum > Max_Operands then
  1568. Message(asmr_e_too_many_operands)
  1569. else
  1570. Inc(operandnum);
  1571. Consume(AS_COMMA);
  1572. end;
  1573. { Typecast, Constant Expression, Type Specifier }
  1574. AS_DWORD,
  1575. AS_BYTE,
  1576. AS_WORD,
  1577. AS_TBYTE,
  1578. AS_QWORD :
  1579. Begin
  1580. { load the size in a temp variable, so it can be set when the
  1581. operand is read }
  1582. size:=0;
  1583. Case actasmtoken of
  1584. AS_DWORD : size:=4;
  1585. AS_WORD : size:=2;
  1586. AS_BYTE : size:=1;
  1587. AS_QWORD : size:=8;
  1588. AS_TBYTE : size:=extended_size;
  1589. end;
  1590. Consume(actasmtoken);
  1591. if actasmtoken=AS_PTR then
  1592. begin
  1593. Consume(AS_PTR);
  1594. Operands[operandnum].InitRef;
  1595. end;
  1596. Operands[operandnum].BuildOperand;
  1597. { now set the size which was specified by the override }
  1598. Operands[operandnum].setsize(size,true);
  1599. end;
  1600. { Type specifier }
  1601. AS_NEAR,
  1602. AS_FAR :
  1603. Begin
  1604. if actasmtoken = AS_NEAR then
  1605. begin
  1606. Message(asmr_w_near_ignored);
  1607. opsize:=S_NEAR;
  1608. end
  1609. else
  1610. begin
  1611. Message(asmr_w_far_ignored);
  1612. opsize:=S_FAR;
  1613. end;
  1614. Consume(actasmtoken);
  1615. if actasmtoken=AS_PTR then
  1616. begin
  1617. Consume(AS_PTR);
  1618. Operands[operandnum].InitRef;
  1619. end;
  1620. Operands[operandnum].BuildOperand;
  1621. end;
  1622. else
  1623. Operands[operandnum].BuildOperand;
  1624. end; { end case }
  1625. until false;
  1626. Ops:=operandnum;
  1627. end;
  1628. Procedure BuildConstant(maxvalue: longint);
  1629. var
  1630. strlength: byte;
  1631. asmsym,
  1632. expr: string;
  1633. value : longint;
  1634. Begin
  1635. strlength:=0; { assume it is a DB }
  1636. Repeat
  1637. Case actasmtoken of
  1638. AS_STRING:
  1639. Begin
  1640. if maxvalue = $ffff then
  1641. strlength:=2
  1642. else
  1643. if maxvalue = longint($ffffffff) then
  1644. strlength:=4;
  1645. { DD and DW cases }
  1646. if strlength <> 0 then
  1647. Begin
  1648. if Not PadZero(actasmpattern,strlength) then
  1649. Message(scan_f_string_exceeds_line);
  1650. end;
  1651. expr:=actasmpattern;
  1652. Consume(AS_STRING);
  1653. Case actasmtoken of
  1654. AS_COMMA:
  1655. Consume(AS_COMMA);
  1656. AS_END,
  1657. AS_SEPARATOR: ;
  1658. else
  1659. Message(asmr_e_invalid_string_expression);
  1660. end;
  1661. ConcatString(curlist,expr);
  1662. end;
  1663. AS_PLUS,
  1664. AS_MINUS,
  1665. AS_LPAREN,
  1666. AS_NOT,
  1667. AS_INTNUM,
  1668. AS_ID :
  1669. Begin
  1670. BuildConstSymbolExpression(false,false,value,asmsym);
  1671. if asmsym<>'' then
  1672. begin
  1673. if maxvalue<>longint($ffffffff) then
  1674. Message1(asmr_w_const32bit_for_address,asmsym);
  1675. ConcatConstSymbol(curlist,asmsym,value)
  1676. end
  1677. else
  1678. ConcatConstant(curlist,value,maxvalue);
  1679. end;
  1680. AS_COMMA:
  1681. Consume(AS_COMMA);
  1682. AS_END,
  1683. AS_SEPARATOR:
  1684. break;
  1685. else
  1686. begin
  1687. Message(asmr_e_syn_constant);
  1688. RecoverConsume(false);
  1689. end
  1690. end;
  1691. Until false;
  1692. end;
  1693. Function Assemble: tnode;
  1694. Var
  1695. hl : tasmlabel;
  1696. instr : T386IntelInstruction;
  1697. Begin
  1698. Message1(asmr_d_start_reading,'intel');
  1699. inexpression:=FALSE;
  1700. firsttoken:=TRUE;
  1701. { sets up all opcode and register tables in uppercase }
  1702. if not _asmsorted then
  1703. Begin
  1704. SetupTables;
  1705. _asmsorted:=TRUE;
  1706. end;
  1707. curlist:=TAAsmoutput.Create;
  1708. { setup label linked list }
  1709. LocalLabelList:=TLocalLabelList.Create;
  1710. { start tokenizer }
  1711. c:=current_scanner.asmgetchar;
  1712. gettoken;
  1713. { main loop }
  1714. repeat
  1715. case actasmtoken of
  1716. AS_LLABEL:
  1717. Begin
  1718. if CreateLocalLabel(actasmpattern,hl,true) then
  1719. ConcatLabel(curlist,hl);
  1720. Consume(AS_LLABEL);
  1721. end;
  1722. AS_LABEL:
  1723. Begin
  1724. if SearchLabel(upper(actasmpattern),hl,true) then
  1725. ConcatLabel(curlist,hl)
  1726. else
  1727. Message1(asmr_e_unknown_label_identifier,actasmpattern);
  1728. Consume(AS_LABEL);
  1729. end;
  1730. AS_DW :
  1731. Begin
  1732. inexpression:=true;
  1733. Consume(AS_DW);
  1734. BuildConstant($ffff);
  1735. inexpression:=false;
  1736. end;
  1737. AS_DB :
  1738. Begin
  1739. inexpression:=true;
  1740. Consume(AS_DB);
  1741. BuildConstant($ff);
  1742. inexpression:=false;
  1743. end;
  1744. AS_DD :
  1745. Begin
  1746. inexpression:=true;
  1747. Consume(AS_DD);
  1748. BuildConstant(longint($ffffffff));
  1749. inexpression:=false;
  1750. end;
  1751. AS_OPCODE :
  1752. Begin
  1753. instr:=T386IntelInstruction.Create;
  1754. instr.BuildOpcode;
  1755. { We need AT&T style operands }
  1756. instr.Swapoperands;
  1757. { Must be done with args in ATT order }
  1758. instr.CheckNonCommutativeOpcodes;
  1759. instr.AddReferenceSizes;
  1760. instr.SetInstructionOpsize;
  1761. instr.CheckOperandSizes;
  1762. instr.ConcatInstruction(curlist);
  1763. instr.Free;
  1764. end;
  1765. AS_SEPARATOR :
  1766. Begin
  1767. Consume(AS_SEPARATOR);
  1768. end;
  1769. AS_END :
  1770. break; { end assembly block }
  1771. else
  1772. Begin
  1773. Message(asmr_e_syntax_error);
  1774. RecoverConsume(false);
  1775. end;
  1776. end; { end case }
  1777. until false;
  1778. { Check LocalLabelList }
  1779. LocalLabelList.CheckEmitted;
  1780. LocalLabelList.Free;
  1781. { Return the list in an asmnode }
  1782. assemble:=casmnode.create(curlist);
  1783. Message1(asmr_d_finish_reading,'intel');
  1784. end;
  1785. {*****************************************************************************
  1786. Initialize
  1787. *****************************************************************************}
  1788. const
  1789. asmmode_i386_intel_info : tasmmodeinfo =
  1790. (
  1791. id : asmmode_i386_intel;
  1792. idtxt : 'INTEL'
  1793. );
  1794. initialization
  1795. RegisterAsmMode(asmmode_i386_intel_info);
  1796. finalization
  1797. if assigned(iasmops) then
  1798. iasmops.Free;
  1799. end.
  1800. {
  1801. $Log$
  1802. Revision 1.52 2003-09-23 20:37:53 peter
  1803. * fix global var+offset
  1804. Revision 1.51 2003/09/23 17:56:06 peter
  1805. * locals and paras are allocated in the code generation
  1806. * tvarsym.localloc contains the location of para/local when
  1807. generating code for the current procedure
  1808. Revision 1.50 2003/09/03 15:55:01 peter
  1809. * NEWRA branch merged
  1810. Revision 1.49.2.2 2003/08/31 15:46:26 peter
  1811. * more updates for tregister
  1812. Revision 1.49.2.1 2003/08/28 18:35:08 peter
  1813. * tregister changed to cardinal
  1814. Revision 1.49 2003/06/06 14:41:59 peter
  1815. * use setsize for size specifier
  1816. Revision 1.48 2003/05/30 23:57:08 peter
  1817. * more sparc cleanup
  1818. * accumulator removed, splitted in function_return_reg (called) and
  1819. function_result_reg (caller)
  1820. Revision 1.47 2003/04/30 15:45:35 florian
  1821. * merged more x86-64/i386 code
  1822. Revision 1.46 2003/04/27 11:21:35 peter
  1823. * aktprocdef renamed to current_procdef
  1824. * procinfo renamed to current_procinfo
  1825. * procinfo will now be stored in current_module so it can be
  1826. cleaned up properly
  1827. * gen_main_procsym changed to create_main_proc and release_main_proc
  1828. to also generate a tprocinfo structure
  1829. * fixed unit implicit initfinal
  1830. Revision 1.45 2003/04/21 20:05:10 peter
  1831. * removed some ie checks
  1832. Revision 1.44 2003/03/28 19:16:57 peter
  1833. * generic constructor working for i386
  1834. * remove fixed self register
  1835. * esi added as address register for i386
  1836. Revision 1.43 2003/03/18 18:15:53 peter
  1837. * changed reg2opsize to function
  1838. Revision 1.42 2003/03/17 21:32:52 peter
  1839. * allow character constants in reference declaration
  1840. Revision 1.41 2003/02/26 22:57:44 daniel
  1841. * Changed no longer correct fillchar of reference into location_reset
  1842. Revision 1.40 2003/02/19 22:00:16 daniel
  1843. * Code generator converted to new register notation
  1844. - Horribily outdated todo.txt removed
  1845. Revision 1.39 2003/01/08 18:43:57 daniel
  1846. * Tregister changed into a record
  1847. Revision 1.38 2002/12/14 15:02:03 carl
  1848. * maxoperands -> max_operands (for portability in rautils.pas)
  1849. * fix some range-check errors with loadconst
  1850. + add ncgadd unit to m68k
  1851. * some bugfix of a_param_reg with LOC_CREFERENCE
  1852. Revision 1.37 2002/12/01 22:08:34 carl
  1853. * some small cleanup (remove some specific operators which are not supported)
  1854. Revision 1.36 2002/11/15 01:58:59 peter
  1855. * merged changes from 1.0.7 up to 04-11
  1856. - -V option for generating bug report tracing
  1857. - more tracing for option parsing
  1858. - errors for cdecl and high()
  1859. - win32 import stabs
  1860. - win32 records<=8 are returned in eax:edx (turned off by default)
  1861. - heaptrc update
  1862. - more info for temp management in .s file with EXTDEBUG
  1863. Revision 1.35 2002/09/16 19:07:00 peter
  1864. * support [eax].constant as reference
  1865. Revision 1.34 2002/09/03 16:26:28 daniel
  1866. * Make Tprocdef.defs protected
  1867. Revision 1.33 2002/08/17 09:23:47 florian
  1868. * first part of procinfo rewrite
  1869. Revision 1.32 2002/08/13 18:01:52 carl
  1870. * rename swatoperands to swapoperands
  1871. + m68k first compilable version (still needs a lot of testing):
  1872. assembler generator, system information , inline
  1873. assembler reader.
  1874. Revision 1.31 2002/08/11 14:32:31 peter
  1875. * renamed current_library to objectlibrary
  1876. Revision 1.30 2002/08/11 13:24:17 peter
  1877. * saving of asmsymbols in ppu supported
  1878. * asmsymbollist global is removed and moved into a new class
  1879. tasmlibrarydata that will hold the info of a .a file which
  1880. corresponds with a single module. Added librarydata to tmodule
  1881. to keep the library info stored for the module. In the future the
  1882. objectfiles will also be stored to the tasmlibrarydata class
  1883. * all getlabel/newasmsymbol and friends are moved to the new class
  1884. Revision 1.29 2002/07/01 18:46:34 peter
  1885. * internal linker
  1886. * reorganized aasm layer
  1887. Revision 1.28 2002/05/18 13:34:26 peter
  1888. * readded missing revisions
  1889. Revision 1.27 2002/05/16 19:46:52 carl
  1890. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1891. + try to fix temp allocation (still in ifdef)
  1892. + generic constructor calls
  1893. + start of tassembler / tmodulebase class cleanup
  1894. Revision 1.25 2002/04/20 21:37:07 carl
  1895. + generic FPC_CHECKPOINTER
  1896. + first parameter offset in stack now portable
  1897. * rename some constants
  1898. + move some cpu stuff to other units
  1899. - remove unused constents
  1900. * fix stacksize for some targets
  1901. * fix generic size problems which depend now on EXTEND_SIZE constant
  1902. * removing frame pointer in routines is only available for : i386,m68k and vis targets
  1903. Revision 1.24 2002/04/15 19:44:22 peter
  1904. * fixed stackcheck that would be called recursively when a stack
  1905. error was found
  1906. * generic changeregsize(reg,size) for i386 register resizing
  1907. * removed some more routines from cga unit
  1908. * fixed returnvalue handling
  1909. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  1910. Revision 1.23 2002/04/15 19:12:09 carl
  1911. + target_info.size_of_pointer -> pointer_size
  1912. + some cleanup of unused types/variables
  1913. * move several constants from cpubase to their specific units
  1914. (where they are used)
  1915. + att_Reg2str -> gas_reg2str
  1916. + int_reg2str -> std_reg2str
  1917. Revision 1.22 2002/04/04 19:06:13 peter
  1918. * removed unused units
  1919. * use tlocation.size in cg.a_*loc*() routines
  1920. Revision 1.21 2002/04/02 17:11:39 peter
  1921. * tlocation,treference update
  1922. * LOC_CONSTANT added for better constant handling
  1923. * secondadd splitted in multiple routines
  1924. * location_force_reg added for loading a location to a register
  1925. of a specified size
  1926. * secondassignment parses now first the right and then the left node
  1927. (this is compatible with Kylix). This saves a lot of push/pop especially
  1928. with string operations
  1929. * adapted some routines to use the new cg methods
  1930. Revision 1.20 2002/01/24 18:25:53 peter
  1931. * implicit result variable generation for assembler routines
  1932. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  1933. }