ra386int.pas 56 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038
  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 assigned(tprocsym(sym).defs^.next) then
  843. Message(asmr_w_calling_overload_func);
  844. hs:=tprocsym(sym).defs^.def.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. Message(asmr_e_building_record_offset);
  1275. expr:='';
  1276. end;
  1277. end
  1278. else
  1279. Message(asmr_e_no_var_type_specified)
  1280. end;
  1281. if expr<>'' then
  1282. begin
  1283. BuildRecordOffsetSize(expr,toffset,tsize);
  1284. inc(l,toffset);
  1285. SetSize(tsize,true);
  1286. end;
  1287. end;
  1288. if actasmtoken in [AS_PLUS,AS_MINUS] then
  1289. inc(l,BuildConstExpression);
  1290. if (opr.typ=OPR_REFERENCE) then
  1291. begin
  1292. { don't allow direct access to fields of parameters, becuase that
  1293. will generate buggy code. Allow it only for explicit typecasting }
  1294. if (not hastype) then
  1295. begin
  1296. case opr.ref.options of
  1297. ref_parafixup :
  1298. Message(asmr_e_cannot_access_field_directly_for_parameters);
  1299. ref_selffixup :
  1300. Message(asmr_e_cannot_access_object_field_directly);
  1301. end;
  1302. end;
  1303. inc(opr.ref.offset,l)
  1304. end
  1305. else
  1306. inc(opr.val,l);
  1307. end;
  1308. Begin
  1309. expr:='';
  1310. case actasmtoken of
  1311. AS_OFFSET,
  1312. AS_TYPE,
  1313. AS_INTNUM,
  1314. AS_PLUS,
  1315. AS_MINUS,
  1316. AS_NOT,
  1317. AS_LPAREN,
  1318. AS_STRING :
  1319. Begin
  1320. if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1321. Message(asmr_e_invalid_operand_type);
  1322. BuildConstant;
  1323. end;
  1324. AS_ID : { A constant expression, or a Variable ref. }
  1325. Begin
  1326. { Label or Special symbol reference? }
  1327. if actasmpattern[1] = '@' then
  1328. Begin
  1329. if actasmpattern = '@RESULT' then
  1330. Begin
  1331. InitRef;
  1332. SetupResult;
  1333. Consume(AS_ID);
  1334. end
  1335. else
  1336. if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
  1337. begin
  1338. Message(asmr_w_CODE_and_DATA_not_supported);
  1339. Consume(AS_ID);
  1340. end
  1341. else
  1342. { Local Label }
  1343. begin
  1344. CreateLocalLabel(actasmpattern,hl,false);
  1345. Consume(AS_ID);
  1346. AddLabelOperand(hl);
  1347. if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
  1348. Message(asmr_e_syntax_error);
  1349. end;
  1350. end
  1351. else
  1352. { support result for delphi modes }
  1353. if (m_objpas in aktmodeswitches) and (actasmpattern='RESULT') then
  1354. begin
  1355. InitRef;
  1356. SetUpResult;
  1357. Consume(AS_ID);
  1358. end
  1359. { probably a variable or normal expression }
  1360. { or a procedure (such as in CALL ID) }
  1361. else
  1362. Begin
  1363. { is it a constant ? }
  1364. if SearchIConstant(actasmpattern,l) then
  1365. Begin
  1366. if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1367. Message(asmr_e_invalid_operand_type);
  1368. BuildConstant;
  1369. end
  1370. else
  1371. { Check for pascal label }
  1372. if SearchLabel(actasmpattern,hl,false) then
  1373. begin
  1374. Consume(AS_ID);
  1375. AddLabelOperand(hl);
  1376. if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
  1377. Message(asmr_e_syntax_error);
  1378. end
  1379. else
  1380. { is it a normal variable ? }
  1381. Begin
  1382. InitRef;
  1383. expr:=actasmpattern;
  1384. Consume(AS_ID);
  1385. { typecasting? }
  1386. if (actasmtoken=AS_LPAREN) and
  1387. SearchType(expr) then
  1388. begin
  1389. hastype:=true;
  1390. Consume(AS_LPAREN);
  1391. tempstr:=actasmpattern;
  1392. Consume(AS_ID);
  1393. Consume(AS_RPAREN);
  1394. if SetupVar(tempstr,false) then
  1395. begin
  1396. MaybeRecordOffset;
  1397. { add a constant expression? }
  1398. if (actasmtoken=AS_PLUS) then
  1399. begin
  1400. l:=BuildConstExpression;
  1401. if opr.typ=OPR_CONSTANT then
  1402. inc(opr.val,l)
  1403. else
  1404. inc(opr.ref.offset,l);
  1405. end
  1406. end
  1407. else
  1408. Message1(sym_e_unknown_id,tempstr);
  1409. end
  1410. else
  1411. begin
  1412. if SetupVar(expr,false) then
  1413. begin
  1414. MaybeRecordOffset;
  1415. { add a constant expression? }
  1416. if (actasmtoken=AS_PLUS) then
  1417. begin
  1418. l:=BuildConstExpression;
  1419. if opr.typ=OPR_CONSTANT then
  1420. inc(opr.val,l)
  1421. else
  1422. inc(opr.ref.offset,l);
  1423. end
  1424. end
  1425. else
  1426. Begin
  1427. { not a variable, check special variables.. }
  1428. if expr = 'SELF' then
  1429. SetupSelf
  1430. else
  1431. Message1(sym_e_unknown_id,expr);
  1432. end;
  1433. end;
  1434. end;
  1435. { handle references }
  1436. if actasmtoken=AS_LBRACKET then
  1437. begin
  1438. if opr.typ=OPR_CONSTANT then
  1439. begin
  1440. l:=opr.val;
  1441. opr.typ:=OPR_REFERENCE;
  1442. Fillchar(opr.ref,sizeof(treference),0);
  1443. opr.Ref.Offset:=l;
  1444. end;
  1445. BuildReference;
  1446. MaybeRecordOffset;
  1447. end;
  1448. end;
  1449. end;
  1450. AS_REGISTER : { Register, a variable reference or a constant reference }
  1451. Begin
  1452. { save the type of register used. }
  1453. tempreg:=actasmregister;
  1454. Consume(AS_REGISTER);
  1455. if actasmtoken = AS_COLON then
  1456. Begin
  1457. Consume(AS_COLON);
  1458. InitRef;
  1459. opr.ref.segment:=tempreg;
  1460. BuildReference;
  1461. end
  1462. else
  1463. { Simple register }
  1464. begin
  1465. if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then
  1466. Message(asmr_e_invalid_operand_type);
  1467. opr.typ:=OPR_REGISTER;
  1468. opr.reg:=tempreg;
  1469. size:=reg2opsize[opr.reg];
  1470. end;
  1471. end;
  1472. AS_LBRACKET: { a variable reference, register ref. or a constant reference }
  1473. Begin
  1474. InitRef;
  1475. BuildReference;
  1476. MaybeRecordOffset;
  1477. end;
  1478. AS_SEG :
  1479. Begin
  1480. Message(asmr_e_seg_not_supported);
  1481. Consume(actasmtoken);
  1482. end;
  1483. AS_SEPARATOR,
  1484. AS_END,
  1485. AS_COMMA: ;
  1486. else
  1487. Message(asmr_e_syn_operand);
  1488. end;
  1489. if not(actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
  1490. begin
  1491. Message(asmr_e_syntax_error);
  1492. RecoverConsume(true);
  1493. end;
  1494. end;
  1495. {*****************************************************************************
  1496. T386IntelInstruction
  1497. *****************************************************************************}
  1498. type
  1499. T386IntelInstruction=class(T386Instruction)
  1500. procedure InitOperands;override;
  1501. procedure BuildOpcode;override;
  1502. end;
  1503. procedure T386IntelInstruction.InitOperands;
  1504. var
  1505. i : longint;
  1506. begin
  1507. for i:=1 to 3 do
  1508. Operands[i]:=T386IntelOperand.Create;
  1509. end;
  1510. Procedure T386IntelInstruction.BuildOpCode;
  1511. var
  1512. PrefixOp,OverrideOp: tasmop;
  1513. size : topsize;
  1514. operandnum : longint;
  1515. Begin
  1516. PrefixOp:=A_None;
  1517. OverrideOp:=A_None;
  1518. { prefix seg opcode / prefix opcode }
  1519. repeat
  1520. if is_prefix(actopcode) then
  1521. begin
  1522. PrefixOp:=ActOpcode;
  1523. opcode:=ActOpcode;
  1524. condition:=ActCondition;
  1525. opsize:=ActOpsize;
  1526. ConcatInstruction(curlist);
  1527. Consume(AS_OPCODE);
  1528. end
  1529. else
  1530. if is_override(actopcode) then
  1531. begin
  1532. OverrideOp:=ActOpcode;
  1533. opcode:=ActOpcode;
  1534. condition:=ActCondition;
  1535. opsize:=ActOpsize;
  1536. ConcatInstruction(curlist);
  1537. Consume(AS_OPCODE);
  1538. end
  1539. else
  1540. break;
  1541. { allow for newline after prefix or override }
  1542. while actasmtoken=AS_SEPARATOR do
  1543. Consume(AS_SEPARATOR);
  1544. until (actasmtoken<>AS_OPCODE);
  1545. { opcode }
  1546. if (actasmtoken <> AS_OPCODE) then
  1547. Begin
  1548. Message(asmr_e_invalid_or_missing_opcode);
  1549. RecoverConsume(false);
  1550. exit;
  1551. end;
  1552. { Fill the instr object with the current state }
  1553. Opcode:=ActOpcode;
  1554. condition:=ActCondition;
  1555. opsize:=ActOpsize;
  1556. { Valid combination of prefix/override and instruction ? }
  1557. if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then
  1558. Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern);
  1559. if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then
  1560. Message1(asmr_e_invalid_override_and_opcode,actasmpattern);
  1561. { We are reading operands, so opcode will be an AS_ID }
  1562. operandnum:=1;
  1563. Consume(AS_OPCODE);
  1564. { Zero operand opcode ? }
  1565. if actasmtoken in [AS_SEPARATOR,AS_END] then
  1566. begin
  1567. operandnum:=0;
  1568. exit;
  1569. end;
  1570. { Read Operands }
  1571. repeat
  1572. case actasmtoken of
  1573. { End of asm operands for this opcode }
  1574. AS_END,
  1575. AS_SEPARATOR :
  1576. break;
  1577. { Operand delimiter }
  1578. AS_COMMA :
  1579. Begin
  1580. if operandnum > MaxOperands then
  1581. Message(asmr_e_too_many_operands)
  1582. else
  1583. Inc(operandnum);
  1584. Consume(AS_COMMA);
  1585. end;
  1586. { Typecast, Constant Expression, Type Specifier }
  1587. AS_DWORD,
  1588. AS_BYTE,
  1589. AS_WORD,
  1590. AS_TBYTE,
  1591. AS_QWORD :
  1592. Begin
  1593. { load the size in a temp variable, so it can be set when the
  1594. operand is read }
  1595. Case actasmtoken of
  1596. AS_DWORD : size:=S_L;
  1597. AS_WORD : size:=S_W;
  1598. AS_BYTE : size:=S_B;
  1599. AS_QWORD : begin
  1600. if (opcode=A_FCOM) or
  1601. (opcode=A_FCOMP) or
  1602. (opcode=A_FDIV) or
  1603. (opcode=A_FDIVR) or
  1604. (opcode=A_FMUL) or
  1605. (opcode=A_FSUB) or
  1606. (opcode=A_FSUBR) or
  1607. (opcode=A_FLD) or
  1608. (opcode=A_FST) or
  1609. (opcode=A_FSTP) or
  1610. (opcode=A_FADD) then
  1611. size:=S_FL
  1612. else
  1613. size:=S_IQ;
  1614. end;
  1615. AS_TBYTE : size:=S_FX;
  1616. end;
  1617. Consume(actasmtoken);
  1618. if actasmtoken=AS_PTR then
  1619. begin
  1620. Consume(AS_PTR);
  1621. Operands[operandnum].InitRef;
  1622. end;
  1623. Operands[operandnum].BuildOperand;
  1624. { now set the size which was specified by the override }
  1625. Operands[operandnum].size:=size;
  1626. end;
  1627. { Type specifier }
  1628. AS_NEAR,
  1629. AS_FAR :
  1630. Begin
  1631. if actasmtoken = AS_NEAR then
  1632. begin
  1633. Message(asmr_w_near_ignored);
  1634. opsize:=S_NEAR;
  1635. end
  1636. else
  1637. begin
  1638. Message(asmr_w_far_ignored);
  1639. opsize:=S_FAR;
  1640. end;
  1641. Consume(actasmtoken);
  1642. if actasmtoken=AS_PTR then
  1643. begin
  1644. Consume(AS_PTR);
  1645. Operands[operandnum].InitRef;
  1646. end;
  1647. Operands[operandnum].BuildOperand;
  1648. end;
  1649. else
  1650. Operands[operandnum].BuildOperand;
  1651. end; { end case }
  1652. until false;
  1653. Ops:=operandnum;
  1654. end;
  1655. Procedure BuildConstant(maxvalue: longint);
  1656. var
  1657. strlength: byte;
  1658. asmsym,
  1659. expr: string;
  1660. value : longint;
  1661. Begin
  1662. strlength:=0; { assume it is a DB }
  1663. Repeat
  1664. Case actasmtoken of
  1665. AS_STRING:
  1666. Begin
  1667. if maxvalue = $ffff then
  1668. strlength:=2
  1669. else
  1670. if maxvalue = longint($ffffffff) then
  1671. strlength:=4;
  1672. { DD and DW cases }
  1673. if strlength <> 0 then
  1674. Begin
  1675. if Not PadZero(actasmpattern,strlength) then
  1676. Message(scan_f_string_exceeds_line);
  1677. end;
  1678. expr:=actasmpattern;
  1679. Consume(AS_STRING);
  1680. Case actasmtoken of
  1681. AS_COMMA:
  1682. Consume(AS_COMMA);
  1683. AS_END,
  1684. AS_SEPARATOR: ;
  1685. else
  1686. Message(asmr_e_invalid_string_expression);
  1687. end;
  1688. ConcatString(curlist,expr);
  1689. end;
  1690. AS_PLUS,
  1691. AS_MINUS,
  1692. AS_LPAREN,
  1693. AS_NOT,
  1694. AS_INTNUM,
  1695. AS_ID :
  1696. Begin
  1697. BuildConstSymbolExpression(false,false,value,asmsym);
  1698. if asmsym<>'' then
  1699. begin
  1700. if maxvalue<>longint($ffffffff) then
  1701. Message1(asmr_w_const32bit_for_address,asmsym);
  1702. ConcatConstSymbol(curlist,asmsym,value)
  1703. end
  1704. else
  1705. ConcatConstant(curlist,value,maxvalue);
  1706. end;
  1707. AS_COMMA:
  1708. Consume(AS_COMMA);
  1709. AS_END,
  1710. AS_SEPARATOR:
  1711. break;
  1712. else
  1713. begin
  1714. Message(asmr_e_syn_constant);
  1715. RecoverConsume(false);
  1716. end
  1717. end;
  1718. Until false;
  1719. end;
  1720. Function Assemble: tnode;
  1721. Var
  1722. hl : tasmlabel;
  1723. instr : T386IntelInstruction;
  1724. Begin
  1725. Message1(asmr_d_start_reading,'intel');
  1726. inexpression:=FALSE;
  1727. firsttoken:=TRUE;
  1728. { sets up all opcode and register tables in uppercase }
  1729. if not _asmsorted then
  1730. Begin
  1731. SetupTables;
  1732. _asmsorted:=TRUE;
  1733. end;
  1734. curlist:=TAAsmoutput.Create;
  1735. { setup label linked list }
  1736. LocalLabelList:=TLocalLabelList.Create;
  1737. { start tokenizer }
  1738. c:=current_scanner.asmgetchar;
  1739. gettoken;
  1740. { main loop }
  1741. repeat
  1742. case actasmtoken of
  1743. AS_LLABEL:
  1744. Begin
  1745. if CreateLocalLabel(actasmpattern,hl,true) then
  1746. ConcatLabel(curlist,hl);
  1747. Consume(AS_LLABEL);
  1748. end;
  1749. AS_LABEL:
  1750. Begin
  1751. if SearchLabel(upper(actasmpattern),hl,true) then
  1752. ConcatLabel(curlist,hl)
  1753. else
  1754. Message1(asmr_e_unknown_label_identifier,actasmpattern);
  1755. Consume(AS_LABEL);
  1756. end;
  1757. AS_DW :
  1758. Begin
  1759. inexpression:=true;
  1760. Consume(AS_DW);
  1761. BuildConstant($ffff);
  1762. inexpression:=false;
  1763. end;
  1764. AS_DB :
  1765. Begin
  1766. inexpression:=true;
  1767. Consume(AS_DB);
  1768. BuildConstant($ff);
  1769. inexpression:=false;
  1770. end;
  1771. AS_DD :
  1772. Begin
  1773. inexpression:=true;
  1774. Consume(AS_DD);
  1775. BuildConstant(longint($ffffffff));
  1776. inexpression:=false;
  1777. end;
  1778. AS_OPCODE :
  1779. Begin
  1780. instr:=T386IntelInstruction.Create;
  1781. instr.BuildOpcode;
  1782. { We need AT&T style operands }
  1783. instr.Swapoperands;
  1784. { Must be done with args in ATT order }
  1785. instr.CheckNonCommutativeOpcodes;
  1786. instr.AddReferenceSizes;
  1787. instr.SetInstructionOpsize;
  1788. instr.CheckOperandSizes;
  1789. instr.ConcatInstruction(curlist);
  1790. instr.Free;
  1791. end;
  1792. AS_SEPARATOR :
  1793. Begin
  1794. Consume(AS_SEPARATOR);
  1795. end;
  1796. AS_END :
  1797. break; { end assembly block }
  1798. else
  1799. Begin
  1800. Message(asmr_e_syntax_error);
  1801. RecoverConsume(false);
  1802. end;
  1803. end; { end case }
  1804. until false;
  1805. { Check LocalLabelList }
  1806. LocalLabelList.CheckEmitted;
  1807. LocalLabelList.Free;
  1808. { Return the list in an asmnode }
  1809. assemble:=casmnode.create(curlist);
  1810. Message1(asmr_d_finish_reading,'intel');
  1811. end;
  1812. {*****************************************************************************
  1813. Initialize
  1814. *****************************************************************************}
  1815. const
  1816. asmmode_i386_intel_info : tasmmodeinfo =
  1817. (
  1818. id : asmmode_i386_intel;
  1819. idtxt : 'INTEL'
  1820. );
  1821. initialization
  1822. RegisterAsmMode(asmmode_i386_intel_info);
  1823. finalization
  1824. if assigned(iasmops) then
  1825. iasmops.Free;
  1826. if assigned(iasmregs) then
  1827. dispose(iasmregs);
  1828. end.
  1829. {
  1830. $Log$
  1831. Revision 1.32 2002-08-13 18:01:52 carl
  1832. * rename swatoperands to swapoperands
  1833. + m68k first compilable version (still needs a lot of testing):
  1834. assembler generator, system information , inline
  1835. assembler reader.
  1836. Revision 1.31 2002/08/11 14:32:31 peter
  1837. * renamed current_library to objectlibrary
  1838. Revision 1.30 2002/08/11 13:24:17 peter
  1839. * saving of asmsymbols in ppu supported
  1840. * asmsymbollist global is removed and moved into a new class
  1841. tasmlibrarydata that will hold the info of a .a file which
  1842. corresponds with a single module. Added librarydata to tmodule
  1843. to keep the library info stored for the module. In the future the
  1844. objectfiles will also be stored to the tasmlibrarydata class
  1845. * all getlabel/newasmsymbol and friends are moved to the new class
  1846. Revision 1.29 2002/07/01 18:46:34 peter
  1847. * internal linker
  1848. * reorganized aasm layer
  1849. Revision 1.28 2002/05/18 13:34:26 peter
  1850. * readded missing revisions
  1851. Revision 1.27 2002/05/16 19:46:52 carl
  1852. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1853. + try to fix temp allocation (still in ifdef)
  1854. + generic constructor calls
  1855. + start of tassembler / tmodulebase class cleanup
  1856. Revision 1.25 2002/04/20 21:37:07 carl
  1857. + generic FPC_CHECKPOINTER
  1858. + first parameter offset in stack now portable
  1859. * rename some constants
  1860. + move some cpu stuff to other units
  1861. - remove unused constents
  1862. * fix stacksize for some targets
  1863. * fix generic size problems which depend now on EXTEND_SIZE constant
  1864. * removing frame pointer in routines is only available for : i386,m68k and vis targets
  1865. Revision 1.24 2002/04/15 19:44:22 peter
  1866. * fixed stackcheck that would be called recursively when a stack
  1867. error was found
  1868. * generic changeregsize(reg,size) for i386 register resizing
  1869. * removed some more routines from cga unit
  1870. * fixed returnvalue handling
  1871. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  1872. Revision 1.23 2002/04/15 19:12:09 carl
  1873. + target_info.size_of_pointer -> pointer_size
  1874. + some cleanup of unused types/variables
  1875. * move several constants from cpubase to their specific units
  1876. (where they are used)
  1877. + att_Reg2str -> gas_reg2str
  1878. + int_reg2str -> std_reg2str
  1879. Revision 1.22 2002/04/04 19:06:13 peter
  1880. * removed unused units
  1881. * use tlocation.size in cg.a_*loc*() routines
  1882. Revision 1.21 2002/04/02 17:11:39 peter
  1883. * tlocation,treference update
  1884. * LOC_CONSTANT added for better constant handling
  1885. * secondadd splitted in multiple routines
  1886. * location_force_reg added for loading a location to a register
  1887. of a specified size
  1888. * secondassignment parses now first the right and then the left node
  1889. (this is compatible with Kylix). This saves a lot of push/pop especially
  1890. with string operations
  1891. * adapted some routines to use the new cg methods
  1892. Revision 1.20 2002/01/24 18:25:53 peter
  1893. * implicit result variable generation for assembler routines
  1894. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  1895. }