ra386int.pas 58 KB

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