ra386int.pas 58 KB

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