ra386int.pas 58 KB

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