ra386int.pas 58 KB

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