ra386int.pas 58 KB

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