ra386int.pas 56 KB

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