raz80asm.pas 83 KB

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