raz80asm.pas 88 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529
  1. {
  2. Copyright (c) 1998-2008 by Carl Eric Codere and Peter Vreman
  3. Does the parsing for the Z80 styled inline assembler.
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. Unit raz80asm;
  18. {$i fpcdefs.inc}
  19. Interface
  20. uses
  21. cclasses,
  22. globtype,
  23. rasm,raz80,
  24. aasmbase,cpubase;
  25. type
  26. tasmtoken = (
  27. AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
  28. AS_REALNUM,AS_COMMA,AS_LPAREN,
  29. AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,
  30. AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_CONDITION,AS_SLASH,AS_DOLLAR,
  31. AS_HASH,AS_LSBRACKET,AS_RSBRACKET,AS_LBRACKET,AS_RBRACKET,
  32. AS_EQUAL,
  33. {------------------ Assembler directives --------------------}
  34. AS_DEFB,AS_DEFW,AS_AREA,AS_END,
  35. {------------------ Assembler Operators --------------------}
  36. AS_TYPE,AS_SIZEOF,AS_VMTOFFSET,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT,
  37. AS_RELTYPE, // common token for relocation types
  38. {------------------ Target-specific directive ---------------}
  39. AS_TARGET_DIRECTIVE
  40. );
  41. tasmkeyword = string[10];
  42. const
  43. { These tokens should be modified accordingly to the modifications }
  44. { in the different enumerations. }
  45. firstdirective = AS_DEFB;
  46. lastdirective = AS_END;
  47. token2str : array[tasmtoken] of tasmkeyword=(
  48. '','Label','LLabel','string','integer',
  49. 'float',',','(',
  50. ')',':','.','+','-','*',
  51. ';','identifier','register','opcode','condition','/','$',
  52. '#','{','}','[',']',
  53. '=',
  54. 'defb','defw','area','END',
  55. 'TYPE','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','reltype',
  56. 'directive');
  57. type
  58. { input flags for BuildConstSymbolExpression }
  59. tconstsymbolexpressioninputflag = (
  60. cseif_needofs,
  61. cseif_isref,
  62. cseif_startingminus,
  63. { allows using full reference-like syntax for constsymbol expressions,
  64. for example:
  65. Rec.Str[5] -> Rec.Str+5 }
  66. cseif_referencelike
  67. );
  68. tconstsymbolexpressioninputflags = set of tconstsymbolexpressioninputflag;
  69. { output flags for BuildConstSymbolExpression }
  70. tconstsymbolexpressionoutputflag = (
  71. cseof_isseg,
  72. cseof_is_farproc_entry,
  73. cseof_hasofs
  74. );
  75. tconstsymbolexpressionoutputflags = set of tconstsymbolexpressionoutputflag;
  76. { tz80reader }
  77. tz80reader = class(tasmreader)
  78. actasmcond : TAsmCond;
  79. actasmpattern_origcase : string;
  80. actasmtoken : tasmtoken;
  81. prevasmtoken : tasmtoken;
  82. inexpression : boolean;
  83. procedure SetupTables;
  84. procedure GetToken;
  85. function consume(t : tasmtoken):boolean;
  86. procedure RecoverConsume(allowcomma:boolean);
  87. procedure AddReferences(dest,src : tz80operand);
  88. function is_locallabel(const s:string):boolean;
  89. function is_asmopcode(const s: string):boolean;
  90. Function is_asmdirective(const s: string):boolean;
  91. function is_register(const s:string):boolean;
  92. function is_condition(const s:string):boolean;
  93. function is_targetdirective(const s: string):boolean;
  94. procedure BuildRecordOffsetSize(const expr: string;out offset:tcgint;out size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean);
  95. procedure BuildConstSymbolExpression(in_flags: tconstsymbolexpressioninputflags;out value:tcgint;out asmsym:string;out asmsymtyp:TAsmsymtype;out size:tcgint;out out_flags:tconstsymbolexpressionoutputflags);
  96. function BuildConstExpression:longint;
  97. function BuildRefConstExpression(out size:tcgint;startingminus:boolean=false):longint;
  98. procedure BuildConstantOperand(oper: tz80operand);
  99. procedure BuildReference(oper : tz80operand);
  100. procedure BuildOperand(oper: tz80operand;istypecast:boolean);
  101. procedure BuildOpCode(instr:TZ80Instruction);
  102. procedure BuildConstant(constsize: byte);
  103. procedure handleopcode;
  104. procedure ConvertCalljmp(instr : tz80instruction);
  105. function Assemble: tlinkedlist;override;
  106. end;
  107. Implementation
  108. uses
  109. { helpers }
  110. cutils,
  111. { global }
  112. globals,verbose,
  113. systems,
  114. { aasm }
  115. cpuinfo,aasmtai,aasmdata,aasmcpu,
  116. { symtable }
  117. symconst,symbase,symtype,symsym,symtable,symdef,symutil,
  118. { parser }
  119. scanner,pbase,
  120. procinfo,
  121. rabase,rautils,
  122. cgbase,cgutils,cgobj
  123. ;
  124. {*****************************************************************************
  125. tz80reader
  126. *****************************************************************************}
  127. procedure tz80reader.SetupTables;
  128. var
  129. i: TAsmOp;
  130. begin
  131. iasmops:=TFPHashList.create;
  132. for i:=firstop to lastop do
  133. iasmops.Add(upper(std_op2str[i]),Pointer(PtrInt(i)));
  134. end;
  135. procedure tz80reader.GetToken;
  136. var
  137. len: Integer;
  138. srsym : tsym;
  139. srsymtable : TSymtable;
  140. can_be_condition : Boolean;
  141. begin
  142. c:=scanner.c;
  143. { certain instructions can have a condition, as an operand. We need to set this flag,
  144. because 'C' can be either a register, or a condition, depending on the context }
  145. can_be_condition:=(actasmtoken=AS_OPCODE) and (actopcode in [A_JP,A_JR,A_JRJP,A_CALL,A_RET]);
  146. { save old token and reset new token }
  147. prevasmtoken:=actasmtoken;
  148. actasmtoken:=AS_NONE;
  149. { reset }
  150. actasmpattern:='';
  151. { while space and tab , continue scan... }
  152. while c in [' ',#9] do
  153. c:=current_scanner.asmgetchar;
  154. { get token pos }
  155. if not (c in [#10,#13,'{',';','/','(']) then
  156. current_scanner.gettokenpos;
  157. { Local Label, Label, Directive, Prefix or Opcode }
  158. if firsttoken and not(c in [#10,#13,'{',';','/','(']) then
  159. begin
  160. firsttoken:=FALSE;
  161. len:=0;
  162. { directive }
  163. if c = '.' then
  164. begin
  165. inc(len);
  166. actasmpattern[len]:=c;
  167. { Let us point to the next character }
  168. c:=current_scanner.asmgetchar;
  169. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  170. begin
  171. inc(len);
  172. actasmpattern[len]:=c;
  173. c:=current_scanner.asmgetchar;
  174. end;
  175. actasmpattern[0]:=chr(len);
  176. { must be a directive }
  177. if is_asmdirective(actasmpattern) then
  178. exit;
  179. if is_targetdirective(actasmpattern) then
  180. begin
  181. actasmtoken:=AS_TARGET_DIRECTIVE;
  182. exit;
  183. end;
  184. Message1(asmr_e_not_directive_or_local_symbol,actasmpattern);
  185. end;
  186. { only opcodes, global and local labels are allowed now. }
  187. while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
  188. begin
  189. inc(len);
  190. actasmpattern[len]:=c;
  191. c:=current_scanner.asmgetchar;
  192. end;
  193. actasmpattern[0]:=chr(len);
  194. actasmpattern_origcase:=actasmpattern;
  195. { Label ? }
  196. if c = ':' then
  197. begin
  198. { Local label ? }
  199. if is_locallabel(actasmpattern) then
  200. actasmtoken:=AS_LLABEL
  201. else
  202. actasmtoken:=AS_LABEL;
  203. { let us point to the next character }
  204. c:=current_scanner.asmgetchar;
  205. firsttoken:=true;
  206. exit;
  207. end;
  208. { Directive ? }
  209. if is_asmdirective(actasmpattern) then
  210. exit;
  211. { Opcode ? }
  212. if is_asmopcode(upper(actasmpattern)) then
  213. begin
  214. uppervar(actasmpattern);
  215. exit;
  216. end;
  217. { End of assemblerblock ? }
  218. if upper(actasmpattern) = 'END' then
  219. begin
  220. actasmtoken:=AS_END;
  221. exit;
  222. end;
  223. message1(asmr_e_unknown_opcode,actasmpattern);
  224. actasmtoken:=AS_NONE;
  225. end
  226. else { else firsttoken }
  227. { Here we must handle all possible cases }
  228. begin
  229. case c of
  230. '.' : { possiblities : - local label reference , such as in jmp @local1 }
  231. { - field of object/record }
  232. { - directive. }
  233. begin
  234. if (prevasmtoken in [AS_ID,AS_RPAREN]) then
  235. begin
  236. c:=current_scanner.asmgetchar;
  237. actasmtoken:=AS_DOT;
  238. exit;
  239. end;
  240. actasmpattern:=c;
  241. c:=current_scanner.asmgetchar;
  242. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  243. begin
  244. actasmpattern:=actasmpattern + c;
  245. c:=current_scanner.asmgetchar;
  246. end;
  247. if is_asmdirective(actasmpattern) then
  248. exit;
  249. if is_targetdirective(actasmpattern) then
  250. begin
  251. actasmtoken:=AS_TARGET_DIRECTIVE;
  252. exit;
  253. end;
  254. { local label references and directives }
  255. { are case sensitive }
  256. actasmtoken:=AS_ID;
  257. exit;
  258. end;
  259. { identifier, register, prefix or directive }
  260. '_','A'..'Z','a'..'z':
  261. begin
  262. len:=0;
  263. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  264. begin
  265. inc(len);
  266. actasmpattern[len]:=c;
  267. c:=current_scanner.asmgetchar;
  268. end;
  269. actasmpattern[0]:=chr(len);
  270. actasmpattern_origcase:=actasmpattern;
  271. uppervar(actasmpattern);
  272. { check for end which is a reserved word unlike the opcodes }
  273. if actasmpattern = 'END' then
  274. begin
  275. actasmtoken:=AS_END;
  276. exit;
  277. end;
  278. if actasmpattern = 'TYPE' then
  279. begin
  280. actasmtoken:=AS_TYPE;
  281. exit;
  282. end;
  283. if actasmpattern = 'SIZEOF' then
  284. begin
  285. actasmtoken:=AS_SIZEOF;
  286. exit;
  287. end;
  288. if actasmpattern = 'VMTOFFSET' then
  289. begin
  290. actasmtoken:=AS_VMTOFFSET;
  291. exit;
  292. end;
  293. if can_be_condition and is_condition(actasmpattern) then
  294. begin
  295. actasmtoken:=AS_CONDITION;
  296. exit;
  297. end;
  298. if is_register(actasmpattern) then
  299. begin
  300. actasmtoken:=AS_REGISTER;
  301. { is it an alternate register? }
  302. if (c='''') and is_register(actasmpattern+'''') then
  303. begin
  304. actasmpattern:=actasmpattern+c;
  305. c:=current_scanner.asmgetchar;
  306. end;
  307. exit;
  308. end;
  309. { if next is a '.' and this is a unitsym then we also need to
  310. parse the identifier }
  311. if (c='.') then
  312. begin
  313. searchsym(actasmpattern,srsym,srsymtable);
  314. if assigned(srsym) and
  315. (srsym.typ=unitsym) and
  316. (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
  317. srsym.owner.iscurrentunit then
  318. begin
  319. actasmpattern:=actasmpattern+c;
  320. c:=current_scanner.asmgetchar;
  321. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  322. begin
  323. actasmpattern:=actasmpattern + upcase(c);
  324. c:=current_scanner.asmgetchar;
  325. end;
  326. end;
  327. end;
  328. actasmtoken:=AS_ID;
  329. exit;
  330. end;
  331. //'%' : { register or modulo }
  332. // handlepercent;
  333. '1'..'9': { integer number }
  334. begin
  335. len:=0;
  336. while c in ['0'..'9'] do
  337. Begin
  338. inc(len);
  339. actasmpattern[len]:=c;
  340. c:=current_scanner.asmgetchar;
  341. end;
  342. actasmpattern[0]:=chr(len);
  343. actasmpattern:=tostr(ParseVal(actasmpattern,10));
  344. actasmtoken:=AS_INTNUM;
  345. exit;
  346. end;
  347. '0' : { octal,hexa,real or binary number. }
  348. begin
  349. actasmpattern:=c;
  350. c:=current_scanner.asmgetchar;
  351. case upcase(c) of
  352. 'B': { binary }
  353. Begin
  354. c:=current_scanner.asmgetchar;
  355. while c in ['0','1'] do
  356. Begin
  357. actasmpattern:=actasmpattern + c;
  358. c:=current_scanner.asmgetchar;
  359. end;
  360. actasmpattern:=tostr(ParseVal(actasmpattern,2));
  361. actasmtoken:=AS_INTNUM;
  362. exit;
  363. end;
  364. 'D': { real }
  365. Begin
  366. c:=current_scanner.asmgetchar;
  367. { get ridd of the 0d }
  368. if (c in ['+','-']) then
  369. begin
  370. actasmpattern:=c;
  371. c:=current_scanner.asmgetchar;
  372. end
  373. else
  374. actasmpattern:='';
  375. while c in ['0'..'9'] do
  376. Begin
  377. actasmpattern:=actasmpattern + c;
  378. c:=current_scanner.asmgetchar;
  379. end;
  380. if c='.' then
  381. begin
  382. actasmpattern:=actasmpattern + c;
  383. c:=current_scanner.asmgetchar;
  384. while c in ['0'..'9'] do
  385. Begin
  386. actasmpattern:=actasmpattern + c;
  387. c:=current_scanner.asmgetchar;
  388. end;
  389. if upcase(c) = 'E' then
  390. begin
  391. actasmpattern:=actasmpattern + c;
  392. c:=current_scanner.asmgetchar;
  393. if (c in ['+','-']) then
  394. begin
  395. actasmpattern:=actasmpattern + c;
  396. c:=current_scanner.asmgetchar;
  397. end;
  398. while c in ['0'..'9'] do
  399. Begin
  400. actasmpattern:=actasmpattern + c;
  401. c:=current_scanner.asmgetchar;
  402. end;
  403. end;
  404. actasmtoken:=AS_REALNUM;
  405. exit;
  406. end
  407. else
  408. begin
  409. Message1(asmr_e_invalid_float_const,actasmpattern+c);
  410. actasmtoken:=AS_NONE;
  411. end;
  412. end;
  413. 'X': { hexadecimal }
  414. Begin
  415. c:=current_scanner.asmgetchar;
  416. while c in ['0'..'9','a'..'f','A'..'F'] do
  417. Begin
  418. actasmpattern:=actasmpattern + c;
  419. c:=current_scanner.asmgetchar;
  420. end;
  421. actasmpattern:=tostr(ParseVal(actasmpattern,16));
  422. actasmtoken:=AS_INTNUM;
  423. exit;
  424. end;
  425. '1'..'7': { octal }
  426. begin
  427. actasmpattern:=actasmpattern + c;
  428. while c in ['0'..'7'] do
  429. Begin
  430. actasmpattern:=actasmpattern + c;
  431. c:=current_scanner.asmgetchar;
  432. end;
  433. actasmpattern:=tostr(ParseVal(actasmpattern,8));
  434. actasmtoken:=AS_INTNUM;
  435. exit;
  436. end;
  437. else { octal number zero value...}
  438. Begin
  439. actasmpattern:=tostr(ParseVal(actasmpattern,8));
  440. actasmtoken:=AS_INTNUM;
  441. exit;
  442. end;
  443. end; { end case }
  444. end;
  445. '&' :
  446. begin
  447. c:=current_scanner.asmgetchar;
  448. actasmtoken:=AS_AND;
  449. end;
  450. '''' : { char }
  451. begin
  452. actasmpattern:='';
  453. repeat
  454. c:=current_scanner.asmgetchar;
  455. case c of
  456. '\' :
  457. begin
  458. { copy also the next char so \" is parsed correctly }
  459. actasmpattern:=actasmpattern+c;
  460. c:=current_scanner.asmgetchar;
  461. actasmpattern:=actasmpattern+c;
  462. end;
  463. '''' :
  464. begin
  465. c:=current_scanner.asmgetchar;
  466. break;
  467. end;
  468. #10,#13:
  469. Message(scan_f_string_exceeds_line);
  470. else
  471. actasmpattern:=actasmpattern+c;
  472. end;
  473. until false;
  474. actasmpattern:=EscapeToPascal(actasmpattern);
  475. actasmtoken:=AS_STRING;
  476. exit;
  477. end;
  478. '"' : { string }
  479. begin
  480. actasmpattern:='';
  481. repeat
  482. c:=current_scanner.asmgetchar;
  483. case c of
  484. '\' :
  485. begin
  486. { copy also the next char so \" is parsed correctly }
  487. actasmpattern:=actasmpattern+c;
  488. c:=current_scanner.asmgetchar;
  489. actasmpattern:=actasmpattern+c;
  490. end;
  491. '"' :
  492. begin
  493. c:=current_scanner.asmgetchar;
  494. break;
  495. end;
  496. #10,#13:
  497. Message(scan_f_string_exceeds_line);
  498. else
  499. actasmpattern:=actasmpattern+c;
  500. end;
  501. until false;
  502. actasmpattern:=EscapeToPascal(actasmpattern);
  503. actasmtoken:=AS_STRING;
  504. exit;
  505. end;
  506. //'$' :
  507. // begin
  508. // handledollar;
  509. // exit;
  510. // end;
  511. '#' :
  512. begin
  513. actasmtoken:=AS_HASH;
  514. c:=current_scanner.asmgetchar;
  515. exit;
  516. end;
  517. '[' :
  518. begin
  519. actasmtoken:=AS_LBRACKET;
  520. c:=current_scanner.asmgetchar;
  521. exit;
  522. end;
  523. ']' :
  524. begin
  525. actasmtoken:=AS_RBRACKET;
  526. c:=current_scanner.asmgetchar;
  527. exit;
  528. end;
  529. '{' :
  530. begin
  531. {$ifdef arm}
  532. // the arm assembler uses { ... } for register sets
  533. // but compiler directives {$... } are still allowed
  534. c:=current_scanner.asmgetchar;
  535. if c<>'$' then
  536. actasmtoken:=AS_LSBRACKET
  537. else
  538. begin
  539. current_scanner.skipcomment(false);
  540. GetToken;
  541. end;
  542. {$else arm}
  543. current_scanner.skipcomment(true);
  544. GetToken;
  545. {$endif arm}
  546. exit;
  547. end;
  548. {$ifdef arm}
  549. '}' :
  550. begin
  551. actasmtoken:=AS_RSBRACKET;
  552. c:=current_scanner.asmgetchar;
  553. exit;
  554. end;
  555. '=' :
  556. begin
  557. actasmtoken:=AS_EQUAL;
  558. c:=current_scanner.asmgetchar;
  559. exit;
  560. end;
  561. {$endif arm}
  562. ',' :
  563. begin
  564. actasmtoken:=AS_COMMA;
  565. c:=current_scanner.asmgetchar;
  566. exit;
  567. end;
  568. '<' :
  569. begin
  570. actasmtoken:=AS_SHL;
  571. c:=current_scanner.asmgetchar;
  572. if c = '<' then
  573. c:=current_scanner.asmgetchar;
  574. exit;
  575. end;
  576. '>' :
  577. begin
  578. actasmtoken:=AS_SHL;
  579. c:=current_scanner.asmgetchar;
  580. if c = '>' then
  581. c:=current_scanner.asmgetchar;
  582. exit;
  583. end;
  584. '|' :
  585. begin
  586. actasmtoken:=AS_OR;
  587. c:=current_scanner.asmgetchar;
  588. exit;
  589. end;
  590. '^' :
  591. begin
  592. actasmtoken:=AS_XOR;
  593. c:=current_scanner.asmgetchar;
  594. exit;
  595. end;
  596. '(' :
  597. begin
  598. c:=current_scanner.asmgetchar;
  599. if c='*' then
  600. begin
  601. current_scanner.skipoldtpcomment(true);
  602. GetToken;
  603. end
  604. else
  605. actasmtoken:=AS_LPAREN;
  606. exit;
  607. end;
  608. ')' :
  609. begin
  610. actasmtoken:=AS_RPAREN;
  611. c:=current_scanner.asmgetchar;
  612. exit;
  613. end;
  614. ':' :
  615. begin
  616. actasmtoken:=AS_COLON;
  617. c:=current_scanner.asmgetchar;
  618. exit;
  619. end;
  620. '+' :
  621. begin
  622. actasmtoken:=AS_PLUS;
  623. c:=current_scanner.asmgetchar;
  624. exit;
  625. end;
  626. '-' :
  627. begin
  628. actasmtoken:=AS_MINUS;
  629. c:=current_scanner.asmgetchar;
  630. exit;
  631. end;
  632. '*' :
  633. begin
  634. actasmtoken:=AS_STAR;
  635. c:=current_scanner.asmgetchar;
  636. exit;
  637. end;
  638. '/' :
  639. begin
  640. c:=current_scanner.asmgetchar;
  641. if c='/' then
  642. begin
  643. current_scanner.skipdelphicomment;
  644. GetToken;
  645. end
  646. else
  647. actasmtoken:=AS_SLASH;
  648. exit;
  649. end;
  650. '!', '~' :
  651. begin
  652. actasmtoken:=AS_NOT;
  653. c:=current_scanner.asmgetchar;
  654. exit;
  655. end;
  656. '@' : { possiblities : - local label reference , such as in jmp @local1 }
  657. { - @Result, @Code or @Data special variables. }
  658. begin
  659. actasmpattern:=c;
  660. c:=current_scanner.asmgetchar;
  661. while c in ['A'..'Z','a'..'z','0'..'9','_','@','$','&','?'] do
  662. begin
  663. actasmpattern:=actasmpattern + c;
  664. c:=current_scanner.asmgetchar;
  665. end;
  666. actasmpattern_origcase:=actasmpattern;
  667. uppervar(actasmpattern);
  668. actasmtoken:=AS_ID;
  669. exit;
  670. end;
  671. #13,#10:
  672. begin
  673. current_scanner.linebreak;
  674. c:=current_scanner.asmgetchar;
  675. firsttoken:=TRUE;
  676. actasmtoken:=AS_SEPARATOR;
  677. exit;
  678. end;
  679. ';' :
  680. begin
  681. c:=current_scanner.asmgetchar;
  682. firsttoken:=TRUE;
  683. actasmtoken:=AS_SEPARATOR;
  684. exit;
  685. end;
  686. else
  687. current_scanner.illegal_char(c);
  688. end;
  689. end;
  690. end;
  691. function tz80reader.consume(t: tasmtoken): boolean;
  692. begin
  693. Consume:=true;
  694. if t<>actasmtoken then
  695. begin
  696. Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
  697. Consume:=false;
  698. end;
  699. repeat
  700. gettoken;
  701. until actasmtoken<>AS_NONE;
  702. end;
  703. procedure tz80reader.RecoverConsume(allowcomma: boolean);
  704. begin
  705. while not (actasmtoken in [AS_SEPARATOR,AS_END]) do
  706. begin
  707. if allowcomma and (actasmtoken=AS_COMMA) then
  708. break;
  709. Consume(actasmtoken);
  710. end;
  711. end;
  712. procedure tz80reader.AddReferences(dest, src: tz80operand);
  713. procedure AddRegister(reg:tregister;scalefactor:byte);
  714. begin
  715. if reg=NR_NO then
  716. exit;
  717. if (dest.opr.ref.base=NR_NO) and (scalefactor=1) then
  718. begin
  719. dest.opr.ref.base:=reg;
  720. exit;
  721. end;
  722. if dest.opr.ref.index=NR_NO then
  723. begin
  724. dest.opr.ref.index:=reg;
  725. dest.opr.ref.scalefactor:=scalefactor;
  726. exit;
  727. end;
  728. if dest.opr.ref.index=reg then
  729. begin
  730. Inc(dest.opr.ref.scalefactor,scalefactor);
  731. exit;
  732. end;
  733. Message(asmr_e_multiple_index);
  734. end;
  735. var
  736. tmplocal: TOprRec;
  737. segreg: TRegister;
  738. begin
  739. case dest.opr.typ of
  740. OPR_REFERENCE:
  741. begin
  742. case src.opr.typ of
  743. OPR_REFERENCE:
  744. begin
  745. AddRegister(src.opr.ref.base,1);
  746. AddRegister(src.opr.ref.index,src.opr.ref.scalefactor);
  747. Inc(dest.opr.ref.offset,src.opr.ref.offset);
  748. Inc(dest.opr.constoffset,src.opr.constoffset);
  749. dest.haslabelref:=dest.haslabelref or src.haslabelref;
  750. dest.hasproc:=dest.hasproc or src.hasproc;
  751. dest.hasvar:=dest.hasvar or src.hasvar;
  752. if assigned(src.opr.ref.symbol) then
  753. begin
  754. if assigned(dest.opr.ref.symbol) then
  755. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  756. dest.opr.ref.symbol:=src.opr.ref.symbol;
  757. end;
  758. if assigned(src.opr.ref.relsymbol) then
  759. begin
  760. if assigned(dest.opr.ref.relsymbol) then
  761. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  762. dest.opr.ref.relsymbol:=src.opr.ref.relsymbol;
  763. end;
  764. if dest.opr.ref.refaddr=addr_no then
  765. dest.opr.ref.refaddr:=src.opr.ref.refaddr;
  766. end;
  767. OPR_LOCAL:
  768. begin
  769. tmplocal:=src.opr;
  770. if dest.opr.ref.base<>NR_NO then
  771. begin
  772. if tmplocal.localindexreg=NR_NO then
  773. begin
  774. tmplocal.localindexreg:=dest.opr.ref.base;
  775. tmplocal.localscale:=0;
  776. end
  777. else if tmplocal.localindexreg=dest.opr.ref.base then
  778. tmplocal.localscale:=Min(tmplocal.localscale,1)+1
  779. else
  780. Message(asmr_e_multiple_index);
  781. end;
  782. if dest.opr.ref.index<>NR_NO then
  783. begin
  784. if tmplocal.localindexreg=NR_NO then
  785. begin
  786. tmplocal.localindexreg:=dest.opr.ref.index;
  787. tmplocal.localscale:=dest.opr.ref.scalefactor;
  788. end
  789. else if tmplocal.localindexreg=dest.opr.ref.index then
  790. tmplocal.localscale:=Min(tmplocal.localscale,1)+Min(dest.opr.ref.scalefactor,1)
  791. else
  792. Message(asmr_e_multiple_index);
  793. end;
  794. Inc(tmplocal.localconstoffset,dest.opr.constoffset);
  795. Inc(tmplocal.localsymofs,dest.opr.ref.offset);
  796. dest.opr:=tmplocal;
  797. end;
  798. else
  799. internalerror(2018030701);
  800. end;
  801. end;
  802. OPR_LOCAL:
  803. begin
  804. case src.opr.typ of
  805. OPR_REFERENCE:
  806. begin
  807. if src.opr.ref.base<>NR_NO then
  808. begin
  809. if dest.opr.localindexreg=NR_NO then
  810. begin
  811. dest.opr.localindexreg:=src.opr.ref.base;
  812. dest.opr.localscale:=0;
  813. end
  814. else if dest.opr.localindexreg=src.opr.ref.base then
  815. dest.opr.localscale:=Min(dest.opr.localscale,1)+1
  816. else
  817. Message(asmr_e_multiple_index);
  818. end;
  819. if src.opr.ref.index<>NR_NO then
  820. begin
  821. if dest.opr.localindexreg=NR_NO then
  822. begin
  823. dest.opr.localindexreg:=src.opr.ref.index;
  824. dest.opr.localscale:=src.opr.ref.scalefactor;
  825. end
  826. else if dest.opr.localindexreg=src.opr.ref.index then
  827. dest.opr.localscale:=Min(dest.opr.localscale,1)+Min(src.opr.ref.scalefactor,1)
  828. else
  829. Message(asmr_e_multiple_index);
  830. end;
  831. Inc(dest.opr.localconstoffset,src.opr.constoffset);
  832. Inc(dest.opr.localsymofs,src.opr.ref.offset);
  833. end;
  834. OPR_LOCAL:
  835. Message(asmr_e_no_local_or_para_allowed);
  836. else
  837. internalerror(2018030703);
  838. end;
  839. end;
  840. else
  841. internalerror(2018030702);
  842. end;
  843. end;
  844. function tz80reader.is_locallabel(const s: string): boolean;
  845. begin
  846. is_locallabel:=(length(s)>1) and (s[1]='@');
  847. end;
  848. function tz80reader.is_asmopcode(const s: string):boolean;
  849. begin
  850. actcondition:=C_None;
  851. actopcode:=tasmop(PtrUInt(iasmops.Find(s)));
  852. if actopcode<>A_NONE then
  853. begin
  854. actasmtoken:=AS_OPCODE;
  855. is_asmopcode:=true;
  856. end
  857. else
  858. is_asmopcode:=false;
  859. end;
  860. function tz80reader.is_asmdirective(const s: string): boolean;
  861. var
  862. i : tasmtoken;
  863. hs : string;
  864. begin
  865. hs:=lower(s);
  866. for i:=firstdirective to lastdirective do
  867. if hs=token2str[i] then
  868. begin
  869. actasmtoken:=i;
  870. is_asmdirective:=true;
  871. exit;
  872. end;
  873. is_asmdirective:=false;
  874. end;
  875. function tz80reader.is_register(const s:string):boolean;
  876. begin
  877. is_register:=false;
  878. actasmregister:=std_regnum_search(lower(s));
  879. if actasmregister<>NR_NO then
  880. begin
  881. is_register:=true;
  882. actasmtoken:=AS_REGISTER;
  883. end;
  884. end;
  885. function tz80reader.is_condition(const s: string): boolean;
  886. var
  887. condstr: string;
  888. cond: TAsmCond;
  889. begin
  890. is_condition:=false;
  891. actasmcond:=C_None;
  892. condstr:=lower(s);
  893. for cond in TAsmCond do
  894. if (cond<>C_None) and (cond2str[cond]=condstr) then
  895. begin
  896. is_condition:=true;
  897. actasmtoken:=AS_CONDITION;
  898. actasmcond:=cond;
  899. exit;
  900. end;
  901. end;
  902. function tz80reader.is_targetdirective(const s: string): boolean;
  903. begin
  904. result:=false;
  905. end;
  906. procedure tz80reader.BuildRecordOffsetSize(const expr: string; out
  907. offset: tcgint; out size: tcgint; out mangledname: string;
  908. needvmtofs: boolean; out hastypecast: boolean);
  909. var
  910. s: string;
  911. Begin
  912. offset:=0;
  913. size:=0;
  914. mangledname:='';
  915. hastypecast:=false;
  916. s:=expr;
  917. while (actasmtoken=AS_DOT) do
  918. begin
  919. Consume(AS_DOT);
  920. if actasmtoken in [AS_ID,AS_REGISTER] then
  921. begin
  922. s:=s+'.'+actasmpattern;
  923. consume(actasmtoken);
  924. end
  925. else
  926. begin
  927. Consume(AS_ID);
  928. RecoverConsume(true);
  929. break;
  930. end;
  931. end;
  932. if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs,hastypecast) then
  933. Message(asmr_e_building_record_offset);
  934. end;
  935. procedure tz80reader.BuildConstSymbolExpression(
  936. in_flags: tconstsymbolexpressioninputflags; out value: tcgint; out
  937. asmsym: string; out asmsymtyp: TAsmsymtype; out size: tcgint; out
  938. out_flags: tconstsymbolexpressionoutputflags);
  939. var
  940. tempstr,expr,hs,mangledname : string;
  941. parenlevel : longint;
  942. l,k : tcgint;
  943. hasparen,
  944. errorflag,
  945. needvmtofs : boolean;
  946. prevtok : tasmtoken;
  947. hl : tasmlabel;
  948. hssymtyp : Tasmsymtype;
  949. def : tdef;
  950. sym : tsym;
  951. srsymtable : TSymtable;
  952. hastypecast : boolean;
  953. Begin
  954. { reset }
  955. value:=0;
  956. asmsym:='';
  957. asmsymtyp:=AT_DATA;
  958. size:=0;
  959. out_flags:=[];
  960. errorflag:=FALSE;
  961. tempstr:='';
  962. expr:='';
  963. if cseif_startingminus in in_flags then
  964. expr:='-';
  965. inexpression:=TRUE;
  966. parenlevel:=0;
  967. sym:=nil;
  968. needvmtofs:=FALSE;
  969. Repeat
  970. { Support ugly delphi constructs like: [ECX].1+2[EDX] }
  971. if (cseif_isref in in_flags) and (actasmtoken=AS_LBRACKET) then
  972. break;
  973. if (cseif_referencelike in in_flags) and
  974. (actasmtoken in [AS_LBRACKET,AS_RBRACKET]) then
  975. case actasmtoken of
  976. AS_LBRACKET:
  977. begin
  978. Consume(AS_LBRACKET);
  979. if (length(expr)>0) and
  980. not (expr[length(expr)] in ['+','-']) then
  981. expr:=expr+'+';
  982. expr:=expr+'[';
  983. end;
  984. AS_RBRACKET:
  985. begin
  986. Consume(AS_RBRACKET);
  987. expr:=expr+']';
  988. end;
  989. else
  990. ;
  991. end;
  992. Case actasmtoken of
  993. AS_LPAREN:
  994. Begin
  995. Consume(AS_LPAREN);
  996. expr:=expr + '(';
  997. inc(parenlevel);
  998. end;
  999. AS_RPAREN:
  1000. Begin
  1001. { Keep the AS_PAREN in actasmtoken, it is maybe a typecast }
  1002. if parenlevel=0 then
  1003. break;
  1004. Consume(AS_RPAREN);
  1005. expr:=expr + ')';
  1006. dec(parenlevel);
  1007. end;
  1008. AS_SHL:
  1009. Begin
  1010. Consume(AS_SHL);
  1011. expr:=expr + '<';
  1012. end;
  1013. AS_SHR:
  1014. Begin
  1015. Consume(AS_SHR);
  1016. expr:=expr + '>';
  1017. end;
  1018. AS_SLASH:
  1019. Begin
  1020. Consume(AS_SLASH);
  1021. expr:=expr + '/';
  1022. end;
  1023. AS_MOD:
  1024. Begin
  1025. Consume(AS_MOD);
  1026. expr:=expr + '%';
  1027. end;
  1028. AS_STAR:
  1029. Begin
  1030. Consume(AS_STAR);
  1031. if (cseif_isref in in_flags) and (actasmtoken=AS_REGISTER) then
  1032. break;
  1033. expr:=expr + '*';
  1034. end;
  1035. AS_PLUS:
  1036. Begin
  1037. Consume(AS_PLUS);
  1038. if (cseif_isref in in_flags) and ((actasmtoken=AS_REGISTER) or (actasmtoken=AS_LBRACKET)) then
  1039. break;
  1040. expr:=expr + '+';
  1041. end;
  1042. AS_MINUS:
  1043. Begin
  1044. Consume(AS_MINUS);
  1045. expr:=expr + '-';
  1046. end;
  1047. AS_AND:
  1048. Begin
  1049. Consume(AS_AND);
  1050. expr:=expr + '&';
  1051. end;
  1052. AS_NOT:
  1053. Begin
  1054. Consume(AS_NOT);
  1055. expr:=expr + '~';
  1056. end;
  1057. AS_XOR:
  1058. Begin
  1059. Consume(AS_XOR);
  1060. expr:=expr + '^';
  1061. end;
  1062. AS_OR:
  1063. Begin
  1064. Consume(AS_OR);
  1065. expr:=expr + '|';
  1066. end;
  1067. AS_INTNUM:
  1068. Begin
  1069. expr:=expr + actasmpattern;
  1070. Consume(AS_INTNUM);
  1071. end;
  1072. {$ifdef i8086}
  1073. AS_SEG:
  1074. begin
  1075. include(out_flags,cseof_isseg);
  1076. Consume(actasmtoken);
  1077. if actasmtoken<>AS_ID then
  1078. Message(asmr_e_seg_without_identifier);
  1079. end;
  1080. {$endif i8086}
  1081. AS_VMTOFFSET{,
  1082. AS_OFFSET}:
  1083. begin
  1084. {if (actasmtoken = AS_OFFSET) then
  1085. begin
  1086. include(in_flags,cseif_needofs);
  1087. include(out_flags,cseof_hasofs);
  1088. end
  1089. else}
  1090. needvmtofs:=true;
  1091. Consume(actasmtoken);
  1092. if actasmtoken<>AS_ID then
  1093. Message(asmr_e_offset_without_identifier);
  1094. end;
  1095. AS_SIZEOF,
  1096. AS_TYPE:
  1097. begin
  1098. l:=0;
  1099. hasparen:=false;
  1100. Consume(actasmtoken);
  1101. if actasmtoken=AS_LPAREN then
  1102. begin
  1103. hasparen:=true;
  1104. Consume(AS_LPAREN);
  1105. end;
  1106. if actasmtoken<>AS_ID then
  1107. Message(asmr_e_type_without_identifier)
  1108. else
  1109. begin
  1110. tempstr:=actasmpattern;
  1111. Consume(AS_ID);
  1112. if actasmtoken=AS_DOT then
  1113. begin
  1114. BuildRecordOffsetSize(tempstr,k,l,mangledname,false,hastypecast);
  1115. if mangledname<>'' then
  1116. { procsym }
  1117. Message(asmr_e_wrong_sym_type);
  1118. if hastypecast then
  1119. end
  1120. else
  1121. begin
  1122. asmsearchsym(tempstr,sym,srsymtable);
  1123. if assigned(sym) then
  1124. begin
  1125. case sym.typ of
  1126. staticvarsym,
  1127. localvarsym,
  1128. paravarsym :
  1129. l:=tabstractvarsym(sym).getsize;
  1130. typesym :
  1131. l:=ttypesym(sym).typedef.size;
  1132. else
  1133. Message(asmr_e_wrong_sym_type);
  1134. end;
  1135. end
  1136. else
  1137. Message1(sym_e_unknown_id,tempstr);
  1138. end;
  1139. end;
  1140. str(l, tempstr);
  1141. expr:=expr + tempstr;
  1142. if hasparen then
  1143. Consume(AS_RPAREN);
  1144. end;
  1145. //AS_PTR :
  1146. // begin
  1147. // { Support ugly delphi constructs like <constant> PTR [ref] }
  1148. // break;
  1149. // end;
  1150. AS_STRING:
  1151. begin
  1152. l:=0;
  1153. case Length(actasmpattern) of
  1154. 1 :
  1155. l:=ord(actasmpattern[1]);
  1156. 2 :
  1157. l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
  1158. 3 :
  1159. l:=ord(actasmpattern[3]) +
  1160. Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
  1161. 4 :
  1162. l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
  1163. Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
  1164. else
  1165. Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
  1166. end;
  1167. str(l, tempstr);
  1168. expr:=expr + tempstr;
  1169. Consume(AS_STRING);
  1170. end;
  1171. AS_ID:
  1172. begin
  1173. hs:='';
  1174. hssymtyp:=AT_DATA;
  1175. def:=nil;
  1176. tempstr:=actasmpattern;
  1177. prevtok:=prevasmtoken;
  1178. { stop parsing a constant expression if we find an opcode after a
  1179. non-operator like "db $66 mov eax,ebx" }
  1180. if (prevtok in [AS_ID,AS_INTNUM,AS_RPAREN]) and
  1181. is_asmopcode(actasmpattern) then
  1182. break;
  1183. consume(AS_ID);
  1184. if (tempstr='@CODE') or (tempstr='@DATA') then
  1185. begin
  1186. if asmsym='' then
  1187. begin
  1188. asmsym:=tempstr;
  1189. asmsymtyp:=AT_SECTION;
  1190. end
  1191. else
  1192. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1193. end
  1194. else if SearchIConstant(tempstr,l) then
  1195. begin
  1196. str(l, tempstr);
  1197. expr:=expr + tempstr;
  1198. end
  1199. else
  1200. begin
  1201. if is_locallabel(tempstr) then
  1202. begin
  1203. CreateLocalLabel(tempstr,hl,false);
  1204. hs:=hl.name;
  1205. hssymtyp:=AT_FUNCTION;
  1206. end
  1207. else
  1208. if SearchLabel(tempstr,hl,false) then
  1209. begin
  1210. hs:=hl.name;
  1211. hssymtyp:=AT_FUNCTION;
  1212. end
  1213. else
  1214. begin
  1215. asmsearchsym(tempstr,sym,srsymtable);
  1216. if assigned(sym) then
  1217. begin
  1218. case sym.typ of
  1219. staticvarsym :
  1220. begin
  1221. hs:=tstaticvarsym(sym).mangledname;
  1222. def:=tstaticvarsym(sym).vardef;
  1223. end;
  1224. localvarsym,
  1225. paravarsym :
  1226. begin
  1227. Message(asmr_e_no_local_or_para_allowed);
  1228. end;
  1229. procsym :
  1230. begin
  1231. if Tprocsym(sym).ProcdefList.Count>1 then
  1232. Message(asmr_w_calling_overload_func);
  1233. hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname;
  1234. {$ifdef i8086}
  1235. if is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
  1236. and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) then
  1237. include(out_flags,cseof_is_farproc_entry)
  1238. else
  1239. exclude(out_flags,cseof_is_farproc_entry);
  1240. {$endif i8086}
  1241. hssymtyp:=AT_FUNCTION;
  1242. end;
  1243. typesym :
  1244. begin
  1245. if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then
  1246. Message(asmr_e_wrong_sym_type);
  1247. size:=ttypesym(sym).typedef.size;
  1248. end;
  1249. fieldvarsym :
  1250. begin
  1251. tempstr:=upper(tdef(sym.owner.defowner).GetTypeName)+'.'+tempstr;
  1252. end;
  1253. else
  1254. Message(asmr_e_wrong_sym_type);
  1255. end;
  1256. end
  1257. else
  1258. Message1(sym_e_unknown_id,tempstr);
  1259. end;
  1260. { symbol found? }
  1261. if hs<>'' then
  1262. begin
  1263. if asmsym='' then
  1264. begin
  1265. asmsym:=hs;
  1266. asmsymtyp:=hssymtyp;
  1267. end
  1268. else
  1269. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1270. if (expr='') or (expr[length(expr)]='+') then
  1271. begin
  1272. { don't remove the + if there could be a record field }
  1273. if actasmtoken<>AS_DOT then
  1274. delete(expr,length(expr),1);
  1275. end
  1276. else
  1277. //if (cseif_needofs in in_flags) then
  1278. // begin
  1279. // if (prevtok<>AS_OFFSET) then
  1280. // Message(asmr_e_need_offset);
  1281. // end
  1282. //else
  1283. Message(asmr_e_only_add_relocatable_symbol);
  1284. end;
  1285. if (actasmtoken=AS_DOT) or
  1286. (assigned(sym) and
  1287. is_normal_fieldvarsym(sym)) then
  1288. begin
  1289. BuildRecordOffsetSize(tempstr,l,size,hs,needvmtofs,hastypecast);
  1290. if hs <> '' then
  1291. hssymtyp:=AT_FUNCTION
  1292. else
  1293. begin
  1294. str(l, tempstr);
  1295. expr:=expr + tempstr;
  1296. end
  1297. end
  1298. else if (actasmtoken<>AS_DOT) and
  1299. assigned(sym) and
  1300. (sym.typ=typesym) and
  1301. (ttypesym(sym).typedef.typ in [recorddef,objectdef]) then
  1302. begin
  1303. { just a record type (without being followed by dot)
  1304. evaluates to 0. Ugly, but TP7 compatible. }
  1305. expr:=expr+'0';
  1306. end
  1307. else
  1308. begin
  1309. if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
  1310. delete(expr,length(expr),1);
  1311. end;
  1312. if (actasmtoken=AS_LBRACKET) and
  1313. assigned(def) and
  1314. (def.typ=arraydef) then
  1315. begin
  1316. consume(AS_LBRACKET);
  1317. l:=BuildConstExpression;
  1318. if l<tarraydef(def).lowrange then
  1319. begin
  1320. Message(asmr_e_constant_out_of_bounds);
  1321. l:=0;
  1322. end
  1323. else
  1324. l:=(l-tarraydef(def).lowrange)*tarraydef(def).elesize;
  1325. str(l, tempstr);
  1326. expr:=expr + '+' + tempstr;
  1327. consume(AS_RBRACKET);
  1328. end;
  1329. end;
  1330. { check if there are wrong operator used like / or mod etc. }
  1331. if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END,AS_RBRACKET]) then
  1332. Message(asmr_e_only_add_relocatable_symbol);
  1333. end;
  1334. //AS_ALIGN,
  1335. AS_DEFB,
  1336. AS_DEFW,
  1337. AS_END,
  1338. AS_RBRACKET,
  1339. AS_SEPARATOR,
  1340. AS_COMMA,
  1341. AS_COLON:
  1342. break;
  1343. else
  1344. begin
  1345. { write error only once. }
  1346. if not errorflag then
  1347. Message(asmr_e_invalid_constant_expression);
  1348. { consume tokens until we find COMMA or SEPARATOR }
  1349. Consume(actasmtoken);
  1350. errorflag:=TRUE;
  1351. end;
  1352. end;
  1353. Until false;
  1354. { calculate expression }
  1355. if not ErrorFlag then
  1356. value:=CalculateExpression(expr)
  1357. else
  1358. value:=0;
  1359. { no longer in an expression }
  1360. inexpression:=FALSE;
  1361. end;
  1362. function tz80reader.BuildConstExpression: longint;
  1363. var
  1364. l,size : tcgint;
  1365. hs : string;
  1366. hssymtyp : TAsmsymtype;
  1367. out_flags : tconstsymbolexpressionoutputflags;
  1368. begin
  1369. BuildConstSymbolExpression([],l,hs,hssymtyp,size,out_flags);
  1370. if hs<>'' then
  1371. Message(asmr_e_relocatable_symbol_not_allowed);
  1372. BuildConstExpression:=l;
  1373. end;
  1374. function tz80reader.BuildRefConstExpression(out size: tcgint;
  1375. startingminus: boolean): longint;
  1376. var
  1377. l : tcgint;
  1378. hs : string;
  1379. hssymtyp : TAsmsymtype;
  1380. in_flags : tconstsymbolexpressioninputflags;
  1381. out_flags : tconstsymbolexpressionoutputflags;
  1382. begin
  1383. in_flags:=[cseif_isref];
  1384. if startingminus then
  1385. include(in_flags,cseif_startingminus);
  1386. BuildConstSymbolExpression(in_flags,l,hs,hssymtyp,size,out_flags);
  1387. if hs<>'' then
  1388. Message(asmr_e_relocatable_symbol_not_allowed);
  1389. BuildRefConstExpression:=l;
  1390. end;
  1391. procedure tz80reader.BuildConstantOperand(oper: tz80operand);
  1392. var
  1393. l,size : tcgint;
  1394. tempstr : string;
  1395. tempsymtyp : tasmsymtype;
  1396. cse_out_flags : tconstsymbolexpressionoutputflags;
  1397. begin
  1398. if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1399. Message(asmr_e_invalid_operand_type);
  1400. BuildConstSymbolExpression([cseif_needofs],l,tempstr,tempsymtyp,size,cse_out_flags);
  1401. if tempstr<>'' then
  1402. begin
  1403. oper.opr.typ:=OPR_SYMBOL;
  1404. oper.opr.symofs:=l;
  1405. oper.opr.symbol:=current_asmdata.RefAsmSymbol(tempstr,tempsymtyp);
  1406. oper.opr.symseg:=cseof_isseg in cse_out_flags;
  1407. oper.opr.sym_farproc_entry:=cseof_is_farproc_entry in cse_out_flags;
  1408. end
  1409. else
  1410. if oper.opr.typ=OPR_NONE then
  1411. begin
  1412. oper.opr.typ:=OPR_CONSTANT;
  1413. oper.opr.val:=l;
  1414. end
  1415. else
  1416. inc(oper.opr.val,l);
  1417. end;
  1418. procedure tz80reader.BuildReference(oper: tz80operand);
  1419. var
  1420. scale : byte;
  1421. k,l,size : tcgint;
  1422. tempstr,hs : string;
  1423. tempsymtyp : tasmsymtype;
  1424. code : integer;
  1425. hreg : tregister;
  1426. GotStar,GotOffset,HadVar,
  1427. GotPlus,Negative,BracketlessReference : boolean;
  1428. hl : tasmlabel;
  1429. hastypecast: boolean;
  1430. tmpoper: tz80operand;
  1431. cse_in_flags: tconstsymbolexpressioninputflags;
  1432. cse_out_flags: tconstsymbolexpressionoutputflags;
  1433. begin
  1434. if actasmtoken=AS_LPAREN then
  1435. begin
  1436. Consume(AS_LPAREN);
  1437. BracketlessReference:=false;
  1438. end
  1439. else
  1440. BracketlessReference:=true;
  1441. if not(oper.opr.typ in [OPR_LOCAL,OPR_REFERENCE]) then
  1442. oper.InitRef;
  1443. GotStar:=false;
  1444. GotPlus:=true;
  1445. GotOffset:=false;
  1446. Negative:=false;
  1447. Scale:=0;
  1448. repeat
  1449. if GotOffset and (actasmtoken<>AS_ID) then
  1450. Message(asmr_e_invalid_reference_syntax);
  1451. Case actasmtoken of
  1452. AS_ID, { Constant reference expression OR variable reference expression }
  1453. AS_VMTOFFSET:
  1454. Begin
  1455. if not GotPlus then
  1456. Message(asmr_e_invalid_reference_syntax);
  1457. GotStar:=false;
  1458. GotPlus:=false;
  1459. if (actasmtoken = AS_VMTOFFSET) or
  1460. (SearchIConstant(actasmpattern,l) or
  1461. SearchRecordType(actasmpattern)) then
  1462. begin
  1463. l:=BuildRefConstExpression(size,negative);
  1464. if size<>0 then
  1465. oper.SetSize(size,false);
  1466. negative:=false; { "l" was negated if necessary }
  1467. GotPlus:=(prevasmtoken=AS_PLUS);
  1468. GotStar:=(prevasmtoken=AS_STAR);
  1469. case oper.opr.typ of
  1470. OPR_LOCAL :
  1471. begin
  1472. if GotStar then
  1473. Message(asmr_e_invalid_reference_syntax);
  1474. Inc(oper.opr.localsymofs,l);
  1475. end;
  1476. OPR_REFERENCE :
  1477. begin
  1478. if GotStar then
  1479. oper.opr.ref.scalefactor:=l
  1480. else
  1481. Inc(oper.opr.ref.offset,l);
  1482. end;
  1483. else
  1484. internalerror(2019050715);
  1485. end;
  1486. end
  1487. else
  1488. Begin
  1489. if negative and not oper.hasvar then
  1490. Message(asmr_e_only_add_relocatable_symbol)
  1491. else if oper.hasvar and not GotOffset and
  1492. (not negative or assigned(oper.opr.ref.relsymbol)) then
  1493. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1494. HadVar:=oper.hasvar and GotOffset;
  1495. tempstr:=actasmpattern;
  1496. Consume(AS_ID);
  1497. { typecasting? }
  1498. if (actasmtoken=AS_LPAREN) and
  1499. SearchType(tempstr,l) then
  1500. begin
  1501. oper.hastype:=true;
  1502. oper.typesize:=l;
  1503. Consume(AS_LPAREN);
  1504. BuildOperand(oper,true);
  1505. Consume(AS_RPAREN);
  1506. end
  1507. else
  1508. if is_locallabel(tempstr) then
  1509. begin
  1510. CreateLocalLabel(tempstr,hl,false);
  1511. oper.InitRef;
  1512. oper.haslabelref:=true;
  1513. if not negative then
  1514. begin
  1515. oper.opr.ref.symbol:=hl;
  1516. oper.hasvar:=true;
  1517. end
  1518. else
  1519. oper.opr.ref.relsymbol:=hl;
  1520. {$ifdef i8086}
  1521. if oper.opr.ref.segment=NR_NO then
  1522. oper.opr.ref.segment:=NR_CS;
  1523. {$endif i8086}
  1524. end
  1525. else
  1526. if oper.SetupVar(tempstr,GotOffset) then
  1527. begin
  1528. { convert OPR_LOCAL register para into a reference base }
  1529. if (oper.opr.typ=OPR_LOCAL) and
  1530. AsmRegisterPara(oper.opr.localsym) then
  1531. oper.InitRefConvertLocal
  1532. else
  1533. begin
  1534. {$ifdef x86_64}
  1535. if actasmtoken=AS_WRT then
  1536. begin
  1537. if (oper.opr.typ=OPR_REFERENCE) then
  1538. begin
  1539. Consume(AS_WRT);
  1540. Consume(AS___GOTPCREL);
  1541. if (oper.opr.ref.base<>NR_NO) or
  1542. (oper.opr.ref.index<>NR_NO) or
  1543. (oper.opr.ref.offset<>0) then
  1544. Message(asmr_e_wrong_gotpcrel_intel_syntax);
  1545. if tf_no_pic_supported in target_info.flags then
  1546. Message(asmr_e_no_gotpcrel_support);
  1547. oper.opr.ref.refaddr:=addr_pic;
  1548. oper.opr.ref.base:=NR_RIP;
  1549. end
  1550. else
  1551. message(asmr_e_invalid_reference_syntax);
  1552. end;
  1553. {$endif x86_64}
  1554. end;
  1555. end
  1556. else
  1557. Message1(sym_e_unknown_id,tempstr);
  1558. { record.field ? }
  1559. if actasmtoken=AS_DOT then
  1560. begin
  1561. BuildRecordOffsetSize(tempstr,l,k,hs,false,hastypecast);
  1562. if (hs<>'') then
  1563. Message(asmr_e_invalid_symbol_ref);
  1564. case oper.opr.typ of
  1565. OPR_LOCAL :
  1566. inc(oper.opr.localsymofs,l);
  1567. OPR_REFERENCE :
  1568. inc(oper.opr.ref.offset,l);
  1569. else
  1570. internalerror(2019050716);
  1571. end;
  1572. if hastypecast then
  1573. oper.hastype:=true;
  1574. oper.SetSize(k,false);
  1575. end;
  1576. if GotOffset then
  1577. begin
  1578. if oper.hasvar and (oper.opr.ref.base=current_procinfo.framepointer) then
  1579. begin
  1580. if (oper.opr.typ=OPR_REFERENCE) then
  1581. oper.opr.ref.base:=NR_NO;
  1582. oper.hasvar:=hadvar;
  1583. end
  1584. else
  1585. begin
  1586. if oper.hasvar and hadvar then
  1587. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1588. { should we allow ?? }
  1589. end;
  1590. end;
  1591. end;
  1592. GotOffset:=false;
  1593. end;
  1594. AS_PLUS :
  1595. Begin
  1596. Consume(AS_PLUS);
  1597. Negative:=false;
  1598. GotPlus:=true;
  1599. GotStar:=false;
  1600. Scale:=0;
  1601. end;
  1602. AS_DOT :
  1603. Begin
  1604. { Handle like a + }
  1605. Consume(AS_DOT);
  1606. Negative:=false;
  1607. GotPlus:=true;
  1608. GotStar:=false;
  1609. Scale:=0;
  1610. end;
  1611. AS_MINUS :
  1612. begin
  1613. Consume(AS_MINUS);
  1614. Negative:=true;
  1615. GotPlus:=true;
  1616. GotStar:=false;
  1617. Scale:=0;
  1618. end;
  1619. AS_STAR : { Scaling, with eax*4 order }
  1620. begin
  1621. Consume(AS_STAR);
  1622. hs:='';
  1623. l:=0;
  1624. case actasmtoken of
  1625. AS_ID,
  1626. AS_LPAREN :
  1627. l:=BuildConstExpression;
  1628. AS_INTNUM:
  1629. Begin
  1630. hs:=actasmpattern;
  1631. Consume(AS_INTNUM);
  1632. end;
  1633. AS_REGISTER :
  1634. begin
  1635. case oper.opr.typ of
  1636. OPR_REFERENCE :
  1637. begin
  1638. if oper.opr.ref.scalefactor=0 then
  1639. begin
  1640. if scale<>0 then
  1641. begin
  1642. oper.opr.ref.scalefactor:=scale;
  1643. scale:=0;
  1644. end
  1645. else
  1646. Message(asmr_e_wrong_scale_factor);
  1647. end
  1648. else
  1649. Message(asmr_e_invalid_reference_syntax);
  1650. end;
  1651. OPR_LOCAL :
  1652. begin
  1653. if oper.opr.localscale=0 then
  1654. begin
  1655. if scale<>0 then
  1656. begin
  1657. oper.opr.localscale:=scale;
  1658. scale:=0;
  1659. end
  1660. else
  1661. Message(asmr_e_wrong_scale_factor);
  1662. end
  1663. else
  1664. Message(asmr_e_invalid_reference_syntax);
  1665. end;
  1666. else
  1667. internalerror(2019050719);
  1668. end;
  1669. end;
  1670. else
  1671. Message(asmr_e_invalid_reference_syntax);
  1672. end;
  1673. if actasmtoken<>AS_REGISTER then
  1674. begin
  1675. if hs<>'' then
  1676. val(hs,l,code);
  1677. case oper.opr.typ of
  1678. OPR_REFERENCE :
  1679. oper.opr.ref.scalefactor:=l;
  1680. OPR_LOCAL :
  1681. oper.opr.localscale:=l;
  1682. else
  1683. internalerror(2019050717);
  1684. end;
  1685. if l>9 then
  1686. Message(asmr_e_wrong_scale_factor);
  1687. end;
  1688. GotPlus:=false;
  1689. GotStar:=false;
  1690. end;
  1691. AS_REGISTER :
  1692. begin
  1693. hreg:=actasmregister;
  1694. Consume(AS_REGISTER);
  1695. if not((GotPlus and (not Negative)) or
  1696. GotStar) then
  1697. Message(asmr_e_invalid_reference_syntax);
  1698. { this register will be the index:
  1699. 1. just read a *
  1700. 2. next token is a *
  1701. 3. base register is already used }
  1702. case oper.opr.typ of
  1703. OPR_LOCAL :
  1704. begin
  1705. if (oper.opr.localindexreg<>NR_NO) then
  1706. Message(asmr_e_multiple_index);
  1707. oper.opr.localindexreg:=hreg;
  1708. if scale<>0 then
  1709. begin
  1710. oper.opr.localscale:=scale;
  1711. scale:=0;
  1712. end;
  1713. end;
  1714. OPR_REFERENCE :
  1715. begin
  1716. if (GotStar) or
  1717. (actasmtoken=AS_STAR) or
  1718. (oper.opr.ref.base<>NR_NO) then
  1719. begin
  1720. if (oper.opr.ref.index<>NR_NO) then
  1721. Message(asmr_e_multiple_index);
  1722. oper.opr.ref.index:=hreg;
  1723. if scale<>0 then
  1724. begin
  1725. oper.opr.ref.scalefactor:=scale;
  1726. scale:=0;
  1727. end;
  1728. end
  1729. else
  1730. begin
  1731. oper.opr.ref.base:=hreg;
  1732. {$ifdef x86_64}
  1733. { non-GOT based RIP-relative accesses are also position-independent }
  1734. if (oper.opr.ref.base=NR_RIP) and
  1735. (oper.opr.ref.refaddr<>addr_pic) then
  1736. oper.opr.ref.refaddr:=addr_pic_no_got;
  1737. {$endif x86_64}
  1738. end;
  1739. end;
  1740. else
  1741. internalerror(2019050718);
  1742. end;
  1743. GotPlus:=false;
  1744. GotStar:=false;
  1745. end;
  1746. //AS_OFFSET :
  1747. // begin
  1748. // Consume(AS_OFFSET);
  1749. // GotOffset:=true;
  1750. // end;
  1751. AS_TYPE,
  1752. AS_NOT,
  1753. AS_STRING,
  1754. AS_INTNUM,
  1755. AS_LPAREN : { Constant reference expression }
  1756. begin
  1757. if not GotPlus and not GotStar then
  1758. Message(asmr_e_invalid_reference_syntax);
  1759. cse_in_flags:=[cseif_needofs,cseif_isref];
  1760. if GotPlus and negative then
  1761. include(cse_in_flags,cseif_startingminus);
  1762. BuildConstSymbolExpression(cse_in_flags,l,tempstr,tempsymtyp,size,cse_out_flags);
  1763. { already handled by BuildConstSymbolExpression(); must be
  1764. handled there to avoid [reg-1+1] being interpreted as
  1765. [reg-(1+1)] }
  1766. negative:=false;
  1767. if tempstr<>'' then
  1768. begin
  1769. if GotStar then
  1770. Message(asmr_e_only_add_relocatable_symbol);
  1771. if not assigned(oper.opr.ref.symbol) then
  1772. begin
  1773. oper.opr.ref.symbol:=current_asmdata.RefAsmSymbol(tempstr,tempsymtyp);
  1774. {$ifdef i8086}
  1775. if cseof_isseg in cse_out_flags then
  1776. begin
  1777. if not (oper.opr.ref.refaddr in [addr_fardataseg,addr_dgroup]) then
  1778. oper.opr.ref.refaddr:=addr_seg;
  1779. end
  1780. else if (tempsymtyp=AT_FUNCTION) and (oper.opr.ref.segment=NR_NO) then
  1781. oper.opr.ref.segment:=NR_CS;
  1782. {$endif i8086}
  1783. end
  1784. else
  1785. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1786. end;
  1787. case oper.opr.typ of
  1788. OPR_REFERENCE :
  1789. begin
  1790. if GotStar then
  1791. oper.opr.ref.scalefactor:=l
  1792. else if (prevasmtoken = AS_STAR) then
  1793. begin
  1794. if scale<>0 then
  1795. scale:=l*scale
  1796. else
  1797. scale:=l;
  1798. end
  1799. else
  1800. begin
  1801. Inc(oper.opr.ref.offset,l);
  1802. Inc(oper.opr.constoffset,l);
  1803. end;
  1804. end;
  1805. OPR_LOCAL :
  1806. begin
  1807. if GotStar then
  1808. oper.opr.localscale:=l
  1809. else if (prevasmtoken = AS_STAR) then
  1810. begin
  1811. if scale<>0 then
  1812. scale:=l*scale
  1813. else
  1814. scale:=l;
  1815. end
  1816. else
  1817. Inc(oper.opr.localsymofs,l);
  1818. end;
  1819. else
  1820. internalerror(2019050714);
  1821. end;
  1822. GotPlus:=(prevasmtoken=AS_PLUS) or
  1823. (prevasmtoken=AS_MINUS);
  1824. if GotPlus then
  1825. negative := prevasmtoken = AS_MINUS;
  1826. GotStar:=(prevasmtoken=AS_STAR);
  1827. end;
  1828. //AS_LBRACKET :
  1829. // begin
  1830. // if (GotPlus and Negative) or GotStar then
  1831. // Message(asmr_e_invalid_reference_syntax);
  1832. // tmpoper:=Tz80Operand.create;
  1833. // BuildReference(tmpoper);
  1834. // AddReferences(oper,tmpoper);
  1835. // tmpoper.Free;
  1836. // GotPlus:=false;
  1837. // GotStar:=false;
  1838. // end;
  1839. AS_RPAREN :
  1840. begin
  1841. if GotPlus or GotStar or BracketlessReference then
  1842. Message(asmr_e_invalid_reference_syntax);
  1843. Consume(AS_RPAREN);
  1844. if actasmtoken=AS_LPAREN then
  1845. begin
  1846. tmpoper:=Tz80Operand.create;
  1847. BuildReference(tmpoper);
  1848. AddReferences(oper,tmpoper);
  1849. tmpoper.Free;
  1850. end;
  1851. break;
  1852. end;
  1853. AS_SEPARATOR,
  1854. AS_END,
  1855. AS_COMMA:
  1856. begin
  1857. if not BracketlessReference then
  1858. begin
  1859. Message(asmr_e_invalid_reference_syntax);
  1860. RecoverConsume(true);
  1861. end;
  1862. break;
  1863. end;
  1864. else
  1865. Begin
  1866. Message(asmr_e_invalid_reference_syntax);
  1867. RecoverConsume(true);
  1868. break;
  1869. end;
  1870. end;
  1871. until false;
  1872. end;
  1873. procedure tz80reader.BuildOperand(oper: tz80operand; istypecast: boolean);
  1874. procedure AddLabelOperand(hl:tasmlabel);
  1875. begin
  1876. if (oper.opr.typ=OPR_NONE) and
  1877. is_calljmp(actopcode) then
  1878. begin
  1879. oper.opr.typ:=OPR_SYMBOL;
  1880. oper.opr.symbol:=hl;
  1881. end
  1882. else
  1883. begin
  1884. oper.InitRef;
  1885. oper.opr.ref.symbol:=hl;
  1886. oper.haslabelref:=true;
  1887. end;
  1888. end;
  1889. var
  1890. l: tcgint;
  1891. tsize: tcgint;
  1892. expr: string;
  1893. hl: tasmlabel;
  1894. begin
  1895. repeat
  1896. case actasmtoken of
  1897. //AS_OFFSET,
  1898. AS_SIZEOF,
  1899. AS_VMTOFFSET,
  1900. AS_TYPE,
  1901. AS_NOT,
  1902. AS_STRING,
  1903. AS_PLUS,
  1904. AS_MINUS,
  1905. // AS_LPAREN,
  1906. AS_INTNUM :
  1907. begin
  1908. case oper.opr.typ of
  1909. OPR_REFERENCE :
  1910. begin
  1911. l := BuildRefConstExpression(tsize);
  1912. if tsize<>0 then
  1913. oper.SetSize(tsize,false);
  1914. inc(oper.opr.ref.offset,l);
  1915. inc(oper.opr.constoffset,l);
  1916. end;
  1917. OPR_LOCAL :
  1918. begin
  1919. l := BuildConstExpression;
  1920. inc(oper.opr.localsymofs,l);
  1921. inc(oper.opr.localconstoffset,l);
  1922. end;
  1923. OPR_NONE,
  1924. OPR_CONSTANT :
  1925. BuildConstantOperand(oper);
  1926. else
  1927. Message(asmr_e_invalid_operand_type);
  1928. end;
  1929. end;
  1930. AS_LPAREN:
  1931. begin
  1932. BuildReference(oper);
  1933. end;
  1934. AS_ID : { A constant expression, or a Variable ref. }
  1935. Begin
  1936. { Label or Special symbol reference? }
  1937. if actasmpattern[1] = '@' then
  1938. Begin
  1939. if actasmpattern = '@RESULT' then
  1940. Begin
  1941. oper.SetupResult;
  1942. Consume(AS_ID);
  1943. expr:='result';
  1944. end
  1945. else
  1946. if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
  1947. begin
  1948. Message(asmr_w_CODE_and_DATA_not_supported);
  1949. Consume(AS_ID);
  1950. end
  1951. else
  1952. { Local Label }
  1953. begin
  1954. CreateLocalLabel(actasmpattern,hl,false);
  1955. Consume(AS_ID);
  1956. AddLabelOperand(hl);
  1957. end;
  1958. end
  1959. else
  1960. { support result for delphi modes }
  1961. if (m_objpas in current_settings.modeswitches) and (actasmpattern='RESULT') then
  1962. begin
  1963. oper.SetUpResult;
  1964. Consume(AS_ID);
  1965. expr:='result';
  1966. end
  1967. { probably a variable or normal expression }
  1968. { or a procedure (such as in CALL ID) }
  1969. else
  1970. Begin
  1971. { is it a constant ? }
  1972. if SearchIConstant(actasmpattern,l) then
  1973. Begin
  1974. case oper.opr.typ of
  1975. OPR_REFERENCE :
  1976. begin
  1977. l := BuildRefConstExpression(tsize);
  1978. if tsize<>0 then
  1979. oper.SetSize(tsize,false);
  1980. inc(oper.opr.ref.offset,l);
  1981. inc(oper.opr.constoffset,l);
  1982. end;
  1983. OPR_LOCAL :
  1984. begin
  1985. l := BuildRefConstExpression(tsize);
  1986. if tsize<>0 then
  1987. oper.SetSize(tsize,false);
  1988. inc(oper.opr.localsymofs,l);
  1989. inc(oper.opr.localconstoffset,l);
  1990. end;
  1991. OPR_NONE,
  1992. OPR_CONSTANT :
  1993. BuildConstantOperand(oper);
  1994. else
  1995. Message(asmr_e_invalid_operand_type);
  1996. end;
  1997. end
  1998. else
  1999. { Check for pascal label }
  2000. if SearchLabel(actasmpattern,hl,false) then
  2001. begin
  2002. Consume(AS_ID);
  2003. AddLabelOperand(hl);
  2004. end
  2005. else
  2006. { is it a normal variable ? }
  2007. Begin
  2008. expr:=actasmpattern;
  2009. Consume(AS_ID);
  2010. { typecasting? }
  2011. if SearchType(expr,l) then
  2012. begin
  2013. oper.hastype:=true;
  2014. oper.typesize:=l;
  2015. case actasmtoken of
  2016. AS_LPAREN :
  2017. begin
  2018. { Support Type([Reference]) }
  2019. Consume(AS_LPAREN);
  2020. BuildOperand(oper,true);
  2021. { Delphi also supports Type(Register) and
  2022. interprets it the same as Type([Register]). }
  2023. if (oper.opr.typ = OPR_REGISTER) then
  2024. { This also sets base to the register. }
  2025. oper.InitRef;
  2026. Consume(AS_RPAREN);
  2027. end;
  2028. //AS_LBRACKET :
  2029. // begin
  2030. // { Support Var.Type[Index] }
  2031. // { Convert @label.Byte[1] to reference }
  2032. // if oper.opr.typ=OPR_SYMBOL then
  2033. // oper.initref;
  2034. // end;
  2035. else
  2036. ;
  2037. end;
  2038. end
  2039. else
  2040. begin
  2041. if not oper.SetupVar(expr,false) then
  2042. Begin
  2043. { not a variable, check special variables.. }
  2044. if expr = 'SELF' then
  2045. begin
  2046. oper.SetupSelf;
  2047. expr:='self';
  2048. end
  2049. else
  2050. begin
  2051. Message1(sym_e_unknown_id,expr);
  2052. expr:='';
  2053. end;
  2054. end;
  2055. { indexed access to variable? }
  2056. //if actasmtoken=AS_LBRACKET then
  2057. // begin
  2058. // { ... then the operand size is not known anymore }
  2059. // oper.size:=OS_NO;
  2060. // BuildReference(oper);
  2061. // end;
  2062. end;
  2063. end;
  2064. end;
  2065. end;
  2066. AS_REGISTER : { Register, a variable reference or a constant reference }
  2067. begin
  2068. Consume(AS_REGISTER);
  2069. { Simple register }
  2070. if (oper.opr.typ <> OPR_NONE) then
  2071. Message(asmr_e_syn_operand);
  2072. oper.opr.typ:=OPR_REGISTER;
  2073. oper.opr.reg:=actasmregister;
  2074. oper.SetSize(tcgsize2size[reg_cgsize(oper.opr.reg)],true);
  2075. end;
  2076. AS_SEPARATOR,
  2077. AS_END,
  2078. AS_COMMA:
  2079. begin
  2080. break;
  2081. end;
  2082. else
  2083. begin
  2084. Message(asmr_e_syn_operand);
  2085. RecoverConsume(true);
  2086. break;
  2087. end;
  2088. end;
  2089. until false;
  2090. end;
  2091. procedure tz80reader.BuildOpCode(instr: TZ80Instruction);
  2092. var
  2093. operandnum: Integer;
  2094. begin
  2095. instr.opcode:=actopcode;
  2096. operandnum:=1;
  2097. Consume(AS_OPCODE);
  2098. { Zero operand opcode ? }
  2099. if actasmtoken in [AS_SEPARATOR,AS_END] then
  2100. exit;
  2101. { Condition (e.g. 'NC' in 'JP NC, label') }
  2102. if actasmtoken=AS_CONDITION then
  2103. begin
  2104. instr.condition:=actasmcond;
  2105. Consume(AS_CONDITION);
  2106. if actasmtoken in [AS_SEPARATOR,AS_END] then
  2107. exit;
  2108. if actasmtoken=AS_COMMA then
  2109. Consume(AS_COMMA);
  2110. end;
  2111. { Read Operands }
  2112. repeat
  2113. case actasmtoken of
  2114. { End of asm operands for this opcode }
  2115. AS_END,
  2116. AS_SEPARATOR :
  2117. break;
  2118. { Operand delimiter }
  2119. AS_COMMA :
  2120. begin
  2121. { should have something before the comma }
  2122. if instr.operands[operandnum].opr.typ=OPR_NONE then
  2123. Message(asmr_e_syntax_error);
  2124. if operandnum >= max_operands then
  2125. Message(asmr_e_too_many_operands)
  2126. else
  2127. Inc(operandnum);
  2128. Consume(AS_COMMA);
  2129. end;
  2130. else
  2131. BuildOperand(instr.Operands[operandnum] as tz80operand,false);
  2132. end;
  2133. until false;
  2134. instr.ops:=operandnum;
  2135. end;
  2136. procedure tz80reader.BuildConstant(constsize: byte);
  2137. var
  2138. asmsymtyp : TAsmSymType;
  2139. asmsym,
  2140. expr : string;
  2141. value, sz : tcgint;
  2142. inflags : tconstsymbolexpressioninputflags;
  2143. outflags : tconstsymbolexpressionoutputflags;
  2144. begin
  2145. repeat
  2146. case actasmtoken of
  2147. AS_STRING:
  2148. Begin
  2149. expr:=actasmpattern;
  2150. if length(expr) > 1 then
  2151. Message(asmr_e_string_not_allowed_as_const);
  2152. Consume(AS_STRING);
  2153. case actasmtoken of
  2154. AS_COMMA: Consume(AS_COMMA);
  2155. AS_END,
  2156. AS_SEPARATOR: ;
  2157. else
  2158. Message(asmr_e_invalid_string_expression);
  2159. end; { end case }
  2160. ConcatString(curlist,expr);
  2161. end;
  2162. AS_INTNUM,
  2163. AS_PLUS,
  2164. AS_MINUS,
  2165. AS_LPAREN,
  2166. AS_TYPE,
  2167. AS_SIZEOF,
  2168. AS_NOT,
  2169. AS_VMTOFFSET,
  2170. AS_ID :
  2171. begin
  2172. inflags:=[];
  2173. BuildConstSymbolExpression(inflags,value,asmsym,asmsymtyp,sz,outflags);
  2174. if asmsym<>'' then
  2175. begin
  2176. if constsize<>sizeof(pint) then
  2177. Message(asmr_w_32bit_const_for_address);
  2178. ConcatConstSymbol(curlist,asmsym,asmsymtyp,value,constsize,true)
  2179. end
  2180. else
  2181. ConcatConstant(curlist,value,constsize);
  2182. end;
  2183. AS_COMMA:
  2184. Consume(AS_COMMA);
  2185. AS_END,
  2186. AS_SEPARATOR:
  2187. break;
  2188. else
  2189. begin
  2190. Message(asmr_e_syn_constant);
  2191. RecoverConsume(false);
  2192. end
  2193. end; { end case }
  2194. until false;
  2195. end;
  2196. procedure tz80reader.handleopcode;
  2197. var
  2198. instr: TZ80Instruction;
  2199. begin
  2200. instr:=TZ80Instruction.create(TZ80Operand);
  2201. BuildOpcode(instr);
  2202. with instr do
  2203. begin
  2204. //CheckNonCommutativeOpcodes;
  2205. //AddReferenceSizes;
  2206. //SetInstructionOpsize;
  2207. //CheckOperandSizes;
  2208. ConcatInstruction(curlist);
  2209. end;
  2210. instr.Free;
  2211. end;
  2212. procedure tz80reader.ConvertCalljmp(instr : tz80instruction);
  2213. var
  2214. newopr : toprrec;
  2215. begin
  2216. if instr.Operands[1].opr.typ=OPR_REFERENCE then
  2217. begin
  2218. newopr.typ:=OPR_SYMBOL;
  2219. newopr.symbol:=instr.Operands[1].opr.ref.symbol;
  2220. newopr.symofs:=instr.Operands[1].opr.ref.offset;
  2221. if (instr.Operands[1].opr.ref.base<>NR_NO) or
  2222. (instr.Operands[1].opr.ref.index<>NR_NO) then
  2223. Message(asmr_e_syn_operand);
  2224. instr.Operands[1].opr:=newopr;
  2225. end;
  2226. end;
  2227. function tz80reader.Assemble: tlinkedlist;
  2228. var
  2229. hl: tasmlabel;
  2230. sectionname: String;
  2231. section: tai_section;
  2232. begin
  2233. Message1(asmr_d_start_reading,'Z80');
  2234. firsttoken:=TRUE;
  2235. { sets up all opcode and register tables in uppercase }
  2236. if not _asmsorted then
  2237. begin
  2238. SetupTables;
  2239. _asmsorted:=TRUE;
  2240. end;
  2241. curlist:=TAsmList.Create;
  2242. { we might need to know which parameters are passed in registers }
  2243. if not parse_generic then
  2244. current_procinfo.generate_parameter_info;
  2245. { start tokenizer }
  2246. gettoken;
  2247. { main loop }
  2248. repeat
  2249. case actasmtoken of
  2250. AS_LLABEL:
  2251. Begin
  2252. if CreateLocalLabel(actasmpattern,hl,true) then
  2253. ConcatLabel(curlist,hl);
  2254. Consume(AS_LLABEL);
  2255. end;
  2256. AS_LABEL:
  2257. Begin
  2258. if SearchLabel(upper(actasmpattern),hl,true) then
  2259. begin
  2260. if hl.is_public then
  2261. ConcatPublic(curlist,actasmpattern_origcase);
  2262. ConcatLabel(curlist,hl);
  2263. end
  2264. else
  2265. Message1(asmr_e_unknown_label_identifier,actasmpattern);
  2266. Consume(AS_LABEL);
  2267. end;
  2268. AS_END:
  2269. begin
  2270. break; { end assembly block }
  2271. end;
  2272. AS_SEPARATOR:
  2273. begin
  2274. Consume(AS_SEPARATOR);
  2275. end;
  2276. AS_DEFB :
  2277. Begin
  2278. inexpression:=true;
  2279. Consume(AS_DEFB);
  2280. BuildConstant(1);
  2281. inexpression:=false;
  2282. end;
  2283. AS_DEFW :
  2284. Begin
  2285. inexpression:=true;
  2286. Consume(AS_DEFW);
  2287. BuildConstant(2);
  2288. inexpression:=false;
  2289. end;
  2290. AS_AREA :
  2291. begin
  2292. Consume(AS_AREA);
  2293. sectionname:=actasmpattern;
  2294. {secflags:=[];
  2295. secprogbits:=SPB_None;}
  2296. Consume(AS_STRING);
  2297. {if actasmtoken=AS_COMMA then
  2298. begin
  2299. Consume(AS_COMMA);
  2300. if actasmtoken=AS_STRING then
  2301. begin
  2302. case actasmpattern of
  2303. 'a':
  2304. Include(secflags,SF_A);
  2305. 'w':
  2306. Include(secflags,SF_W);
  2307. 'x':
  2308. Include(secflags,SF_X);
  2309. '':
  2310. ;
  2311. else
  2312. Message(asmr_e_syntax_error);
  2313. end;
  2314. Consume(AS_STRING);
  2315. if actasmtoken=AS_COMMA then
  2316. begin
  2317. Consume(AS_COMMA);
  2318. if (actasmtoken=AS_MOD) or (actasmtoken=AS_AT) then
  2319. begin
  2320. Consume(actasmtoken);
  2321. if actasmtoken=AS_ID then
  2322. begin
  2323. case actasmpattern of
  2324. 'PROGBITS':
  2325. secprogbits:=SPB_PROGBITS;
  2326. 'NOBITS':
  2327. secprogbits:=SPB_NOBITS;
  2328. 'NOTE':
  2329. secprogbits:=SPB_NOTE;
  2330. else
  2331. Message(asmr_e_syntax_error);
  2332. end;
  2333. Consume(AS_ID);
  2334. end
  2335. else
  2336. Message(asmr_e_syntax_error);
  2337. end
  2338. else
  2339. Message(asmr_e_syntax_error);
  2340. end;
  2341. end
  2342. else
  2343. Message(asmr_e_syntax_error);
  2344. end;}
  2345. //curList.concat(tai_section.create(sec_user, actasmpattern, 0));
  2346. section:=new_section(curlist, sec_user, sectionname, 0);
  2347. //section.secflags:=secflags;
  2348. //section.secprogbits:=secprogbits;
  2349. end;
  2350. AS_OPCODE:
  2351. begin
  2352. HandleOpCode;
  2353. end;
  2354. else
  2355. begin
  2356. Message(asmr_e_syntax_error);
  2357. RecoverConsume(false);
  2358. end;
  2359. end;
  2360. until false;
  2361. { check that all referenced local labels are defined }
  2362. checklocallabels;
  2363. { Return the list in an asmnode }
  2364. assemble:=curlist;
  2365. Message1(asmr_d_finish_reading,'Z80');
  2366. end;
  2367. {*****************************************************************************
  2368. Initialize
  2369. *****************************************************************************}
  2370. const
  2371. { asmmode_z80_att_info : tasmmodeinfo =
  2372. (
  2373. id : asmmode_z80_gas;
  2374. idtxt : 'GAS';
  2375. casmreader : tz80attreader;
  2376. );}
  2377. asmmode_z80_standard_info : tasmmodeinfo =
  2378. (
  2379. id : asmmode_standard;
  2380. idtxt : 'STANDARD';
  2381. casmreader : tz80reader;
  2382. );
  2383. initialization
  2384. // RegisterAsmMode(asmmode_z80_att_info);
  2385. RegisterAsmMode(asmmode_z80_standard_info);
  2386. end.