ra386int.pas 58 KB

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