ra386int.pas 58 KB

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