ra386int.pas 57 KB

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