raz80asm.pas 83 KB

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