cg68kinl.pas 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate m68k inline nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit cg68kinl;
  19. interface
  20. uses
  21. tree;
  22. procedure secondinline(var p : ptree);
  23. implementation
  24. uses
  25. cobjects,verbose,globals,systems,
  26. aasm,types,symtable,
  27. hcodegen,temp_gen,pass_2,
  28. m68k,cga68k,tgen68k,cg68kld,cg68kcal;
  29. {*****************************************************************************
  30. Helpers
  31. *****************************************************************************}
  32. { reverts the parameter list }
  33. var nb_para : integer;
  34. function reversparameter(p : ptree) : ptree;
  35. var
  36. hp1,hp2 : ptree;
  37. begin
  38. hp1:=nil;
  39. nb_para := 0;
  40. while assigned(p) do
  41. begin
  42. { pull out }
  43. hp2:=p;
  44. p:=p^.right;
  45. inc(nb_para);
  46. { pull in }
  47. hp2^.right:=hp1;
  48. hp1:=hp2;
  49. end;
  50. reversparameter:=hp1;
  51. end;
  52. {*****************************************************************************
  53. SecondInLine
  54. *****************************************************************************}
  55. procedure secondinline(var p : ptree);
  56. const
  57. { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
  58. float_name: array[tfloattype] of string[8]=
  59. ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
  60. addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADDQ,A_SUBQ);
  61. var
  62. aktfile : treference;
  63. ft : tfiletype;
  64. opsize : topsize;
  65. asmop : tasmop;
  66. pushed : tpushed;
  67. {inc/dec}
  68. addconstant : boolean;
  69. addvalue : longint;
  70. procedure handlereadwrite(doread,doln : boolean);
  71. { produces code for READ(LN) and WRITE(LN) }
  72. procedure loadstream;
  73. const
  74. io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
  75. var
  76. r : preference;
  77. begin
  78. new(r);
  79. reset_reference(r^);
  80. r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
  81. concat_external(r^.symbol^,EXT_NEAR);
  82. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,r,R_A0)))
  83. end;
  84. var
  85. node,hp : ptree;
  86. typedtyp,
  87. pararesult : pdef;
  88. has_length : boolean;
  89. dummycoll : tdefcoll;
  90. iolabel : plabel;
  91. npara : longint;
  92. begin
  93. { I/O check }
  94. if cs_check_io in aktlocalswitches then
  95. begin
  96. getlabel(iolabel);
  97. emitl(A_LABEL,iolabel);
  98. end
  99. else
  100. iolabel:=nil;
  101. { for write of real with the length specified }
  102. has_length:=false;
  103. hp:=nil;
  104. { reserve temporary pointer to data variable }
  105. aktfile.symbol:=nil;
  106. gettempofsizereference(4,aktfile);
  107. { first state text data }
  108. ft:=ft_text;
  109. { and state a parameter ? }
  110. if p^.left=nil then
  111. begin
  112. { the following instructions are for "writeln;" }
  113. loadstream;
  114. { save @aktfile in temporary variable }
  115. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
  116. end
  117. else
  118. begin
  119. { revers paramters }
  120. node:=reversparameter(p^.left);
  121. p^.left := node;
  122. npara := nb_para;
  123. { calculate data variable }
  124. { is first parameter a file type ? }
  125. if node^.left^.resulttype^.deftype=filedef then
  126. begin
  127. ft:=pfiledef(node^.left^.resulttype)^.filetype;
  128. if ft=ft_typed then
  129. typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
  130. secondpass(node^.left);
  131. if codegenerror then
  132. exit;
  133. { save reference in temporary variables }
  134. if node^.left^.location.loc<>LOC_REFERENCE then
  135. begin
  136. Message(cg_e_illegal_expression);
  137. exit;
  138. end;
  139. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_A0)));
  140. { skip to the next parameter }
  141. node:=node^.right;
  142. end
  143. else
  144. begin
  145. { load stdin/stdout stream }
  146. loadstream;
  147. end;
  148. { save @aktfile in temporary variable }
  149. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
  150. if doread then
  151. { parameter by READ gives call by reference }
  152. dummycoll.paratyp:=vs_var
  153. { an WRITE Call by "Const" }
  154. else
  155. dummycoll.paratyp:=vs_const;
  156. { because of secondcallparan, which otherwise attaches }
  157. if ft=ft_typed then
  158. { this is to avoid copy of simple const parameters }
  159. dummycoll.data:=new(pformaldef,init)
  160. else
  161. { I think, this isn't a good solution (FK) }
  162. dummycoll.data:=nil;
  163. while assigned(node) do
  164. begin
  165. pushusedregisters(pushed,$ff);
  166. hp:=node;
  167. node:=node^.right;
  168. hp^.right:=nil;
  169. if hp^.is_colon_para then
  170. Message(parser_e_illegal_colon_qualifier);
  171. if ft=ft_typed then
  172. never_copy_const_param:=true;
  173. secondcallparan(hp,@dummycoll,false);
  174. if ft=ft_typed then
  175. never_copy_const_param:=false;
  176. hp^.right:=node;
  177. if codegenerror then
  178. exit;
  179. emit_push_mem(aktfile);
  180. if (ft=ft_typed) then
  181. begin
  182. { OK let's try this }
  183. { first we must only allow the right type }
  184. { we have to call blockread or blockwrite }
  185. { but the real problem is that }
  186. { reset and rewrite should have set }
  187. { the type size }
  188. { as recordsize for that file !!!! }
  189. { how can we make that }
  190. { I think that is only possible by adding }
  191. { reset and rewrite to the inline list a call }
  192. { allways read only one record by element }
  193. push_int(typedtyp^.size);
  194. if doread then
  195. emitcall('TYPED_READ',true)
  196. else
  197. emitcall('TYPED_WRITE',true);
  198. end
  199. else
  200. begin
  201. { save current position }
  202. pararesult:=hp^.left^.resulttype;
  203. { handle possible field width }
  204. { of course only for write(ln) }
  205. if not doread then
  206. begin
  207. { handle total width parameter }
  208. if assigned(node) and node^.is_colon_para then
  209. begin
  210. hp:=node;
  211. node:=node^.right;
  212. hp^.right:=nil;
  213. secondcallparan(hp,@dummycoll,false);
  214. hp^.right:=node;
  215. if codegenerror then
  216. exit;
  217. has_length:=true;
  218. end
  219. else
  220. if pararesult^.deftype<>floatdef then
  221. push_int(0)
  222. else
  223. push_int(-32767);
  224. { a second colon para for a float ? }
  225. if assigned(node) and node^.is_colon_para then
  226. begin
  227. hp:=node;
  228. node:=node^.right;
  229. hp^.right:=nil;
  230. secondcallparan(hp,@dummycoll,false);
  231. hp^.right:=node;
  232. if pararesult^.deftype<>floatdef then
  233. Message(parser_e_illegal_colon_qualifier);
  234. if codegenerror then
  235. exit;
  236. end
  237. else
  238. begin
  239. if pararesult^.deftype=floatdef then
  240. push_int(-1);
  241. end
  242. end;
  243. case pararesult^.deftype of
  244. stringdef : begin
  245. if doread then
  246. begin
  247. { push maximum string length }
  248. push_int(pstringdef(pararesult)^.len);
  249. case pstringdef(pararesult)^.string_typ of
  250. st_shortstring:
  251. emitcall ('READ_TEXT_STRING',true);
  252. st_ansistring:
  253. emitcall ('READ_TEXT_ANSISTRING',true);
  254. st_longstring:
  255. emitcall ('READ_TEXT_LONGSTRING',true);
  256. st_widestring:
  257. emitcall ('READ_TEXT_ANSISTRING',true);
  258. end
  259. end
  260. else
  261. Case pstringdef(Pararesult)^.string_typ of
  262. st_shortstring:
  263. emitcall ('WRITE_TEXT_STRING',true);
  264. st_ansistring:
  265. emitcall ('WRITE_TEXT_ANSISTRING',true);
  266. st_longstring:
  267. emitcall ('WRITE_TEXT_LONGSTRING',true);
  268. st_widestring:
  269. emitcall ('WRITE_TEXT_ANSISTRING',true);
  270. end;
  271. end;
  272. pointerdef : begin
  273. if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
  274. begin
  275. if doread then
  276. emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
  277. else
  278. emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
  279. end
  280. else
  281. Message(parser_e_illegal_parameter_list);
  282. end;
  283. arraydef : begin
  284. if (parraydef(pararesult)^.lowrange=0) and
  285. is_equal(parraydef(pararesult)^.definition,cchardef) then
  286. begin
  287. if doread then
  288. emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
  289. else
  290. emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
  291. end
  292. else
  293. Message(parser_e_illegal_parameter_list);
  294. end;
  295. floatdef : begin
  296. if doread then
  297. emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
  298. else
  299. emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
  300. end;
  301. orddef : begin
  302. case porddef(pararesult)^.typ of
  303. u8bit : if doread then
  304. emitcall('READ_TEXT_BYTE',true);
  305. s8bit : if doread then
  306. emitcall('READ_TEXT_SHORTINT',true);
  307. u16bit : if doread then
  308. emitcall('READ_TEXT_WORD',true);
  309. s16bit : if doread then
  310. emitcall('READ_TEXT_INTEGER',true);
  311. s32bit : if doread then
  312. emitcall('READ_TEXT_LONGINT',true)
  313. else
  314. emitcall('WRITE_TEXT_LONGINT',true);
  315. u32bit : if doread then
  316. emitcall('READ_TEXT_CARDINAL',true)
  317. else
  318. emitcall('WRITE_TEXT_CARDINAL',true);
  319. uchar : if doread then
  320. emitcall('READ_TEXT_CHAR',true)
  321. else
  322. emitcall('WRITE_TEXT_CHAR',true);
  323. bool8bit,
  324. bool16bit,
  325. bool32bit : if doread then
  326. { emitcall('READ_TEXT_BOOLEAN',true) }
  327. Message(parser_e_illegal_parameter_list)
  328. else
  329. emitcall('WRITE_TEXT_BOOLEAN',true);
  330. else
  331. Message(parser_e_illegal_parameter_list);
  332. end;
  333. end;
  334. else
  335. Message(parser_e_illegal_parameter_list);
  336. end;
  337. end;
  338. { load ESI in methods again }
  339. popusedregisters(pushed);
  340. maybe_loada5;
  341. end;
  342. end;
  343. { Insert end of writing for textfiles }
  344. if ft=ft_text then
  345. begin
  346. pushusedregisters(pushed,$ff);
  347. emit_push_mem(aktfile);
  348. if doread then
  349. begin
  350. if doln then
  351. emitcall('READLN_END',true)
  352. else
  353. emitcall('READ_END',true);
  354. end
  355. else
  356. begin
  357. if doln then
  358. emitcall('WRITELN_END',true)
  359. else
  360. emitcall('WRITE_END',true);
  361. end;
  362. popusedregisters(pushed);
  363. maybe_loada5;
  364. end;
  365. { Insert IOCheck if set }
  366. if assigned(iolabel) then
  367. begin
  368. { registers are saved in the procedure }
  369. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
  370. emitcall('IOCHECK',true);
  371. end;
  372. { Freeup all used temps }
  373. ungetiftemp(aktfile);
  374. if assigned(p^.left) then
  375. begin
  376. p^.left:=reversparameter(p^.left);
  377. if npara<>nb_para then
  378. Message(cg_f_internal_error_in_secondinline);
  379. hp:=p^.left;
  380. while assigned(hp) do
  381. begin
  382. if assigned(hp^.left) then
  383. if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  384. ungetiftemp(hp^.left^.location.reference);
  385. hp:=hp^.right;
  386. end;
  387. end;
  388. end;
  389. procedure handle_str;
  390. var
  391. hp,node : ptree;
  392. dummycoll : tdefcoll;
  393. is_real,has_length : boolean;
  394. begin
  395. pushusedregisters(pushed,$ff);
  396. node:=p^.left;
  397. is_real:=false;
  398. has_length:=false;
  399. while assigned(node^.right) do node:=node^.right;
  400. { if a real parameter somewhere then call REALSTR }
  401. if (node^.left^.resulttype^.deftype=floatdef) then
  402. is_real:=true;
  403. node:=p^.left;
  404. { we have at least two args }
  405. { with at max 2 colon_para in between }
  406. { first arg longint or float }
  407. hp:=node;
  408. node:=node^.right;
  409. hp^.right:=nil;
  410. dummycoll.data:=hp^.resulttype;
  411. { string arg }
  412. dummycoll.paratyp:=vs_var;
  413. secondcallparan(hp,@dummycoll,false);
  414. if codegenerror then
  415. exit;
  416. dummycoll.paratyp:=vs_const;
  417. { second arg }
  418. hp:=node;
  419. node:=node^.right;
  420. hp^.right:=nil;
  421. { frac para }
  422. if hp^.is_colon_para and assigned(node) and
  423. node^.is_colon_para then
  424. begin
  425. dummycoll.data:=hp^.resulttype;
  426. secondcallparan(hp,@dummycoll,false);
  427. if codegenerror then
  428. exit;
  429. hp:=node;
  430. node:=node^.right;
  431. hp^.right:=nil;
  432. has_length:=true;
  433. end
  434. else
  435. if is_real then
  436. push_int(-1);
  437. { third arg, length only if is_real }
  438. if hp^.is_colon_para then
  439. begin
  440. dummycoll.data:=hp^.resulttype;
  441. secondcallparan(hp,@dummycoll,false);
  442. if codegenerror then
  443. exit;
  444. hp:=node;
  445. node:=node^.right;
  446. hp^.right:=nil;
  447. end
  448. else
  449. if is_real then
  450. push_int(-32767)
  451. else
  452. push_int(-1);
  453. { last arg longint or real }
  454. secondcallparan(hp,@dummycoll,false);
  455. if codegenerror then
  456. exit;
  457. if is_real then
  458. emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
  459. else if porddef(hp^.resulttype)^.typ=u32bit then
  460. emitcall('STR_CARDINAL',true)
  461. else
  462. emitcall('STR_LONGINT',true);
  463. popusedregisters(pushed);
  464. end;
  465. var
  466. r : preference;
  467. l : longint;
  468. ispushed : boolean;
  469. hregister : tregister;
  470. otlabel,oflabel,filenamestring : plabel;
  471. begin
  472. case p^.inlinenumber of
  473. in_assert_x:
  474. begin
  475. { !!!!!!!!! }
  476. (* otlabel:=truelabel;
  477. oflabel:=falselabel;
  478. getlabel(truelabel);
  479. getlabel(falselabel);
  480. getlabel(filenamestring);
  481. secondpass(p^.left);
  482. if codegenerror then
  483. exit;
  484. if cs_do_assertion in aktlocalswitches then
  485. begin
  486. maketojumpbool(p^.left);
  487. emitl(A_LABEL,falselabel);
  488. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
  489. p^.fileinfo.line)));
  490. { generate string }
  491. { push string
  492. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
  493. p^.fileinfo.line)));
  494. }
  495. emitcall('FPC_DO_ASSERT',true);
  496. emitl(A_LABEL,truelabel);
  497. end;
  498. truelabel:=otlabel;
  499. falselabel:=oflabel; *)
  500. end;
  501. in_lo_word,
  502. in_hi_word :
  503. begin
  504. secondpass(p^.left);
  505. p^.location.loc:=LOC_REGISTER;
  506. if p^.left^.location.loc<>LOC_REGISTER then
  507. begin
  508. if p^.left^.location.loc=LOC_CREGISTER then
  509. begin
  510. p^.location.register:=getregister32;
  511. emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,
  512. p^.location.register);
  513. end
  514. else
  515. begin
  516. del_reference(p^.left^.location.reference);
  517. p^.location.register:=getregister32;
  518. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  519. newreference(p^.left^.location.reference),
  520. p^.location.register)));
  521. end;
  522. end
  523. else p^.location.register:=p^.left^.location.register;
  524. if p^.inlinenumber=in_hi_word then
  525. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSR,S_W,8,p^.location.register)));
  526. p^.location.register:=p^.location.register;
  527. end;
  528. in_high_x :
  529. begin
  530. if is_open_array(p^.left^.resulttype) then
  531. begin
  532. secondpass(p^.left);
  533. del_reference(p^.left^.location.reference);
  534. p^.location.register:=getregister32;
  535. new(r);
  536. reset_reference(r^);
  537. r^.base:=highframepointer;
  538. r^.offset:=highoffset+4;
  539. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  540. r,p^.location.register)));
  541. end
  542. end;
  543. in_sizeof_x,
  544. in_typeof_x :
  545. begin
  546. { sizeof(openarray) handling }
  547. if (p^.inlinenumber=in_sizeof_x) and
  548. is_open_array(p^.left^.resulttype) then
  549. begin
  550. { sizeof(openarray)=high(openarray)+1 }
  551. secondpass(p^.left);
  552. del_reference(p^.left^.location.reference);
  553. p^.location.register:=getregister32;
  554. new(r);
  555. reset_reference(r^);
  556. r^.base:=highframepointer;
  557. r^.offset:=highoffset+4;
  558. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  559. r,p^.location.register)));
  560. exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,
  561. 1,p^.location.register)));
  562. if parraydef(p^.left^.resulttype)^.elesize<>1 then
  563. exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,
  564. parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
  565. end
  566. else
  567. begin
  568. { for both cases load vmt }
  569. if p^.left^.treetype=typen then
  570. begin
  571. exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,
  572. S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
  573. R_A0)));
  574. p^.location.register:=getregister32;
  575. emit_reg_reg(A_MOVE,S_L,R_A0,p^.location.register);
  576. end
  577. else
  578. begin
  579. secondpass(p^.left);
  580. del_reference(p^.left^.location.reference);
  581. p^.location.loc:=LOC_REGISTER;
  582. p^.location.register:=getregister32;
  583. { load VMT pointer }
  584. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  585. newreference(p^.left^.location.reference),
  586. p^.location.register)));
  587. end;
  588. { in sizeof load size }
  589. if p^.inlinenumber=in_sizeof_x then
  590. begin
  591. new(r);
  592. reset_reference(r^);
  593. { load the address in A0 }
  594. { because now supposedly p^.location.register is an }
  595. { address. }
  596. emit_reg_reg(A_MOVE, S_L, p^.location.register, R_A0);
  597. r^.base:=R_A0;
  598. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,
  599. p^.location.register)));
  600. end;
  601. end;
  602. end;
  603. in_lo_long,
  604. in_hi_long : begin
  605. secondpass(p^.left);
  606. p^.location.loc:=LOC_REGISTER;
  607. if p^.left^.location.loc<>LOC_REGISTER then
  608. begin
  609. if p^.left^.location.loc=LOC_CREGISTER then
  610. begin
  611. p^.location.register:=getregister32;
  612. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
  613. p^.location.register);
  614. end
  615. else
  616. begin
  617. del_reference(p^.left^.location.reference);
  618. p^.location.register:=getregister32;
  619. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  620. newreference(p^.left^.location.reference),
  621. p^.location.register)));
  622. end;
  623. end
  624. else p^.location.register:=p^.left^.location.register;
  625. if p^.inlinenumber=in_hi_long then
  626. begin
  627. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ, S_L, 16, R_D1)));
  628. exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSR,S_L,R_D1,p^.location.register)));
  629. end;
  630. p^.location.register:=p^.location.register;
  631. end;
  632. in_length_string :
  633. begin
  634. secondpass(p^.left);
  635. set_location(p^.location,p^.left^.location);
  636. { length in ansi strings is at offset -8 }
  637. {$ifdef UseAnsiString}
  638. if is_ansistring(p^.left^.resulttype) then
  639. dec(p^.location.reference.offset,8);
  640. {$endif UseAnsiString}
  641. end;
  642. in_pred_x,
  643. in_succ_x:
  644. begin
  645. secondpass(p^.left);
  646. if p^.inlinenumber=in_pred_x then
  647. asmop:=A_SUB
  648. else
  649. asmop:=A_ADD;
  650. case p^.resulttype^.size of
  651. 4 : opsize:=S_L;
  652. 2 : opsize:=S_W;
  653. 1 : opsize:=S_B;
  654. else
  655. internalerror(10080);
  656. end;
  657. p^.location.loc:=LOC_REGISTER;
  658. if p^.left^.location.loc<>LOC_REGISTER then
  659. begin
  660. p^.location.register:=getregister32;
  661. if p^.left^.location.loc=LOC_CREGISTER then
  662. emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
  663. p^.location.register)
  664. else
  665. if p^.left^.location.loc=LOC_FLAGS then
  666. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
  667. p^.location.register)))
  668. else
  669. begin
  670. del_reference(p^.left^.location.reference);
  671. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.left^.location.reference),
  672. p^.location.register)));
  673. end;
  674. end
  675. else p^.location.register:=p^.left^.location.register;
  676. exprasmlist^.concat(new(pai68k,op_const_reg(asmop,opsize,1,
  677. p^.location.register)))
  678. { here we should insert bounds check ? }
  679. { and direct call to bounds will crash the program }
  680. { if we are at the limit }
  681. { we could also simply say that pred(first)=first and succ(last)=last }
  682. { could this be usefull I don't think so (PM)
  683. emitoverflowcheck;}
  684. end;
  685. in_dec_x,
  686. in_inc_x :
  687. begin
  688. { set defaults }
  689. addvalue:=1;
  690. addconstant:=true;
  691. { load first parameter, must be a reference }
  692. secondpass(p^.left^.left);
  693. case p^.left^.left^.resulttype^.deftype of
  694. orddef,
  695. enumdef : begin
  696. case p^.left^.left^.resulttype^.size of
  697. 1 : opsize:=S_B;
  698. 2 : opsize:=S_W;
  699. 4 : opsize:=S_L;
  700. end;
  701. end;
  702. pointerdef : begin
  703. opsize:=S_L;
  704. addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
  705. end;
  706. else
  707. internalerror(10081);
  708. end;
  709. { second argument specified?, must be a s32bit in register }
  710. if assigned(p^.left^.right) then
  711. begin
  712. secondpass(p^.left^.right^.left);
  713. { when constant, just multiply the addvalue }
  714. if is_constintnode(p^.left^.right^.left) then
  715. addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
  716. else
  717. begin
  718. case p^.left^.right^.left^.location.loc of
  719. LOC_REGISTER,
  720. LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
  721. LOC_MEM,
  722. LOC_REFERENCE : begin
  723. hregister:=getregister32;
  724. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  725. newreference(p^.left^.right^.left^.location.reference),hregister)));
  726. end;
  727. else
  728. internalerror(10082);
  729. end;
  730. { insert multiply with addvalue if its >1 }
  731. if addvalue>1 then
  732. exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,opsize,
  733. addvalue,hregister)));
  734. addconstant:=false;
  735. end;
  736. end;
  737. { write the add instruction }
  738. if addconstant then
  739. begin
  740. exprasmlist^.concat(new(pai68k,op_const_ref(addsubop[p^.inlinenumber],opsize,
  741. addvalue,newreference(p^.left^.left^.location.reference))));
  742. end
  743. else
  744. begin
  745. exprasmlist^.concat(new(pai68k,op_reg_ref(addsubop[p^.inlinenumber],opsize,
  746. hregister,newreference(p^.left^.left^.location.reference))));
  747. ungetregister32(hregister);
  748. end;
  749. emitoverflowcheck(p^.left^.left);
  750. end;
  751. in_assigned_x :
  752. begin
  753. secondpass(p^.left^.left);
  754. p^.location.loc:=LOC_FLAGS;
  755. if (p^.left^.left^.location.loc=LOC_REGISTER) or
  756. (p^.left^.left^.location.loc=LOC_CREGISTER) then
  757. begin
  758. exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,
  759. p^.left^.left^.location.register)));
  760. ungetregister32(p^.left^.left^.location.register);
  761. end
  762. else
  763. begin
  764. exprasmlist^.concat(new(pai68k,op_ref(A_TST,S_L,
  765. newreference(p^.left^.left^.location.reference))));
  766. del_reference(p^.left^.left^.location.reference);
  767. end;
  768. p^.location.resflags:=F_NE;
  769. end;
  770. in_reset_typedfile,in_rewrite_typedfile :
  771. begin
  772. pushusedregisters(pushed,$ffff);
  773. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,
  774. pfiledef(p^.left^.resulttype)^.typed_as^.size,R_SPPUSH)));
  775. secondload(p^.left);
  776. emitpushreferenceaddr(p^.left^.location.reference);
  777. if p^.inlinenumber=in_reset_typedfile then
  778. emitcall('RESET_TYPED',true)
  779. else
  780. emitcall('REWRITE_TYPED',true);
  781. popusedregisters(pushed);
  782. end;
  783. in_write_x :
  784. handlereadwrite(false,false);
  785. in_writeln_x :
  786. handlereadwrite(false,true);
  787. in_read_x :
  788. handlereadwrite(true,false);
  789. in_readln_x :
  790. handlereadwrite(true,true);
  791. in_str_x_string :
  792. begin
  793. handle_str;
  794. maybe_loada5;
  795. end;
  796. in_include_x_y,
  797. in_exclude_x_y:
  798. begin
  799. { !!!!!!! }
  800. (* secondpass(p^.left^.left);
  801. if p^.left^.right^.left^.treetype=ordconstn then
  802. begin
  803. { calculate bit position }
  804. l:=1 shl (p^.left^.right^.left^.value mod 32);
  805. { determine operator }
  806. if p^.inlinenumber=in_include_x_y then
  807. asmop:=A_OR
  808. else
  809. begin
  810. asmop:=A_AND;
  811. l:=not(l);
  812. end;
  813. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  814. begin
  815. inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
  816. exprasmlist^.concat(new(pai68k,op_const_ref(asmop,S_L,
  817. l,newreference(p^.left^.left^.location.reference))));
  818. del_reference(p^.left^.left^.location.reference);
  819. end
  820. else
  821. { LOC_CREGISTER }
  822. exprasmlist^.concat(new(pai68k,op_const_reg(asmop,S_L,
  823. l,p^.left^.left^.location.register)));
  824. end
  825. else
  826. begin
  827. { generate code for the element to set }
  828. ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
  829. secondpass(p^.left^.right^.left);
  830. if ispushed then
  831. restore(p^.left^.left);
  832. { determine asm operator }
  833. if p^.inlinenumber=in_include_x_y then
  834. asmop:=A_BTS
  835. else
  836. asmop:=A_BTR;
  837. if psetdef(p^.left^.resulttype)^.settype=smallset then
  838. begin
  839. if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
  840. hregister:=p^.left^.right^.left^.location.register
  841. else
  842. begin
  843. hregister:=R_EDI;
  844. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  845. newreference(p^.left^.right^.left^.location.reference),R_EDI)));
  846. end;
  847. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  848. exprasmlist^.concat(new(pai386,op_reg_ref(asmop,S_L,R_EDI,
  849. newreference(p^.left^.right^.left^.location.reference))))
  850. else
  851. exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,R_EDI,
  852. p^.left^.right^.left^.location.register)));
  853. end
  854. else
  855. begin
  856. end;
  857. end;
  858. *)
  859. end;
  860. else
  861. internalerror(9);
  862. end;
  863. end;
  864. end.
  865. {
  866. $Log$
  867. Revision 1.1 1998-09-01 09:07:09 peter
  868. * m68k fixes, splitted cg68k like cgi386
  869. }