cg386inl.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 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 cg386inl;
  19. interface
  20. uses
  21. tree;
  22. procedure secondinline(var p : ptree);
  23. implementation
  24. uses
  25. cobjects,verbose,globals,systems,
  26. aasm,i386,types,symtable,
  27. cgi386,cgai386,temp_gen,tgeni386,hcodegen,
  28. cg386ld,cg386cal;
  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. incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC);
  61. addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
  62. var
  63. aktfile : treference;
  64. ft : tfiletype;
  65. opsize : topsize;
  66. asmop : tasmop;
  67. pushed : tpushed;
  68. {inc/dec}
  69. addconstant : boolean;
  70. addvalue : longint;
  71. procedure handlereadwrite(doread,doln : boolean);
  72. { produces code for READ(LN) and WRITE(LN) }
  73. procedure loadstream;
  74. const
  75. io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
  76. var
  77. r : preference;
  78. begin
  79. new(r);
  80. reset_reference(r^);
  81. r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
  82. concat_external(r^.symbol^,EXT_NEAR);
  83. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
  84. end;
  85. var
  86. node,hp : ptree;
  87. typedtyp,
  88. pararesult : pdef;
  89. has_length : boolean;
  90. dummycoll : tdefcoll;
  91. iolabel : plabel;
  92. npara : longint;
  93. begin
  94. { I/O check }
  95. if cs_check_io in aktlocalswitches then
  96. begin
  97. getlabel(iolabel);
  98. emitl(A_LABEL,iolabel);
  99. end
  100. else
  101. iolabel:=nil;
  102. { for write of real with the length specified }
  103. has_length:=false;
  104. hp:=nil;
  105. { reserve temporary pointer to data variable }
  106. aktfile.symbol:=nil;
  107. gettempofsizereference(4,aktfile);
  108. { first state text data }
  109. ft:=ft_text;
  110. { and state a parameter ? }
  111. if p^.left=nil then
  112. begin
  113. { the following instructions are for "writeln;" }
  114. loadstream;
  115. { save @aktfile in temporary variable }
  116. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  117. end
  118. else
  119. begin
  120. { revers paramters }
  121. node:=reversparameter(p^.left);
  122. p^.left := node;
  123. npara := nb_para;
  124. { calculate data variable }
  125. { is first parameter a file type ? }
  126. if node^.left^.resulttype^.deftype=filedef then
  127. begin
  128. ft:=pfiledef(node^.left^.resulttype)^.filetype;
  129. if ft=ft_typed then
  130. typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
  131. secondpass(node^.left);
  132. if codegenerror then
  133. exit;
  134. { save reference in temporary variables }
  135. if node^.left^.location.loc<>LOC_REFERENCE then
  136. begin
  137. Message(cg_e_illegal_expression);
  138. exit;
  139. end;
  140. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_EDI)));
  141. { skip to the next parameter }
  142. node:=node^.right;
  143. end
  144. else
  145. begin
  146. { load stdin/stdout stream }
  147. loadstream;
  148. end;
  149. { save @aktfile in temporary variable }
  150. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  151. if doread then
  152. { parameter by READ gives call by reference }
  153. dummycoll.paratyp:=vs_var
  154. { an WRITE Call by "Const" }
  155. else
  156. dummycoll.paratyp:=vs_const;
  157. { because of secondcallparan, which otherwise attaches }
  158. if ft=ft_typed then
  159. { this is to avoid copy of simple const parameters }
  160. dummycoll.data:=new(pformaldef,init)
  161. else
  162. { I think, this isn't a good solution (FK) }
  163. dummycoll.data:=nil;
  164. while assigned(node) do
  165. begin
  166. pushusedregisters(pushed,$ff);
  167. hp:=node;
  168. node:=node^.right;
  169. hp^.right:=nil;
  170. if hp^.is_colon_para then
  171. Message(parser_e_illegal_colon_qualifier);
  172. if ft=ft_typed then
  173. never_copy_const_param:=true;
  174. secondcallparan(hp,@dummycoll,false,false,0);
  175. if ft=ft_typed then
  176. never_copy_const_param:=false;
  177. hp^.right:=node;
  178. if codegenerror then
  179. exit;
  180. emit_push_mem(aktfile);
  181. if (ft=ft_typed) then
  182. begin
  183. { OK let's try this }
  184. { first we must only allow the right type }
  185. { we have to call blockread or blockwrite }
  186. { but the real problem is that }
  187. { reset and rewrite should have set }
  188. { the type size }
  189. { as recordsize for that file !!!! }
  190. { how can we make that }
  191. { I think that is only possible by adding }
  192. { reset and rewrite to the inline list a call }
  193. { allways read only one record by element }
  194. push_int(typedtyp^.size);
  195. if doread then
  196. emitcall('TYPED_READ',true)
  197. else
  198. emitcall('TYPED_WRITE',true);
  199. end
  200. else
  201. begin
  202. { save current position }
  203. pararesult:=hp^.left^.resulttype;
  204. { handle possible field width }
  205. { of course only for write(ln) }
  206. if not doread then
  207. begin
  208. { handle total width parameter }
  209. if assigned(node) and node^.is_colon_para then
  210. begin
  211. hp:=node;
  212. node:=node^.right;
  213. hp^.right:=nil;
  214. secondcallparan(hp,@dummycoll,false,false,0);
  215. hp^.right:=node;
  216. if codegenerror then
  217. exit;
  218. has_length:=true;
  219. end
  220. else
  221. if pararesult^.deftype<>floatdef then
  222. push_int(0)
  223. else
  224. push_int(-32767);
  225. { a second colon para for a float ? }
  226. if assigned(node) and node^.is_colon_para then
  227. begin
  228. hp:=node;
  229. node:=node^.right;
  230. hp^.right:=nil;
  231. secondcallparan(hp,@dummycoll,false,false,0);
  232. hp^.right:=node;
  233. if pararesult^.deftype<>floatdef then
  234. Message(parser_e_illegal_colon_qualifier);
  235. if codegenerror then
  236. exit;
  237. end
  238. else
  239. begin
  240. if pararesult^.deftype=floatdef then
  241. push_int(-1);
  242. end
  243. end;
  244. case pararesult^.deftype of
  245. stringdef : begin
  246. if doread then
  247. begin
  248. { push maximum string length }
  249. push_int(pstringdef(pararesult)^.len);
  250. case pstringdef(pararesult)^.string_typ of
  251. st_shortstring:
  252. emitcall ('READ_TEXT_STRING',true);
  253. st_ansistring:
  254. emitcall ('READ_TEXT_ANSISTRING',true);
  255. st_longstring:
  256. emitcall ('READ_TEXT_LONGSTRING',true);
  257. st_widestring:
  258. emitcall ('READ_TEXT_ANSISTRING',true);
  259. end
  260. end
  261. else
  262. Case pstringdef(Pararesult)^.string_typ of
  263. st_shortstring:
  264. emitcall ('WRITE_TEXT_STRING',true);
  265. st_ansistring:
  266. emitcall ('WRITE_TEXT_ANSISTRING',true);
  267. st_longstring:
  268. emitcall ('WRITE_TEXT_LONGSTRING',true);
  269. st_widestring:
  270. emitcall ('WRITE_TEXT_ANSISTRING',true);
  271. end;
  272. end;
  273. pointerdef : begin
  274. if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
  275. begin
  276. if doread then
  277. emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
  278. else
  279. emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
  280. end;
  281. end;
  282. arraydef : begin
  283. if (parraydef(pararesult)^.lowrange=0) and
  284. is_equal(parraydef(pararesult)^.definition,cchardef) then
  285. begin
  286. if doread then
  287. emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
  288. else
  289. emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
  290. end;
  291. end;
  292. floatdef : begin
  293. if doread then
  294. emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
  295. else
  296. emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
  297. end;
  298. orddef : begin
  299. case porddef(pararesult)^.typ of
  300. u8bit : if doread then
  301. emitcall('READ_TEXT_BYTE',true);
  302. s8bit : if doread then
  303. emitcall('READ_TEXT_SHORTINT',true);
  304. u16bit : if doread then
  305. emitcall('READ_TEXT_WORD',true);
  306. s16bit : if doread then
  307. emitcall('READ_TEXT_INTEGER',true);
  308. s32bit : if doread then
  309. emitcall('READ_TEXT_LONGINT',true)
  310. else
  311. emitcall('WRITE_TEXT_LONGINT',true);
  312. u32bit : if doread then
  313. emitcall('READ_TEXT_CARDINAL',true)
  314. else
  315. emitcall('WRITE_TEXT_CARDINAL',true);
  316. uchar : if doread then
  317. emitcall('READ_TEXT_CHAR',true)
  318. else
  319. emitcall('WRITE_TEXT_CHAR',true);
  320. bool8bit,
  321. bool16bit,
  322. bool32bit : if doread then
  323. { emitcall('READ_TEXT_BOOLEAN',true) }
  324. Message(parser_e_illegal_parameter_list)
  325. else
  326. emitcall('WRITE_TEXT_BOOLEAN',true);
  327. end;
  328. end;
  329. end;
  330. end;
  331. { load ESI in methods again }
  332. popusedregisters(pushed);
  333. maybe_loadesi;
  334. end;
  335. end;
  336. { Insert end of writing for textfiles }
  337. if ft=ft_text then
  338. begin
  339. pushusedregisters(pushed,$ff);
  340. emit_push_mem(aktfile);
  341. if doread then
  342. begin
  343. if doln then
  344. emitcall('READLN_END',true)
  345. else
  346. emitcall('READ_END',true);
  347. end
  348. else
  349. begin
  350. if doln then
  351. emitcall('WRITELN_END',true)
  352. else
  353. emitcall('WRITE_END',true);
  354. end;
  355. popusedregisters(pushed);
  356. maybe_loadesi;
  357. end;
  358. { Insert IOCheck if set }
  359. if assigned(iolabel) then
  360. begin
  361. { registers are saved in the procedure }
  362. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  363. emitcall('IOCHECK',true);
  364. end;
  365. { Freeup all used temps }
  366. ungetiftemp(aktfile);
  367. if assigned(p^.left) then
  368. begin
  369. p^.left:=reversparameter(p^.left);
  370. if npara<>nb_para then
  371. Message(cg_f_internal_error_in_secondinline);
  372. hp:=p^.left;
  373. while assigned(hp) do
  374. begin
  375. if assigned(hp^.left) then
  376. if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  377. ungetiftemp(hp^.left^.location.reference);
  378. hp:=hp^.right;
  379. end;
  380. end;
  381. end;
  382. procedure handle_str;
  383. var
  384. hp,node : ptree;
  385. dummycoll : tdefcoll;
  386. is_real,has_length : boolean;
  387. begin
  388. pushusedregisters(pushed,$ff);
  389. node:=p^.left;
  390. is_real:=false;
  391. has_length:=false;
  392. while assigned(node^.right) do node:=node^.right;
  393. { if a real parameter somewhere then call REALSTR }
  394. if (node^.left^.resulttype^.deftype=floatdef) then
  395. is_real:=true;
  396. node:=p^.left;
  397. { we have at least two args }
  398. { with at max 2 colon_para in between }
  399. { first arg longint or float }
  400. hp:=node;
  401. node:=node^.right;
  402. hp^.right:=nil;
  403. dummycoll.data:=hp^.resulttype;
  404. { string arg }
  405. dummycoll.paratyp:=vs_var;
  406. secondcallparan(hp,@dummycoll,false
  407. ,false,0
  408. );
  409. if codegenerror then
  410. exit;
  411. dummycoll.paratyp:=vs_const;
  412. { second arg }
  413. hp:=node;
  414. node:=node^.right;
  415. hp^.right:=nil;
  416. { frac para }
  417. if hp^.is_colon_para and assigned(node) and
  418. node^.is_colon_para then
  419. begin
  420. dummycoll.data:=hp^.resulttype;
  421. secondcallparan(hp,@dummycoll,false
  422. ,false,0
  423. );
  424. if codegenerror then
  425. exit;
  426. hp:=node;
  427. node:=node^.right;
  428. hp^.right:=nil;
  429. has_length:=true;
  430. end
  431. else
  432. if is_real then
  433. push_int(-1);
  434. { third arg, length only if is_real }
  435. if hp^.is_colon_para then
  436. begin
  437. dummycoll.data:=hp^.resulttype;
  438. secondcallparan(hp,@dummycoll,false
  439. ,false,0
  440. );
  441. if codegenerror then
  442. exit;
  443. hp:=node;
  444. node:=node^.right;
  445. hp^.right:=nil;
  446. end
  447. else
  448. if is_real then
  449. push_int(-32767)
  450. else
  451. push_int(-1);
  452. { last arg longint or real }
  453. secondcallparan(hp,@dummycoll,false
  454. ,false,0
  455. );
  456. if codegenerror then
  457. exit;
  458. if is_real then
  459. emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
  460. else if porddef(hp^.resulttype)^.typ=u32bit then
  461. emitcall('STR_CARDINAL',true)
  462. else
  463. emitcall('STR_LONGINT',true);
  464. popusedregisters(pushed);
  465. end;
  466. var
  467. r : preference;
  468. l : longint;
  469. ispushed : boolean;
  470. hregister : tregister;
  471. otlabel,oflabel,filenamestring : plabel;
  472. begin
  473. case p^.inlinenumber of
  474. in_assert_x:
  475. begin
  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:=reg32toreg16(getregister32);
  511. emit_reg_reg(A_MOV,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:=reg32toreg16(getregister32);
  518. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,newreference(p^.left^.location.reference),
  519. p^.location.register)));
  520. end;
  521. end
  522. else p^.location.register:=p^.left^.location.register;
  523. if p^.inlinenumber=in_hi_word then
  524. exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
  525. p^.location.register:=reg16toreg8(p^.location.register);
  526. end;
  527. in_high_x :
  528. begin
  529. if is_open_array(p^.left^.resulttype) then
  530. begin
  531. secondpass(p^.left);
  532. del_reference(p^.left^.location.reference);
  533. p^.location.register:=getregister32;
  534. new(r);
  535. reset_reference(r^);
  536. r^.base:=highframepointer;
  537. r^.offset:=highoffset+4;
  538. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  539. r,p^.location.register)));
  540. end
  541. end;
  542. in_sizeof_x,
  543. in_typeof_x :
  544. begin
  545. { sizeof(openarray) handling }
  546. if (p^.inlinenumber=in_sizeof_x) and
  547. is_open_array(p^.left^.resulttype) then
  548. begin
  549. { sizeof(openarray)=high(openarray)+1 }
  550. secondpass(p^.left);
  551. del_reference(p^.left^.location.reference);
  552. p^.location.register:=getregister32;
  553. new(r);
  554. reset_reference(r^);
  555. r^.base:=highframepointer;
  556. r^.offset:=highoffset+4;
  557. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  558. r,p^.location.register)));
  559. exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,
  560. p^.location.register)));
  561. if parraydef(p^.left^.resulttype)^.elesize<>1 then
  562. exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,
  563. parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
  564. end
  565. else
  566. begin
  567. { for both cases load vmt }
  568. if p^.left^.treetype=typen then
  569. begin
  570. p^.location.register:=getregister32;
  571. exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
  572. S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
  573. p^.location.register)));
  574. end
  575. else
  576. begin
  577. secondpass(p^.left);
  578. del_reference(p^.left^.location.reference);
  579. p^.location.loc:=LOC_REGISTER;
  580. p^.location.register:=getregister32;
  581. { load VMT pointer }
  582. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  583. newreference(p^.left^.location.reference),
  584. p^.location.register)));
  585. end;
  586. { in sizeof load size }
  587. if p^.inlinenumber=in_sizeof_x then
  588. begin
  589. new(r);
  590. reset_reference(r^);
  591. r^.base:=p^.location.register;
  592. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,
  593. p^.location.register)));
  594. end;
  595. end;
  596. end;
  597. in_lo_long,
  598. in_hi_long :
  599. begin
  600. secondpass(p^.left);
  601. p^.location.loc:=LOC_REGISTER;
  602. if p^.left^.location.loc<>LOC_REGISTER then
  603. begin
  604. if p^.left^.location.loc=LOC_CREGISTER then
  605. begin
  606. p^.location.register:=getregister32;
  607. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  608. p^.location.register);
  609. end
  610. else
  611. begin
  612. del_reference(p^.left^.location.reference);
  613. p^.location.register:=getregister32;
  614. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  615. p^.location.register)));
  616. end;
  617. end
  618. else p^.location.register:=p^.left^.location.register;
  619. if p^.inlinenumber=in_hi_long then
  620. exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,16,p^.location.register)));
  621. p^.location.register:=reg32toreg16(p^.location.register);
  622. end;
  623. {***CHARBUG}
  624. {We can now comment them out, as they are handled as typecast.
  625. Saves an incredible amount of 8 bytes code.
  626. I'am not lucky about this, because it's _not_ a type cast (FK) }
  627. { in_ord_char,
  628. in_chr_byte,}
  629. {***}
  630. in_length_string :
  631. begin
  632. secondpass(p^.left);
  633. set_location(p^.location,p^.left^.location);
  634. { length in ansi strings is at offset -8 }
  635. {$ifdef UseAnsiString}
  636. if is_ansistring(p^.left^.resulttype) then
  637. dec(p^.location.reference.offset,8);
  638. {$endif UseAnsiString}
  639. end;
  640. in_pred_x,
  641. in_succ_x:
  642. begin
  643. secondpass(p^.left);
  644. if p^.inlinenumber=in_pred_x then
  645. asmop:=A_DEC
  646. else
  647. asmop:=A_INC;
  648. case p^.resulttype^.size of
  649. 4 : opsize:=S_L;
  650. 2 : opsize:=S_W;
  651. 1 : opsize:=S_B;
  652. else
  653. internalerror(10080);
  654. end;
  655. p^.location.loc:=LOC_REGISTER;
  656. if p^.left^.location.loc<>LOC_REGISTER then
  657. begin
  658. p^.location.register:=getregister32;
  659. if (p^.resulttype^.size=2) then
  660. p^.location.register:=reg32toreg16(p^.location.register);
  661. if (p^.resulttype^.size=1) then
  662. p^.location.register:=reg32toreg8(p^.location.register);
  663. if p^.left^.location.loc=LOC_CREGISTER then
  664. emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
  665. p^.location.register)
  666. else
  667. if p^.left^.location.loc=LOC_FLAGS then
  668. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
  669. p^.location.register)))
  670. else
  671. begin
  672. del_reference(p^.left^.location.reference);
  673. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
  674. p^.location.register)));
  675. end;
  676. end
  677. else p^.location.register:=p^.left^.location.register;
  678. exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
  679. p^.location.register)))
  680. { here we should insert bounds check ? }
  681. { and direct call to bounds will crash the program }
  682. { if we are at the limit }
  683. { we could also simply say that pred(first)=first and succ(last)=last }
  684. { could this be usefull I don't think so (PM)
  685. emitoverflowcheck;}
  686. end;
  687. in_dec_x,
  688. in_inc_x :
  689. begin
  690. { set defaults }
  691. addvalue:=1;
  692. addconstant:=true;
  693. { load first parameter, must be a reference }
  694. secondpass(p^.left^.left);
  695. case p^.left^.left^.resulttype^.deftype of
  696. orddef,
  697. enumdef : begin
  698. case p^.left^.left^.resulttype^.size of
  699. 1 : opsize:=S_B;
  700. 2 : opsize:=S_W;
  701. 4 : opsize:=S_L;
  702. end;
  703. end;
  704. pointerdef : begin
  705. opsize:=S_L;
  706. addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
  707. end;
  708. else
  709. internalerror(10081);
  710. end;
  711. { second argument specified?, must be a s32bit in register }
  712. if assigned(p^.left^.right) then
  713. begin
  714. secondpass(p^.left^.right^.left);
  715. { when constant, just multiply the addvalue }
  716. if is_constintnode(p^.left^.right^.left) then
  717. addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
  718. else
  719. begin
  720. case p^.left^.right^.left^.location.loc of
  721. LOC_REGISTER,
  722. LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
  723. LOC_MEM,
  724. LOC_REFERENCE : begin
  725. del_reference(p^.left^.right^.left^.location.reference);
  726. hregister:=getregister32;
  727. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  728. newreference(p^.left^.right^.left^.location.reference),hregister)));
  729. end;
  730. else
  731. internalerror(10082);
  732. end;
  733. { insert multiply with addvalue if its >1 }
  734. if addvalue>1 then
  735. exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,opsize,
  736. addvalue,hregister)));
  737. addconstant:=false;
  738. end;
  739. end;
  740. { write the add instruction }
  741. if addconstant then
  742. begin
  743. if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then
  744. begin
  745. if p^.left^.left^.location.loc=LOC_CREGISTER then
  746. exprasmlist^.concat(new(pai386,op_reg(incdecop[p^.inlinenumber],opsize,
  747. p^.left^.left^.location.register)))
  748. else
  749. exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
  750. newreference(p^.left^.left^.location.reference))))
  751. end
  752. else
  753. begin
  754. if p^.left^.left^.location.loc=LOC_CREGISTER then
  755. exprasmlist^.concat(new(pai386,op_const_reg(addsubop[p^.inlinenumber],opsize,
  756. addvalue,p^.left^.left^.location.register)))
  757. else
  758. exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
  759. addvalue,newreference(p^.left^.left^.location.reference))));
  760. end
  761. end
  762. else
  763. begin
  764. if p^.left^.left^.location.loc=LOC_CREGISTER then
  765. exprasmlist^.concat(new(pai386,op_reg_reg(addsubop[p^.inlinenumber],opsize,
  766. hregister,p^.left^.left^.location.register)))
  767. else
  768. exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
  769. hregister,newreference(p^.left^.left^.location.reference))));
  770. ungetregister32(hregister);
  771. end;
  772. emitoverflowcheck(p^.left^.left);
  773. end;
  774. in_assigned_x :
  775. begin
  776. secondpass(p^.left^.left);
  777. p^.location.loc:=LOC_FLAGS;
  778. if (p^.left^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  779. begin
  780. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,
  781. p^.left^.left^.location.register,
  782. p^.left^.left^.location.register)));
  783. ungetregister32(p^.left^.left^.location.register);
  784. end
  785. else
  786. begin
  787. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
  788. newreference(p^.left^.left^.location.reference))));
  789. del_reference(p^.left^.left^.location.reference);
  790. end;
  791. p^.location.resflags:=F_NE;
  792. end;
  793. in_reset_typedfile,in_rewrite_typedfile :
  794. begin
  795. pushusedregisters(pushed,$ff);
  796. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
  797. secondload(p^.left);
  798. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  799. if p^.inlinenumber=in_reset_typedfile then
  800. emitcall('RESET_TYPED',true)
  801. else
  802. emitcall('REWRITE_TYPED',true);
  803. popusedregisters(pushed);
  804. end;
  805. in_write_x :
  806. handlereadwrite(false,false);
  807. in_writeln_x :
  808. handlereadwrite(false,true);
  809. in_read_x :
  810. handlereadwrite(true,false);
  811. in_readln_x :
  812. handlereadwrite(true,true);
  813. in_str_x_string :
  814. begin
  815. handle_str;
  816. maybe_loadesi;
  817. end;
  818. in_include_x_y,
  819. in_exclude_x_y:
  820. begin
  821. secondpass(p^.left^.left);
  822. if p^.left^.right^.left^.treetype=ordconstn then
  823. begin
  824. { calculate bit position }
  825. l:=1 shl (p^.left^.right^.left^.value mod 32);
  826. { determine operator }
  827. if p^.inlinenumber=in_include_x_y then
  828. asmop:=A_OR
  829. else
  830. begin
  831. asmop:=A_AND;
  832. l:=not(l);
  833. end;
  834. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  835. begin
  836. inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
  837. exprasmlist^.concat(new(pai386,op_const_ref(asmop,S_L,
  838. l,newreference(p^.left^.left^.location.reference))));
  839. del_reference(p^.left^.left^.location.reference);
  840. end
  841. else
  842. { LOC_CREGISTER }
  843. exprasmlist^.concat(new(pai386,op_const_reg(asmop,S_L,
  844. l,p^.left^.left^.location.register)));
  845. end
  846. else
  847. begin
  848. { generate code for the element to set }
  849. ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
  850. secondpass(p^.left^.right^.left);
  851. if ispushed then
  852. restore(p^.left^.left);
  853. { determine asm operator }
  854. if p^.inlinenumber=in_include_x_y then
  855. asmop:=A_BTS
  856. else
  857. asmop:=A_BTR;
  858. if psetdef(p^.left^.resulttype)^.settype=smallset then
  859. begin
  860. if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
  861. hregister:=p^.left^.right^.left^.location.register
  862. else
  863. begin
  864. hregister:=R_EDI;
  865. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  866. newreference(p^.left^.right^.left^.location.reference),R_EDI)));
  867. end;
  868. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  869. exprasmlist^.concat(new(pai386,op_reg_ref(asmop,S_L,R_EDI,
  870. newreference(p^.left^.right^.left^.location.reference))))
  871. else
  872. exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,R_EDI,
  873. p^.left^.right^.left^.location.register)));
  874. end
  875. else
  876. begin
  877. end;
  878. end;
  879. end;
  880. else internalerror(9);
  881. end;
  882. end;
  883. end.
  884. {
  885. $Log$
  886. Revision 1.3 1998-09-05 23:03:57 florian
  887. * some fixes to get -Or work:
  888. - inc/dec didn't take care of CREGISTER
  889. - register calculcation of inc/dec was wrong
  890. - var/const parameters get now assigned 32 bit register, but
  891. const parameters only if they are passed by reference !
  892. Revision 1.2 1998/09/04 08:41:40 peter
  893. * updated some error messages
  894. Revision 1.1 1998/08/31 12:22:14 peter
  895. * secondinline moved to cg386inl
  896. Revision 1.19 1998/08/31 08:52:03 peter
  897. * fixed error 10 with succ() and pref()
  898. Revision 1.18 1998/08/20 21:36:38 peter
  899. * fixed 'with object do' bug
  900. Revision 1.17 1998/08/19 16:07:36 jonas
  901. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  902. Revision 1.16 1998/08/18 09:24:36 pierre
  903. * small warning position bug fixed
  904. * support_mmx switches splitting was missing
  905. * rhide error and warning output corrected
  906. Revision 1.15 1998/08/13 11:00:09 peter
  907. * fixed procedure<>procedure construct
  908. Revision 1.14 1998/08/11 14:05:33 peter
  909. * fixed sizeof(array of char)
  910. Revision 1.13 1998/08/10 14:49:45 peter
  911. + localswitches, moduleswitches, globalswitches splitting
  912. Revision 1.12 1998/07/30 13:30:31 florian
  913. * final implemenation of exception support, maybe it needs
  914. some fixes :)
  915. Revision 1.11 1998/07/24 22:16:52 florian
  916. * internal error 10 together with array access fixed. I hope
  917. that's the final fix.
  918. Revision 1.10 1998/07/18 22:54:23 florian
  919. * some ansi/wide/longstring support fixed:
  920. o parameter passing
  921. o returning as result from functions
  922. Revision 1.9 1998/07/07 17:40:37 peter
  923. * packrecords 4 works
  924. * word aligning of parameters
  925. Revision 1.8 1998/07/06 15:51:15 michael
  926. Added length checking for string reading
  927. Revision 1.7 1998/07/06 14:19:51 michael
  928. + Added calls for reading/writing ansistrings
  929. Revision 1.6 1998/07/01 15:28:48 peter
  930. + better writeln/readln handling, now 100% like tp7
  931. Revision 1.5 1998/06/25 14:04:17 peter
  932. + internal inc/dec
  933. Revision 1.4 1998/06/25 08:48:06 florian
  934. * first version of rtti support
  935. Revision 1.3 1998/06/09 16:01:33 pierre
  936. + added procedure directive parsing for procvars
  937. (accepted are popstack cdecl and pascal)
  938. + added C vars with the following syntax
  939. var C calias 'true_c_name';(can be followed by external)
  940. reason is that you must add the Cprefix
  941. which is target dependent
  942. Revision 1.2 1998/06/08 13:13:29 pierre
  943. + temporary variables now in temp_gen.pas unit
  944. because it is processor independent
  945. * mppc68k.bat modified to undefine i386 and support_mmx
  946. (which are defaults for i386)
  947. Revision 1.1 1998/06/05 17:44:10 peter
  948. * splitted cgi386
  949. }