FreeBASIC  0.91.0
ir-tac.bas
Go to the documentation of this file.
1 '' intermediate representation - three-address-codes module
2 ''
3 '' chng: sep/2004 written [v1ctor]
4 
5 
6 #include once "fb.bi"
7 #include once "fbint.bi"
8 #include once "reg.bi"
9 #include once "emit.bi"
10 #include once "flist.bi"
11 #include once "ir.bi"
12 #include once "hlp.bi"
13 
16  taccnt as integer
17  tacidx as IRTAC ptr
18 
20 
21  asm_line as string
22 end type
23 
24 declare sub hFlushUOP _
25  ( _
26  byval op as integer, _
27  byval v1 as IRVREG ptr, _
28  byval vr as IRVREG ptr _
29  )
30 
31 declare sub hFlushBOP _
32  ( _
33  byval op as integer, _
34  byval v1 as IRVREG ptr, _
35  byval v2 as IRVREG ptr, _
36  byval vr as IRVREG ptr _
37  )
38 
39 declare sub hFlushCOMP _
40  ( _
41  byval op as integer, _
42  byval v1 as IRVREG ptr, _
43  byval v2 as IRVREG ptr, _
44  byval vr as IRVREG ptr, _
45  byval label as FBSYMBOL ptr _
46  )
47 
48 declare sub hFlushSTORE _
49  ( _
50  byval op as integer, _
51  byval v1 as IRVREG ptr, _
52  byval v2 as IRVREG ptr _
53  )
54 
55 declare sub hFlushLOAD _
56  ( _
57  byval op as integer, _
58  byval v1 as IRVREG ptr, _
59  byval vr as IRVREG ptr _
60  )
61 
62 declare sub hFlushCONVERT _
63  ( _
64  byval op as integer, _
65  byval v1 as IRVREG ptr, _
66  byval v2 as IRVREG ptr _
67  )
68 
69 declare sub hFlushCALL _
70  ( _
71  byval op as integer, _
72  byval proc as FBSYMBOL ptr, _
73  byval bytestopop as integer, _
74  byval v1 as IRVREG ptr, _
75  byval vr as IRVREG ptr _
76  )
77 
78 declare sub hFlushBRANCH _
79  ( _
80  byval op as integer, _
81  byval label as FBSYMBOL ptr _
82  )
83 
84 declare sub hFlushSTACK _
85  ( _
86  byval op as integer, _
87  byval v1 as IRVREG ptr, _
88  byval ex as integer _
89  )
90 
91 declare sub hFlushADDR _
92  ( _
93  byval op as integer, _
94  byval v1 as IRVREG ptr, _
95  byval vr as IRVREG ptr _
96  )
97 
98 declare sub hFlushMEM _
99  ( _
100  byval op as integer, _
101  byval v1 as IRVREG ptr, _
102  byval v2 as IRVREG ptr, _
103  byval bytes as integer, _
104  byval extra as any ptr _
105  )
106 
107 declare sub hFlushDBG _
108  ( _
109  byval op as integer, _
110  byval proc as FBSYMBOL ptr, _
111  byval ex as integer _
112  )
113 
114 declare sub hFlushLIT( byval op as integer, byval text as zstring ptr )
115 
116 declare sub hFreeIDX _
117  ( _
118  byval vreg as IRVREG ptr, _
119  byval force as integer = FALSE _
120  )
121 
122 declare sub hFreeREG _
123  ( _
124  byval vreg as IRVREG ptr, _
125  byval force as integer = FALSE _
126  )
127 
128 declare sub hFreePreservedRegs _
129  ( _
130  _
131  )
132 
133 #if __FB_DEBUG__
134 declare sub hDumpFreeIntRegs( )
135 declare sub hDump _
136  ( _
137  byval op as integer, _
138  byval v1 as IRVREG ptr, _
139  byval v2 as IRVREG ptr, _
140  byval vr as IRVREG ptr, _
141  byval wrapline as integer = FALSE _
142  )
143 declare function tacvregDump( byval tacvreg as IRTACVREG ptr ) as string
144 declare sub tacDump( byval tac as IRTAC ptr )
145 #endif
146 
147 declare sub _flush _
148  ( _
149  )
150 
151 
152 '' globals
153  dim shared ctx as IRTAC_CTX
154 
155  dim shared regTB(0 to EMIT_REGCLASSES-1) as REGCLASS ptr
156 
157 sub _init( )
158  ctx.tacidx = NULL
159  ctx.taccnt = 0
160 
161  flistInit( @ctx.tacTB, IR_INITADDRNODES, len( IRTAC ) )
162  flistInit( @ctx.vregTB, IR_INITVREGNODES, len( IRVREG ) )
163 
164  emitInit( )
165 
166  for i as integer = 0 to EMIT_REGCLASSES-1
167  regTB(i) = emitGetRegClass( i )
168  next
169 end sub
170 
171 sub _end( )
172  emitEnd( )
173 
174  flistEnd( @ctx.vregTB )
175  flistEnd( @ctx.tacTB )
176 
177  ctx.tacidx = NULL
178  ctx.taccnt = 0
179 end sub
180 
181 '':::::
182 function _emitBegin _
183  ( _
184  ) as integer
185 
186  function = emitOpen( )
187 
188 end function
189 
190 '':::::
191 sub _emitEnd _
192  ( _
193  byval tottime as double _
194  )
195 
196  emitClose( tottime )
197 
198 end sub
199 
200 '':::::
201 function _getOptionValue _
202  ( _
203  byval opt as IR_OPTIONVALUE _
204  ) as integer
205 
206  function = emitGetOptionValue( opt )
207 
208 end function
209 
210 sub hLoadIDX( byval vreg as IRVREG ptr )
211  dim as IRVREG ptr vi = any
212 
213  if( vreg = NULL ) then
214  exit sub
215  end if
216 
217  select case vreg->typ
218  case IR_VREGTYPE_IDX, IR_VREGTYPE_PTR
219  case else
220  exit sub
221  end select
222 
223  '' any vreg attached?
224  vi = vreg->vidx
225  if( vi = NULL ) then
226  exit sub
227  end if
228 
229  '' don't load immediates to registers
230  if( vi->typ = IR_VREGTYPE_IMM ) then
231  exit sub
232  end if
233 
234  regTB(FB_DATACLASS_INTEGER)->ensure( regTB(FB_DATACLASS_INTEGER), vi, NULL, typeGetSize( FB_DATATYPE_INTEGER ) )
235 end sub
236 
237 '':::::
238 #macro hGetVREG( vreg, dt, dc, t )
239  if( vreg <> NULL ) then
240  t = vreg->typ
241 
242  dt = typeGet( vreg->dtype )
243  if( dt = FB_DATATYPE_POINTER ) then
244  dt = FB_DATATYPE_ULONG
245  end if
246 
247  dc = symb_dtypeTB(dt).class
248 
249  else
250  t = INVALID
251  dt = FB_DATATYPE_INVALID
252  dc = INVALID
253  end if
254 #endmacro
255 
256 ''::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
257 
258 '' Add the IRTACVREG to the IRVREG's list
259 sub hRelink( byval vreg as IRVREG ptr, byval tvreg as IRTACVREG ptr )
260  if( vreg->tacvhead = NULL ) then
261  vreg->tacvhead = tvreg
262  else
263  vreg->tacvtail->next = tvreg
264  end if
265  vreg->tacvtail = tvreg
266 end sub
267 
268 '' Setup an IRTAC's vr, v1 or v2 fields for the given IRVREG and its idx/aux
269 '' sub-IRVREGs.
270 #macro hRelinkVreg(v,t)
271  t->v.reg.parent = NULL
272  t->v.reg.next = NULL
273 
274  if( v <> NULL ) then
275  hRelink( v, @t->v.reg )
276  v->taclast = t
277 
278  if( v->vidx <> NULL ) then
279  t->v.idx.vreg = v->vidx
280  t->v.idx.parent = v
281  t->v.idx.next = NULL
282  hRelink( v->vidx, @t->v.idx )
283  v->vidx->taclast = t
284  end if
285 
286  if( v->vaux <> NULL ) then
287  t->v.aux.vreg = v->vaux
288  t->v.aux.parent = v
289  t->v.aux.next = NULL
290  hRelink( v->vaux, @t->v.aux )
291  v->vaux->taclast = t
292  end if
293  end if
294 #endmacro
295 
296 '':::::
297 sub _emit _
298  ( _
299  byval op as integer, _
300  byval v1 as IRVREG ptr, _
301  byval v2 as IRVREG ptr, _
302  byval vr as IRVREG ptr, _
303  byval ex1 as FBSYMBOL ptr = NULL, _
304  byval ex2 as integer = 0 _
305  ) static
306 
307  dim as IRTAC ptr t
308 
309  '' Add a new IRTAC node to represent the three operand vregs
310  t = flistNewItem( @ctx.tacTB )
311 
312  t->pos = ctx.taccnt
313 
314  t->op = op
315 
316  t->v1.reg.vreg = v1
317  hRelinkVreg( v1, t )
318 
319  t->v2.reg.vreg = v2
320  hRelinkVreg( v2, t )
321 
322  t->vr.reg.vreg = vr
323  hRelinkVreg( vr, t )
324 
325  t->ex1 = ex1
326  t->ex2 = ex2
327 
328  ctx.taccnt += 1
329 
330 end sub
331 
332 '':::::
333 sub _procBegin _
334  ( _
335  byval proc as FBSYMBOL ptr _
336  ) static
337 
338  emitProcBegin( proc )
339 
340 end sub
341 
342 '':::::
343 sub _procEnd _
344  ( _
345  byval proc as FBSYMBOL ptr _
346  ) static
347 
348  emitProcEnd( proc )
349 
350 end sub
351 
352 sub _procAllocArg _
353  ( _
354  byval proc as FBSYMBOL ptr, _
355  byval sym as FBSYMBOL ptr _
356  )
357 
358  emitProcAllocArg( proc, sym )
359 
360 end sub
361 
362 sub _procAllocLocal _
363  ( _
364  byval proc as FBSYMBOL ptr, _
365  byval sym as FBSYMBOL ptr _
366  )
367 
368  emitProcAllocLocal( proc, sym )
369 
370 end sub
371 
372 '':::::
373 function _procGetFrameRegName _
374  ( _
375  ) as const zstring ptr
376 
377  function = emitProcGetFrameRegName( )
378 
379 end function
380 
381 '':::::
382 sub _scopeBegin _
383  ( _
384  byval s as FBSYMBOL ptr _
385  ) static
386 
387  emitScopeBegin( s )
388 
389 end sub
390 
391 '':::::
392 sub _scopeEnd _
393  ( _
394  byval s as FBSYMBOL ptr _
395  ) static
396 
397  emitScopeEnd( s )
398 
399 end sub
400 
401 sub _procAllocStaticVars( byval head_sym as FBSYMBOL ptr )
402  emitProcAllocStaticVars( head_sym )
403 end sub
404 
405 '':::::
406 sub _emitLabel _
407  ( _
408  byval label as FBSYMBOL ptr _
409  ) static
410 
411  _flush( )
412 
413  emitLABEL( label )
414 
415 end sub
416 
417 '':::::
418 sub _emitReturn _
419  ( _
420  byval bytestopop as integer _
421  ) static
422 
423  _flush( )
424 
425  emitRET( bytestopop )
426 
427 end sub
428 
429 '':::::
430 sub _emitProcBegin _
431  ( _
432  byval proc as FBSYMBOL ptr, _
433  byval initlabel as FBSYMBOL ptr _
434  ) static
435 
436  dim as integer class_
437 
438  _flush( )
439 
440  '' clear regs so they aren't different from one proc to another
441  for class_ = 0 to EMIT_REGCLASSES-1
442  regTB(class_)->Clear( regTB(class_) )
443  next
444 
445  emitProcHeader( proc, initlabel )
446 
447 end sub
448 
449 sub _emitProcEnd _
450  ( _
451  byval proc as FBSYMBOL ptr, _
452  byval initlabel as FBSYMBOL ptr, _
453  byval exitlabel as FBSYMBOL ptr _
454  )
455 
456  dim as integer bytestopop = any
457 
458  _flush( )
459 
460  '' Get the size for the callee's stack clean up (at end of procedure)
461  if( symbGetProcMode( proc ) = FB_FUNCMODE_CDECL ) then
462  bytestopop = 0
463  else
464  bytestopop = symbCalcProcParamsLen( proc )
465  end if
466 
467  '' Additionally pop the hidden ptr (symbCalcProcParamsLen() doesn't
468  '' include it), if it's stdcall/pascal, or the target wants us to
469  '' always pop it, even under cdecl.
470  if( symbProcReturnsOnStack( proc ) ) then
471  if( (symbGetProcMode( proc ) <> FB_FUNCMODE_CDECL) or _
472  (env.target.options and FB_TARGETOPT_CALLEEPOPSHIDDENPTR) ) then
473  bytestopop += env.pointersize
474  end if
475  end if
476 
477  emitProcFooter( proc, bytestopop, initlabel, exitlabel )
478 
479 end sub
480 
481 '':::::
482 sub _emitScopeBegin _
483  ( _
484  byval s as FBSYMBOL ptr _
485  )
486 
487  _flush( )
488 
489 end sub
490 
491 '':::::
492 sub _emitScopeEnd _
493  ( _
494  byval s as FBSYMBOL ptr _
495  )
496 
497  _flush( )
498 
499 end sub
500 
501 '':::::
502 sub _emitBop _
503  ( _
504  byval op as integer, _
505  byval v1 as IRVREG ptr, _
506  byval v2 as IRVREG ptr, _
507  byval vr as IRVREG ptr, _
508  byval ex as FBSYMBOL ptr _
509  )
510 
511  _emit( op, v1, v2, vr, ex )
512 
513 end sub
514 
515 '':::::
516 sub _emitUop _
517  ( _
518  byval op as integer, _
519  byval v1 as IRVREG ptr, _
520  byval vr as IRVREG ptr _
521  )
522 
523  _emit( op, v1, NULL, vr )
524 
525 end sub
526 
527 sub _emitConvert( byval v1 as IRVREG ptr, byval v2 as IRVREG ptr )
528  select case( typeGetClass( v1->dtype ) )
529  case FB_DATACLASS_INTEGER
530  _emit( AST_OP_TOINT, v1, v2, NULL )
531  case FB_DATACLASS_FPOINT
532  _emit( AST_OP_TOFLT, v1, v2, NULL )
533  end select
534 end sub
535 
536 sub _emitStore( byval v1 as IRVREG ptr, byval v2 as IRVREG ptr )
537  _emit( AST_OP_ASSIGN, v1, v2, NULL )
538 end sub
539 
540 '':::::
541 sub _emitSpillRegs _
542  ( _
543  )
544 
545  _emit( AST_OP_SPILLREGS, NULL, NULL, NULL )
546 
547 end sub
548 
549 '':::::
550 sub _emitLoad _
551  ( _
552  byval v1 as IRVREG ptr _
553  )
554 
555  _emit( AST_OP_LOAD, v1, NULL, NULL )
556 
557 end sub
558 
559 '':::::
560 sub _emitLoadRes _
561  ( _
562  byval v1 as IRVREG ptr, _
563  byval vr as IRVREG ptr _
564  )
565 
566  _emit( AST_OP_LOADRES, v1, NULL, vr )
567 
568 end sub
569 
570 '':::::
571 sub _emitStack _
572  ( _
573  byval op as integer, _
574  byval v1 as IRVREG ptr _
575  )
576 
577  _emit( op, v1, NULL, NULL )
578 
579 end sub
580 
581 '':::::
582 sub _emitPushArg _
583  ( _
584  byval param as FBSYMBOL ptr, _
585  byval vr as IRVREG ptr, _
586  byval udtlen as longint, _
587  byval level as integer _
588  )
589 
590  if( udtlen = 0 ) then
591  _emitStack( AST_OP_PUSH, vr )
592  else
593  _emit( AST_OP_PUSHUDT, vr, NULL, NULL, NULL, udtlen )
594  end if
595 
596 end sub
597 
598 '':::::
599 sub _emitAddr _
600  ( _
601  byval op as integer, _
602  byval v1 as IRVREG ptr, _
603  byval vr as IRVREG ptr _
604  )
605 
606  _emit( op, v1, NULL, vr )
607 
608 end sub
609 
610 '':::::
611 sub _emitLabelNF _
612  ( _
613  byval l as FBSYMBOL ptr _
614  )
615 
616  _emit( AST_OP_LABEL, NULL, NULL, NULL, l )
617 
618 end sub
619 
620 '':::::
621 sub _emitCall _
622  ( _
623  byval proc as FBSYMBOL ptr, _
624  byval bytestopop as integer, _
625  byval vr as IRVREG ptr, _
626  byval level as integer _
627  )
628 
629  _emit( AST_OP_CALLFUNCT, NULL, NULL, vr, proc, bytestopop )
630 
631 end sub
632 
633 '':::::
634 sub _emitCallPtr _
635  ( _
636  byval v1 as IRVREG ptr, _
637  byval vr as IRVREG ptr, _
638  byval bytestopop as integer, _
639  byval level as integer _
640  )
641 
642  _emit( AST_OP_CALLPTR, v1, NULL, vr, NULL, bytestopop )
643 
644 end sub
645 
646 '':::::
647 sub _emitStackAlign _
648  ( _
649  byval bytes as integer _
650  )
651 
652  _emit( AST_OP_STACKALIGN, NULL, NULL, NULL, NULL, bytes )
653 
654 end sub
655 
656 sub _emitJumpPtr( byval v1 as IRVREG ptr )
657  _emit( AST_OP_JUMPPTR, v1, NULL, NULL, NULL )
658 end sub
659 
660 sub _emitBranch( byval op as integer, byval label as FBSYMBOL ptr )
661  _emit( op, NULL, NULL, NULL, label )
662 end sub
663 
664 sub _emitJmpTb _
665  ( _
666  byval v1 as IRVREG ptr, _
667  byval tbsym as FBSYMBOL ptr, _
668  byval values as ulongint ptr, _
669  byval labels as FBSYMBOL ptr ptr, _
670  byval labelcount as integer, _
671  byval deflabel as FBSYMBOL ptr, _
672  byval minval as ulongint, _
673  byval maxval as ulongint _
674  )
675 
676  _flush( )
677  emitJMPTB( tbsym, values, labels, labelcount, deflabel, minval, maxval )
678 
679 end sub
680 
681 '':::::
682 sub _emitMem _
683  ( _
684  byval op as integer, _
685  byval v1 as IRVREG ptr, _
686  byval v2 as IRVREG ptr, _
687  byval bytes as longint _
688  )
689 
690  _emit( op, v1, v2, NULL, 0, bytes )
691 
692 end sub
693 
694 sub _emitDECL( byval sym as FBSYMBOL ptr )
695  '' Nothing to do - used by C backend
696 end sub
697 
698 '':::::
699 sub _emitDBG _
700  ( _
701  byval op as integer, _
702  byval proc as FBSYMBOL ptr, _
703  byval ex as integer _
704  )
705 
706  _emit( op, NULL, NULL, NULL, proc, ex )
707 
708 end sub
709 
710 sub _emitComment( byval text as zstring ptr )
711  _emit( AST_OP_LIT_COMMENT, NULL, NULL, NULL, cast( any ptr, ZstrDup( text ) ) )
712 end sub
713 
715  ctx.asm_line = ""
716 end sub
717 
718 sub _emitAsmText( byval text as zstring ptr )
719  ctx.asm_line += *text
720 end sub
721 
722 sub _emitAsmSymb( byval sym as FBSYMBOL ptr )
723  ctx.asm_line += *symbGetMangledName( sym )
724  if( symbGetOfs( sym ) > 0 ) then
725  ctx.asm_line += "+" + str( symbGetOfs( sym ) )
726  elseif( symbGetOfs( sym ) < 0 ) then
727  ctx.asm_line += str( symbGetOfs( sym ) )
728  end if
729 end sub
730 
732  _emit( AST_OP_LIT_ASM, NULL, NULL, NULL, cast( any ptr, ZstrDup( strptr( ctx.asm_line ) ) ) )
733 end sub
734 
735 sub _emitVarIniBegin( byval sym as FBSYMBOL ptr )
736  '' no flush, all var-ini go to data sections
737  emitVARINIBEGIN( sym )
738 end sub
739 
740 sub _emitVarIniEnd( byval sym as FBSYMBOL ptr )
741 end sub
742 
743 sub _emitVarIniI( byval sym as FBSYMBOL ptr, byval value as longint )
744  var dtype = symbGetType( sym )
745  if( ISLONGINT( dtype ) ) then
746  emitVARINI64( dtype, value )
747  else
748  emitVARINIi( dtype, value )
749  end if
750 end sub
751 
752 sub _emitVarIniF( byval sym as FBSYMBOL ptr, byval value as double )
753  emitVARINIf( symbGetType( sym ), value )
754 end sub
755 
756 sub _emitVarIniOfs( byval sym as FBSYMBOL ptr, byval ofs as longint )
757  emitVARINIOFS( symbGetMangledName( sym ), ofs )
758 end sub
759 
760 sub _emitVarIniStr _
761  ( _
762  byval totlgt as longint, _
763  byval litstr as zstring ptr, _
764  byval litlgt as longint _
765  )
766 
767  dim as const zstring ptr s
768 
769  '' zstring * 1?
770  if( totlgt = 0 ) then
771  emitVARINIi( FB_DATATYPE_BYTE, 0 )
772  exit sub
773  end if
774 
775  ''
776  if( litlgt > totlgt ) then
777  errReportWarn( FB_WARNINGMSG_LITSTRINGTOOBIG )
778  '' !!!FIXME!!! truncate will fail if it lies on an escape seq
779  s = hEscape( left( *litstr, totlgt ) )
780  else
781  s = hEscape( litstr )
782  end if
783 
784  ''
785  emitVARINISTR( s )
786 
787  if( litlgt < totlgt ) then
788  emitVARINIPAD( totlgt - litlgt )
789  end if
790 
791 end sub
792 
793 '':::::
794 sub _emitVarIniWstr _
795  ( _
796  byval totlgt as longint, _
797  byval litstr as wstring ptr, _
798  byval litlgt as longint _
799  )
800 
801  dim as zstring ptr s
802  dim as integer wclen
803 
804  '' wstring * 1?
805  if( totlgt = 0 ) then
806  emitVARINIi( env.target.wchar, 0 )
807  exit sub
808  end if
809 
810  ''
811  if( litlgt > totlgt ) then
812  errReportWarn( FB_WARNINGMSG_LITSTRINGTOOBIG )
813  '' !!!FIXME!!! truncate will fail if it lies on an escape seq
814  s = hEscapeW( left( *litstr, totlgt ) )
815  else
816  s = hEscapeW( litstr )
817  end if
818 
819  ''
820  wclen = typeGetSize( FB_DATATYPE_WCHAR )
821 
822  emitVARINIWSTR( s )
823 
824  if( litlgt < totlgt ) then
825  emitVARINIPAD( (totlgt - litlgt) * wclen )
826  end if
827 
828 end sub
829 
830 sub _emitVarIniPad( byval bytes as longint )
831  emitVARINIPAD( bytes )
832 end sub
833 
835  '' Used by C-emitter only
836 end sub
837 
839  '' Used by C-emitter only
840 end sub
841 
844 end sub
845 
846 sub _emitFbctinfString( byval s as zstring ptr )
847  emitFBCTINFSTRING( s )
848 end sub
849 
851  emitFBCTINFEND( )
852 end sub
853 
854 '':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
855 
856 '':::::
857 function hNewVR _
858  ( _
859  byval dtype as integer, _
860  byval subtype as FBSYMBOL ptr, _
861  byval vtype as integer _
862  ) as IRVREG ptr
863 
864  dim as IRVREG ptr v = any
865 
866  v = flistNewItem( @ctx.vregTB )
867 
868  v->typ = vtype
869  v->dtype = typeGet( dtype )
870  v->subtype = subtype
871  v->sym = NULL
872  v->reg = INVALID
873  v->vidx = NULL
874  v->vaux = NULL
875  v->ofs = 0
876  v->vector = 0
877 
878  if( env.clopt.fputype = FB_FPUTYPE_FPU ) then
879  v->regFamily = IR_REG_FPU_STACK
880  else
881  v->regFamily = IR_REG_SSE
882  end if
883 
884  v->tacvhead = NULL
885  v->tacvtail = NULL
886  v->taclast = NULL
887 
888  function = v
889 
890 end function
891 
892 '':::::
893 function _allocVreg _
894  ( _
895  byval dtype as integer, _
896  byval subtype as FBSYMBOL ptr _
897  ) as IRVREG ptr
898 
899  dim as IRVREG ptr vr = any
900 
901  vr = hNewVR( dtype, subtype, IR_VREGTYPE_REG )
902 
903  '' longint?
904  if( ISLONGINT( dtype ) ) then
905  vr->vaux = hNewVR( FB_DATATYPE_INTEGER, NULL, IR_VREGTYPE_REG )
906  end if
907 
908  function = vr
909 
910 end function
911 
912 function _allocVrImm _
913  ( _
914  byval dtype as integer, _
915  byval subtype as FBSYMBOL ptr, _
916  byval value as longint _
917  ) as IRVREG ptr
918 
919  dim as IRVREG ptr vr = any
920 
921  vr = hNewVR( dtype, subtype, IR_VREGTYPE_IMM )
922 
923  if( ISLONGINT( dtype ) ) then
924  '' Only the low 32bits go in the main vreg
925  vr->value.i = cuint( value )
926 
927  '' The aux vreg takes the high 32bits
928  vr->vaux = hNewVR( FB_DATATYPE_INTEGER, NULL, IR_VREGTYPE_IMM )
929  vr->vaux->value.i = cint( value shr 32 )
930  else
931  vr->value.i = value
932  end if
933 
934  function = vr
935 end function
936 
937 function _allocVrImmF _
938  ( _
939  byval dtype as integer, _
940  byval subtype as FBSYMBOL ptr, _
941  byval value as double _
942  ) as IRVREG ptr
943 
944  dim as IRVREG ptr vr = any
945  dim as FBSYMBOL ptr s = any
946 
947  '' float immediates supported by the FPU?
948  if( irGetOption( IR_OPT_FPUIMMEDIATES ) ) then
949  vr = hNewVR( dtype, subtype, IR_VREGTYPE_IMM )
950  vr->value.f = value
951  else
952  '' create a temp const var
953  s = symbAllocFloatConst( value, dtype )
954  vr = irAllocVRVAR( dtype, subtype, s, symbGetOfs( s ) )
955  end if
956 
957  function = vr
958 end function
959 
960 '':::::
961 function _allocVrVar _
962  ( _
963  byval dtype as integer, _
964  byval subtype as FBSYMBOL ptr, _
965  byval symbol as FBSYMBOL ptr, _
966  byval ofs as longint _
967  ) as IRVREG ptr
968 
969  dim as IRVREG ptr vr = any, va = any
970 
971  assert( symbol )
972 
973  vr = hNewVR( dtype, subtype, IR_VREGTYPE_VAR )
974 
975  vr->sym = symbol
976  vr->ofs = ofs
977 
978  '' longint?
979  if( ISLONGINT( dtype ) ) then
980  va = hNewVR( FB_DATATYPE_INTEGER, NULL, IR_VREGTYPE_VAR )
981  vr->vaux = va
982  va->ofs = ofs + 4 '' vaux = the upper 4 bytes
983  end if
984 
985  function = vr
986 
987 end function
988 
989 '':::::
990 function _allocVrIdx _
991  ( _
992  byval dtype as integer, _
993  byval subtype as FBSYMBOL ptr, _
994  byval symbol as FBSYMBOL ptr, _
995  byval ofs as longint, _
996  byval mult as integer, _
997  byval vidx as IRVREG ptr _
998  ) as IRVREG ptr
999 
1000  dim as IRVREG ptr vr = any, va = any
1001 
1002  vr = hNewVR( dtype, subtype, IR_VREGTYPE_IDX )
1003 
1004  vr->sym = symbol
1005  vr->ofs = ofs
1006  vr->mult = mult
1007  vr->vidx = vidx
1008 
1009  '' longint?
1010  if( ISLONGINT( dtype ) ) then
1011  va = hNewVR( FB_DATATYPE_INTEGER, NULL, IR_VREGTYPE_IDX )
1012  vr->vaux= va
1013  va->ofs = ofs + 4 '' vaux = the upper 4 bytes
1014  end if
1015 
1016  function = vr
1017 
1018 end function
1019 
1020 '':::::
1021 function _allocVrPtr _
1022  ( _
1023  byval dtype as integer, _
1024  byval subtype as FBSYMBOL ptr, _
1025  byval ofs as longint, _
1026  byval vidx as IRVREG ptr _
1027  ) as IRVREG ptr
1028 
1029  dim as IRVREG ptr vr = any, va = any
1030 
1031  vr = hNewVR( dtype, subtype, IR_VREGTYPE_PTR )
1032 
1033  vr->ofs = ofs
1034  vr->mult = 1
1035  vr->vidx = vidx
1036 
1037  '' longint?
1038  if( ISLONGINT( dtype ) ) then
1039  va = hNewVR( FB_DATATYPE_INTEGER, NULL, IR_VREGTYPE_IDX )
1040  vr->vaux= va
1041  va->ofs = ofs + 4 '' vaux = the upper 4 bytes
1042  end if
1043 
1044  function = vr
1045 
1046 end function
1047 
1048 '':::::
1049 function _allocVrOfs _
1050  ( _
1051  byval dtype as integer, _
1052  byval subtype as FBSYMBOL ptr, _
1053  byval symbol as FBSYMBOL ptr, _
1054  byval ofs as longint _
1055  ) as IRVREG ptr
1056 
1057  dim as IRVREG ptr vr = any
1058 
1059  vr = hNewVR( dtype, subtype, IR_VREGTYPE_OFS )
1060 
1061  vr->sym = symbol
1062  vr->ofs = ofs
1063 
1064  function = vr
1065 
1066 end function
1067 
1068 '':::::
1069 sub _setVregDataType _
1070  ( _
1071  byval vreg as IRVREG ptr, _
1072  byval dtype as integer, _
1073  byval subtype as FBSYMBOL ptr _
1074  )
1075 
1076  if( vreg <> NULL ) then
1077  vreg->dtype = typeGet( dtype )
1078  vreg->subtype = subtype
1079  end if
1080 
1081 end sub
1082 
1083 ''::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
1084 
1085 #if __FB_DEBUG__
1087  dim as string free, used
1088  dim as integer reg = any
1089 
1090  '' For each register in the integer class
1091  reg = regTB(FB_DATACLASS_INTEGER)->getFirst( regTB(FB_DATACLASS_INTEGER) )
1092  while( reg <> INVALID )
1093 
1094  if( regTB(FB_DATACLASS_INTEGER)->isFree( regTB(FB_DATACLASS_INTEGER), reg ) ) then
1095  if( len( free ) > 0 ) then free += ", "
1096  free += emitDumpRegName( FB_DATATYPE_INTEGER, reg )
1097  else
1098  if( len( used ) > 0 ) then used += ", "
1099  used += emitDumpRegName( FB_DATATYPE_INTEGER, reg )
1100  end if
1101 
1102  reg = regTB(FB_DATACLASS_INTEGER)->getNext( regTB(FB_DATACLASS_INTEGER), reg )
1103  wend
1104 
1105  print , "used: " & used & " | free: " & free
1106 end sub
1107 
1108 sub hDump _
1109  ( _
1110  byval op as integer, _
1111  byval v1 as IRVREG ptr, _
1112  byval v2 as IRVREG ptr, _
1113  byval vr as IRVREG ptr, _
1114  byval wrapline as integer = FALSE _
1115  )
1116 
1117  dim s as string
1118 
1119  if( astGetOpId( op ) <> NULL ) then
1120  s = *astGetOpId( op )
1121  else
1122  s = str( op )
1123  end if
1124 
1125  const MAXLEN = 4
1126  select case( len( s ) )
1127  case is > MAXLEN
1128  s = left( s, MAXLEN )
1129  case is < MAXLEN
1130  s += space( MAXLEN - len( s ) )
1131  end select
1132  s = "[" + s + "]"
1133 
1134  #macro hDumpVr( id, v )
1135  if( v <> NULL ) then
1136  if( wrapline ) then
1137  s += !"\t"
1138  else
1139  s += " "
1140  end if
1141  s += id + " = " + vregDump( v )
1142  if( wrapline ) then
1143  s += NEWLINE
1144  else
1145  s += !"\t"
1146  end if
1147  end if
1148  #endmacro
1149 
1150  hDumpVr( "d", vr )
1151  hDumpVr( "l", v1 )
1152  hDumpVr( "r", v2 )
1153 
1154  if( wrapline = FALSE ) then
1155  s += NEWLINE
1156  end if
1157 
1158  if( (wrapline = FALSE) and (len( s ) > 79) ) then
1159  hDump( op, v1, v2, vr, TRUE )
1160  else
1161  print s;
1162  end if
1163 
1164 end sub
1165 
1166 function tacvregDump( byval tacvreg as IRTACVREG ptr ) as string
1167  if( tacvreg = NULL ) then
1168  return "<NULL>"
1169  end if
1170  function = "IRTACVREG( " & _
1171  "vreg=" & vregDump( tacvreg->vreg ) & ", " & _
1172  "parent=" & vregDump( tacvreg->parent ) & ", " & _
1173  "next=" & tacvregDump( tacvreg->next ) & " )"
1174 end function
1175 
1176 sub tacDump( byval tac as IRTAC ptr )
1177  if( tac = NULL ) then
1178  print "IRTAC: <NULL>"
1179  exit sub
1180  end if
1181  print "IRTAC: pos=" & tac->pos & ", op=" & tac->op
1182  print , "vr vreg: " & tacvregDump( @tac->vr.reg )
1183  print , "vr vidx: " & tacvregDump( @tac->vr.idx )
1184  print , "vr vaux: " & tacvregDump( @tac->vr.aux )
1185  print , "v1 vreg: " & tacvregDump( @tac->v1.reg )
1186  print , "v1 vidx: " & tacvregDump( @tac->v1.idx )
1187  print , "v1 vaux: " & tacvregDump( @tac->v1.aux )
1188  print , "v2 vreg: " & tacvregDump( @tac->v2.reg )
1189  print , "v2 vidx: " & tacvregDump( @tac->v2.idx )
1190  print , "v2 vaux: " & tacvregDump( @tac->v2.aux )
1191 end sub
1192 #endif
1193 
1194 '':::::
1195 sub hRename _
1196  ( _
1197  byval vold as IRVREG ptr, _
1198  byval vnew as IRVREG ptr _
1199  )
1200 
1201  dim as IRTACVREG ptr t = any
1202  dim as IRVREG ptr v = any
1203 
1204  '' reassign tac table vregs
1205  '' (assuming res, v1 and v2 will never point to the same vreg!)
1206  t = vold->tacvhead
1207  do
1208  '' if it's an index or auxiliary vreg, update parent
1209  if( t->parent ) then
1210  assert( (t->parent->vidx = vold) or (t->parent->vaux = vold) )
1211  if( t->parent->vidx = vold ) then
1212  t->parent->vidx = vnew
1213  else
1214  t->parent->vaux = vnew
1215  end if
1216  end if
1217  t->vreg = vnew
1218  t = t->next
1219  loop while( t <> NULL )
1220 
1221  vnew->tacvhead = vold->tacvhead
1222  vnew->tacvtail = vold->tacvtail
1223  vnew->taclast = vold->taclast
1224 
1225 end sub
1226 
1227 '':::::
1228 sub hReuse _
1229  ( _
1230  byval t as IRTAC ptr _
1231  )
1232 
1233  dim as IRVREG ptr v1 = any, v2 = any, vr = any
1234  dim as integer v1_dtype = any, v1_dclass = any, v1_typ = any
1235  dim as integer v2_dtype = any, v2_dclass = any, v2_typ = any
1236  dim as integer vr_dtype = any, vr_dclass = any, vr_typ = any
1237  dim as integer op = any
1238 
1239  op = t->op
1240  v1 = t->v1.reg.vreg
1241  v2 = t->v2.reg.vreg
1242  vr = t->vr.reg.vreg
1243 
1244  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
1245  hGetVREG( v2, v2_dtype, v2_dclass, v2_typ )
1246  hGetVREG( vr, vr_dtype, vr_dclass, vr_typ )
1247 
1248  select case astGetOpClass( op )
1249  case AST_NODECLASS_UOP
1250  if( vr <> v1 ) then
1251  if( vr_dtype = v1_dtype ) then
1252  if( irGetDistance( v1 ) = IR_MAXDIST ) then
1253  hRename( vr, v1 )
1254  end if
1255  end if
1256  end if
1257 
1258  case AST_NODECLASS_BOP, AST_NODECLASS_COMP
1259  dim as integer v1rename = any, v2rename = any
1260 
1261  if( vr = NULL ) then
1262  exit sub
1263  end if
1264 
1265  '' check if operands have the same class (can happen 'cause the x86 FPU hacks)
1266  if( v1_dclass <> v2_dclass ) then
1267  exit sub
1268  end if
1269 
1270  v1rename = FALSE
1271  if( vr <> v1 ) then
1272  if( vr_dtype = v1_dtype ) then
1273  if( irGetDistance( v1 ) = IR_MAXDIST ) then
1274  v1rename = TRUE
1275  end if
1276  end if
1277  end if
1278 
1279  v2rename = FALSE
1280  if( astGetOpIsCommutative( op ) ) then
1281  if( vr <> v2 ) then
1282  if( vr_dtype = v2_dtype ) then
1283  if( v2_typ <> IR_VREGTYPE_IMM ) then
1284  if( irGetDistance( v2 ) = IR_MAXDIST ) then
1285  v2rename = TRUE
1286  end if
1287  end if
1288  end if
1289  end if
1290  end if
1291 
1292  if( v1rename and v2rename ) then
1293  if( irIsREG( v1 ) = FALSE ) then
1294  v1rename = FALSE
1295  end if
1296  end if
1297 
1298  if( v1rename ) then
1299  hRename( vr, v1 )
1300 
1301  elseif( v2rename ) then
1302  swap t->v1, t->v2
1303 
1304  hRename( vr, v2 )
1305  end if
1306 
1307  end select
1308 
1309 end sub
1310 
1311 '':::::
1312 sub _flush static
1313  dim as integer op
1314  dim as IRTAC ptr t
1315  dim as IRVREG ptr v1, v2, vr
1316 
1317  if( ctx.taccnt = 0 ) then
1318  exit sub
1319  end if
1320 
1321  t = flistGetHead( @ctx.tacTB )
1322  do
1323  ctx.tacidx = t
1324 
1325  hReuse( t )
1326 
1327  op = t->op
1328  v1 = t->v1.reg.vreg
1329  v2 = t->v2.reg.vreg
1330  vr = t->vr.reg.vreg
1331 
1332  ''
1333  'hDump( op, v1, v2, vr )
1334 
1335  ''
1336  select case as const astGetOpClass( op )
1337  case AST_NODECLASS_UOP
1338  hFlushUOP( op, v1, vr )
1339 
1340  case AST_NODECLASS_BOP
1341  hFlushBOP( op, v1, v2, vr )
1342 
1343  case AST_NODECLASS_COMP
1344  hFlushCOMP( op, v1, v2, vr, t->ex1 )
1345 
1346  case AST_NODECLASS_ASSIGN
1347  hFlushSTORE( op, v1, v2 )
1348 
1349  case AST_NODECLASS_LOAD
1350  hFlushLOAD( op, v1, vr )
1351 
1352  case AST_NODECLASS_CONV
1353  hFlushCONVERT( op, v1, v2 )
1354 
1355  case AST_NODECLASS_STACK
1356  hFlushSTACK( op, v1, t->ex2 )
1357 
1358  case AST_NODECLASS_CALL
1359  hFlushCALL( op, t->ex1, t->ex2, v1, vr )
1360 
1361  case AST_NODECLASS_BRANCH
1362  hFlushBRANCH( op, t->ex1 )
1363 
1364  case AST_NODECLASS_ADDROF
1365  hFlushADDR( op, v1, vr )
1366 
1367  case AST_NODECLASS_MEM
1368  hFlushMEM( op, v1, v2, t->ex2, t->ex1 )
1369 
1370  case AST_NODECLASS_DBG
1371  hFlushDBG( op, t->ex1, t->ex2 )
1372 
1373  case AST_NODECLASS_LIT
1374  hFlushLIT( op, cast( any ptr, t->ex1 ) )
1375 
1376  end select
1377 
1378  if( env.clopt.fputype >= FB_FPUTYPE_SSE ) then
1379  '' after vr has been used for the first time, force reg family to be SSE
1380  if( astGetOpClass( op ) <> AST_NODECLASS_CALL ) then
1381  if( vr ) then
1382  if( vr->regFamily = IR_REG_FPU_STACK ) then vr->regFamily = IR_REG_SSE
1383  end if
1384  end if
1385  end if
1386 
1387  t = flistGetNext( t )
1388  loop while( t <> NULL )
1389 
1390  ''
1391  ctx.tacidx = NULL
1392  ctx.taccnt = 0
1393  flistReset( @ctx.tacTB )
1394 
1395  ''
1396  flistReset( @ctx.vregTB )
1397 
1398  ''
1400 
1401 end sub
1402 
1403 sub hFlushBRANCH _
1404  ( _
1405  byval op as integer, _
1406  byval label as FBSYMBOL ptr _
1407  )
1408 
1409  select case as const op
1410  case AST_OP_LABEL
1411  emitLABEL( label )
1412 
1413  case AST_OP_JMP
1414  emitJUMP( label )
1415 
1416  case AST_OP_CALL
1417  emitCALL( label, 0 )
1418 
1419  case AST_OP_RET
1420  emitRET( 0 )
1421 
1422  case else
1423  emitBRANCH( op, label )
1424  end select
1425 
1426 end sub
1427 
1428 '':::::
1429 sub hFreePreservedRegs( ) static
1430  dim as integer class_, reg
1431 
1432  '' for each reg class
1433  for class_ = 0 to EMIT_REGCLASSES-1
1434 
1435  '' for each register on that class
1436  reg = regTB(class_)->getFirst( regTB(class_) )
1437  do until( reg = INVALID )
1438  '' if not free
1439  if( regTB(class_)->isFree( regTB(class_), reg ) = FALSE ) then
1440 
1441  assert( emitIsRegPreserved( class_, reg ) )
1442 
1443  '' free reg
1444  regTB(class_)->free( regTB(class_), reg )
1445 
1446  end if
1447 
1448  '' next reg
1449  reg = regTB(class_)->getNext( regTB(class_), reg )
1450  loop
1451 
1452  next
1453 
1454 end sub
1455 
1456 function hPreserveReg( byval vr as IRVREG ptr ) as integer
1457  dim as integer vr_dclass = any, vr_dtype = any, vr_typ = any
1458  dim as integer preserved1 = any, preserved2 = any
1459  dim as integer freg1 = any, freg2 = any
1460  dim as IRVREG origvreg = any, origvaux = any, destvreg = any
1461 
1462  '' If the vreg uses a register that isn't preserved across calls,
1463  '' we have to allocate another register that is preserved, and copy
1464  '' over the data. If there is no other free preserved register
1465  '' available, we must spill and put the data into a temp var on stack.
1466  ''
1467  '' For LONGINTs this is more complex, because both main and aux vregs
1468  '' must be checked. If either needs to be spilled, both should be
1469  '' spilled, to ensure the LONGINT's dwords stay together, either both
1470  '' in regs, or both on stack.
1471 
1472  hGetVREG( vr, vr_dtype, vr_dclass, vr_typ )
1473 
1474  assert( irIsREG( vr ) )
1475  origvreg = *vr
1476  preserved1 = emitIsRegPreserved( vr_dclass, vr->reg )
1477  if( ISLONGINT( vr_dtype ) ) then
1478  assert( irIsREG( vr->vaux ) )
1479  origvaux = *vr->vaux
1480  origvreg.vaux = @origvaux
1481  preserved2 = emitIsRegPreserved( vr_dclass, vr->vaux->reg )
1482  else
1483  preserved2 = TRUE
1484  end if
1485 
1486  if( preserved1 and preserved2 ) then
1487  '' Both vr and vaux (if any) already use regs that will be
1488  '' preserved, nothing to do
1489  return TRUE
1490  end if
1491 
1492  if( preserved1 = FALSE ) then
1493  '' Find a free preserved reg to copy to
1494  freg1 = emitGetFreePreservedReg( vr_dclass, vr_dtype )
1495  if( freg1 = INVALID ) then
1496  '' None free, need to spill
1497  return FALSE
1498  end if
1499  vr->reg = regTB(vr_dclass)->allocateReg( regTB(vr_dclass), freg1, vr, NULL )
1500  end if
1501 
1502  if( preserved2 = FALSE ) then
1503  '' Find a 2nd free preserved reg (this relies on the 1st one
1504  '' already being allocated, otherwise this would just return
1505  '' the same reg again)
1506  freg2 = emitGetFreePreservedReg( FB_DATACLASS_INTEGER, FB_DATATYPE_INTEGER )
1507  if( freg2 = INVALID ) then
1508  '' None free, need to spill
1509  if( preserved1 = FALSE ) then
1510  '' Restore vr to its old reg
1511  regTB(vr_dclass)->free( regTB(vr_dclass), vr->reg )
1512  vr->reg = origvreg.reg
1513  end if
1514  return FALSE
1515  end if
1516  vr->vaux->reg = regTB(FB_DATACLASS_INTEGER)->allocateReg( regTB(FB_DATACLASS_INTEGER), freg2, vr->vaux, vr )
1517  end if
1518 
1519  if( (not preserved1) and (not preserved2) ) then
1520  '' Both vr and its vaux changed, move both to their new regs
1521  emitMOV( vr, @origvreg )
1522  elseif( preserved1 = FALSE ) then
1523  '' vr changed, vaux (if any) didn't
1524  if( ISLONGINT( vr_dtype ) ) then
1525  '' Copy vr temporarily, remapping its type and removing
1526  '' the vaux vreg, so we can move only the low dword
1527  destvreg = *vr
1528  destvreg.dtype = FB_DATATYPE_INTEGER
1529  destvreg.vaux = NULL
1530 
1531  origvreg.dtype = FB_DATATYPE_INTEGER
1532  origvreg.vaux = NULL
1533 
1534  emitMOV( @destvreg, @origvreg )
1535  else
1536  emitMOV( vr, @origvreg )
1537  end if
1538  else
1539  '' vaux changed, vr didn't
1540  emitMOV( vr->vaux, @origvaux )
1541  end if
1542 
1543  '' Free the original register(s)
1544  if( preserved1 = FALSE ) then
1545  regTB(vr_dclass)->free( regTB(vr_dclass), origvreg.reg )
1546  end if
1547  if( preserved2 = FALSE ) then
1548  regTB(FB_DATACLASS_INTEGER)->free( regTB(FB_DATACLASS_INTEGER), origvaux.reg )
1549  end if
1550 
1551  function = TRUE
1552 end function
1553 
1554 sub hPreserveRegs( byval ptrvreg as IRVREG ptr = NULL )
1555  dim as integer npreg = any, reg = any
1556  dim as IRVREG ptr vr = any, vauxparent = any
1557 
1558  '' for each reg class
1559  for class_ as integer = 0 to EMIT_REGCLASSES-1
1560  '' set the register that shouldn't be preserved (used for CALLPTR only)
1561 
1562  npreg = INVALID
1563  if( class_ = FB_DATACLASS_INTEGER ) then
1564  if( ptrvreg <> NULL ) then
1565 
1566  select case ptrvreg->typ
1567  case IR_VREGTYPE_REG
1568  npreg = ptrvreg->reg
1569 
1570  case IR_VREGTYPE_IDX, IR_VREGTYPE_PTR
1571  ptrvreg = ptrvreg->vidx
1572  if( ptrvreg <> NULL ) then
1573  npreg = ptrvreg->reg
1574  end if
1575  end select
1576 
1577  ptrvreg = NULL
1578  end if
1579  end if
1580 
1581  '' for each register on that class
1582  reg = regTB(class_)->getFirst( regTB(class_) )
1583  do until( reg = INVALID )
1584  '' if not free
1585  if( (regTB(class_)->isFree( regTB(class_), reg ) = FALSE) and _
1586  (reg <> npreg) ) then
1587 
1588  '' get the attached vreg
1589  vr = regTB(class_)->getVreg( regTB(class_), reg, vauxparent )
1590  assert( irIsREG( vr ) and (vr->reg = reg) )
1591 
1592  '' If this is a LONGINT vreg's vaux, use the main vreg instead.
1593  '' This way we ensure that we'll always check both the main and
1594  '' aux vregs, no matter which one is found first in this loop.
1595  if( vauxparent ) then
1596  assert( vauxparent->vaux = vr )
1597  vr = vauxparent
1598  end if
1599 
1600  '' Move to other registers if needed and possible
1601  if( hPreserveReg( vr ) = FALSE ) then
1602  '' Failed, no more free regs, spill to stack
1603  irStoreVR( vr, NULL )
1604  end if
1605  end if
1606 
1607  '' next reg
1608  reg = regTB(class_)->getNext( regTB(class_), reg )
1609  loop
1610  next
1611 
1612 end sub
1613 
1614 '':::::
1615 sub hFlushCALL _
1616  ( _
1617  byval op as integer, _
1618  byval proc as FBSYMBOL ptr, _
1619  byval bytestopop as integer, _
1620  byval v1 as IRVREG ptr, _
1621  byval vr as IRVREG ptr _
1622  ) static
1623 
1624  dim as integer vr_dclass, vr_dtype, vr_typ, vr_reg, vr_reg2
1625  dim as IRVREG ptr va
1626 
1627  '' function?
1628  if( proc <> NULL ) then
1629  '' save used registers and free the FPU stack
1630  hPreserveRegs( )
1631 
1632  emitCALL( proc, bytestopop )
1633 
1634  '' call or jump to pointer..
1635  else
1636  '' if it's a CALL, save used registers and free the FPU stack
1637  if( op = AST_OP_CALLPTR ) then
1638  hPreserveRegs( v1 )
1639  end if
1640 
1641  '' load pointer
1642  hGetVREG( v1, vr_dtype, vr_dclass, vr_typ )
1643  hLoadIDX( v1 )
1644  if( vr_typ = IR_VREGTYPE_REG ) then
1645  regTB(vr_dclass)->ensure( regTB(vr_dclass), v1, NULL, typeGetSize( vr_dtype ) )
1646  end if
1647 
1648  '' CALLPTR
1649  if( op = AST_OP_CALLPTR ) then
1650  emitCALLPTR( v1, bytestopop )
1651  '' JUMPPTR
1652  else
1653  emitJUMPPTR( v1 )
1654  end if
1655 
1656  '' free pointer
1657  hFreeREG( v1 )
1658  end if
1659 
1660  '' load result
1661  if( vr <> NULL ) then
1662  hGetVREG( vr, vr_dtype, vr_dclass, vr_typ )
1663 
1664  emitGetResultReg( vr_dtype, vr_dclass, vr_reg, vr_reg2 )
1665 
1666  '' longints..
1667  if( ISLONGINT( vr_dtype ) ) then
1668  va = vr->vaux
1669  va->reg = regTB(vr_dclass)->allocateReg( regTB(vr_dclass), vr_reg2, va, vr )
1670  va->typ = IR_VREGTYPE_REG
1671  end if
1672 
1673  vr->reg = regTB(vr_dclass)->allocateReg( regTB(vr_dclass), vr_reg, vr, NULL )
1674  vr->typ = IR_VREGTYPE_REG
1675 
1676  '' fb allows function calls w/o saving the result
1677  hFreeREG( vr )
1678  end if
1679 
1680 end sub
1681 
1682 '':::::
1683 sub hFlushSTACK _
1684  ( _
1685  byval op as integer, _
1686  byval v1 as IRVREG ptr, _
1687  byval ex as integer _
1688  ) static
1689 
1690  dim as integer v1_typ, v1_dtype, v1_dclass
1691  dim as IRVREG ptr va
1692 
1693  ''
1694  if( op = AST_OP_STACKALIGN ) then
1695  emitSTACKALIGN( ex )
1696  exit sub
1697  end if
1698 
1699  ''
1700  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
1701 
1702  hLoadIDX( v1 )
1703 
1704  '' load only if it's a reg (x86 assumption)
1705  if( v1_typ = IR_VREGTYPE_REG ) then
1706  '' handle longint
1707  if( ISLONGINT( v1_dtype ) ) then
1708  va = v1->vaux
1709  regTB(v1_dclass)->ensure( regTB(v1_dclass), va, v1, typeGetSize( FB_DATATYPE_INTEGER ) )
1710  v1_dtype = FB_DATATYPE_INTEGER
1711  end if
1712  regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
1713  end if
1714 
1715  ''
1716  select case op
1717  case AST_OP_PUSH
1718  emitPUSH( v1 )
1719  case AST_OP_PUSHUDT
1720  emitPUSHUDT( v1, ex )
1721  case AST_OP_POP
1722  emitPOP( v1 )
1723  end select
1724 
1725  ''
1726  hFreeREG( v1 )
1727 
1728 end sub
1729 
1730 '':::::
1731 sub hFlushUOP _
1732  ( _
1733  byval op as integer, _
1734  byval v1 as IRVREG ptr, _
1735  byval vr as IRVREG ptr _
1736  ) static
1737 
1738  dim as integer v1_typ, v1_dtype, v1_dclass
1739  dim as integer vr_typ, vr_dtype, vr_dclass
1740  dim as IRVREG ptr va
1741 
1742  dim as integer v1vector
1743  v1vector = v1->vector
1744 
1745  ''
1746  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
1747  hGetVREG( vr, vr_dtype, vr_dclass, vr_typ )
1748 
1749  hLoadIDX( v1 )
1750  hLoadIDX( vr )
1751 
1752  ''
1753  if ( vr <> NULL ) then
1754  if( v1 <> vr ) then
1755  '' handle longint
1756  if( ISLONGINT( vr_dtype ) ) then
1757  va = vr->vaux
1758  regTB(vr_dclass)->ensure( regTB(vr_dclass), va, vr, typeGetSize( FB_DATATYPE_INTEGER ) )
1759  vr_dtype = FB_DATATYPE_INTEGER
1760  end if
1761  regTB(vr_dclass)->ensure( regTB(vr_dclass), vr, NULL, typeGetSize( vr_dtype ) )
1762  end if
1763  end if
1764 
1765  '' UOP to self? x86 assumption at AST
1766  if( vr <> NULL ) then
1767  '' handle longint
1768  if( ISLONGINT( v1_dtype ) ) then
1769  va = v1->vaux
1770  regTB(v1_dclass)->ensure( regTB(v1_dclass), va, v1, typeGetSize( FB_DATATYPE_INTEGER ) )
1771  v1_dtype = FB_DATATYPE_INTEGER
1772  end if
1773 
1774  if( op = AST_OP_SWZ_REPEAT ) then
1775  '' v1 must be loaded as a scalar
1776  v1->vector = 0
1777  end if
1778 
1779  regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
1780 
1781  if( op = AST_OP_SWZ_REPEAT ) then
1782  v1->vector = v1vector
1783  end if
1784  end if
1785 
1786  ''
1787  select case as const op
1788  case AST_OP_NEG
1789  emitNEG( v1 )
1790  case AST_OP_NOT
1791  emitNOT( v1 )
1792 
1793  case AST_OP_HADD
1794  emitHADD( v1 )
1795  v1->vector = 0
1796 
1797  case AST_OP_ABS
1798  emitABS( v1 )
1799  case AST_OP_SGN
1800  emitSGN( v1 )
1801  case AST_OP_FIX
1802  emitFIX( v1 )
1803  case AST_OP_FRAC
1804  emitFRAC( v1 )
1805  case AST_OP_CONVFD2FS
1806  emitCONVFD2FS( v1 )
1807 
1808  case AST_OP_SIN
1809  emitSIN( v1 )
1810  case AST_OP_ASIN
1811  emitASIN( v1 )
1812  case AST_OP_COS
1813  emitCOS( v1 )
1814  case AST_OP_ACOS
1815  emitACOS( v1 )
1816  case AST_OP_TAN
1817  emitTAN( v1 )
1818  case AST_OP_ATAN
1819  emitATAN( v1 )
1820  case AST_OP_SQRT
1821  emitSQRT( v1 )
1822  case AST_OP_RSQRT
1823  emitRSQRT( v1 )
1824  case AST_OP_RCP
1825  emitRCP( v1 )
1826  case AST_OP_LOG
1827  emitLOG( v1 )
1828  case AST_OP_EXP
1829  emitEXP( v1 )
1830  case AST_OP_FLOOR
1831  emitFLOOR( v1 )
1832 
1833  case AST_OP_SWZ_REPEAT
1834  emitSWZREP( v1 )
1835 
1836  end select
1837 
1838  ''
1839  if ( vr <> NULL ) then
1840  if( v1 <> vr ) then
1841  emitMOV( vr, v1 )
1842  end if
1843  end if
1844 
1845  ''
1846  hFreeREG( v1 )
1847  hFreeREG( vr )
1848 
1849 end sub
1850 
1851 '':::::
1852 sub hFlushBOP _
1853  ( _
1854  byval op as integer, _
1855  byval v1 as IRVREG ptr, _
1856  byval v2 as IRVREG ptr, _
1857  byval vr as IRVREG ptr _
1858  ) static
1859 
1860  dim as integer v1_typ, v1_dtype, v1_dclass
1861  dim as integer v2_typ, v2_dtype, v2_dclass
1862  dim as integer vr_typ, vr_dtype, vr_dclass
1863  dim as IRVREG ptr va
1864 
1865  ''
1866  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
1867  hGetVREG( v2, v2_dtype, v2_dclass, v2_typ )
1868  hGetVREG( vr, vr_dtype, vr_dclass, vr_typ )
1869 
1870  hLoadIDX( v1 )
1871  hLoadIDX( v2 )
1872  hLoadIDX( vr )
1873 
1874  '' BOP to self? (x86 assumption at AST)
1875  if( vr = NULL ) then
1876  if( v2_typ <> IR_VREGTYPE_IMM ) then '' x86 assumption
1877  '' handle longint
1878  if( ISLONGINT( v2_dtype ) ) then
1879  va = v2->vaux
1880  regTB(v2_dclass)->ensure( regTB(v2_dclass), va, v2, typeGetSize( FB_DATATYPE_INTEGER ) )
1881  v2_dtype = FB_DATATYPE_INTEGER
1882  end if
1883  regTB(v2_dclass)->ensure( regTB(v2_dclass), v2, NULL, typeGetSize( v2_dtype ) )
1884  end if
1885  else
1886  if( v2_typ = IR_VREGTYPE_REG ) then '' x86 assumption
1887  '' handle longint
1888  if( ISLONGINT( v2_dtype ) ) then
1889  va = v2->vaux
1890  regTB(v2_dclass)->ensure( regTB(v2_dclass), va, v2, typeGetSize( FB_DATATYPE_INTEGER ) )
1891  v2_dtype = FB_DATATYPE_INTEGER
1892  end if
1893  regTB(v2_dclass)->ensure( regTB(v2_dclass), v2, NULL, typeGetSize( v2_dtype ) )
1894  end if
1895 
1896  '' destine allocation comes *after* source, 'cause the x86 FPU stack
1897  '' handle longint
1898  if( ISLONGINT( v1_dtype ) ) then
1899  va = v1->vaux
1900  regTB(v1_dclass)->ensure( regTB(v1_dclass), va, v1, typeGetSize( FB_DATATYPE_INTEGER ) )
1901  v1_dtype = FB_DATATYPE_INTEGER
1902  end if
1903  regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
1904  end if
1905 
1906  ''
1907  select case as const op
1908  case AST_OP_ADD
1909  emitADD( v1, v2 )
1910  case AST_OP_SUB
1911  emitSUB( v1, v2 )
1912  case AST_OP_MUL
1913  emitMUL( v1, v2 )
1914  case AST_OP_DIV
1915  emitDIV( v1, v2 )
1916  case AST_OP_INTDIV
1917  emitINTDIV( v1, v2 )
1918  case AST_OP_MOD
1919  emitMOD( v1, v2 )
1920 
1921  case AST_OP_SHL
1922  emitSHL( v1, v2 )
1923  case AST_OP_SHR
1924  emitSHR( v1, v2 )
1925 
1926  case AST_OP_AND
1927  emitAND( v1, v2 )
1928  case AST_OP_OR
1929  emitOR( v1, v2 )
1930  case AST_OP_XOR
1931  emitXOR( v1, v2 )
1932  case AST_OP_EQV
1933  emitEQV( v1, v2 )
1934  case AST_OP_IMP
1935  emitIMP( v1, v2 )
1936 
1937  case AST_OP_ATAN2
1938  emitATN2( v1, v2 )
1939  case AST_OP_POW
1940  emitPOW( v1, v2 )
1941  end select
1942 
1943  '' not BOP to self?
1944  if ( vr <> NULL ) then
1945  '' result not equal destine? (can happen with DAG optimizations)
1946  if( (v1 <> vr) ) then
1947  '' handle longint
1948  if( ISLONGINT( vr_dtype ) ) then
1949  va = vr->vaux
1950  regTB(vr_dclass)->ensure( regTB(vr_dclass), va, vr, typeGetSize( FB_DATATYPE_INTEGER ) )
1951  vr_dtype = FB_DATATYPE_INTEGER
1952  end if
1953  regTB(vr_dclass)->ensure( regTB(vr_dclass), vr, NULL, typeGetSize( vr_dtype ) )
1954  emitMOV( vr, v1 )
1955  end if
1956  end if
1957 
1958  ''
1959  hFreeREG( v1 )
1960  hFreeREG( v2 )
1961  hFreeREG( vr )
1962 
1963 end sub
1964 
1965 '':::::
1966 sub hFlushCOMP _
1967  ( _
1968  byval op as integer, _
1969  byval v1 as IRVREG ptr, _
1970  byval v2 as IRVREG ptr, _
1971  byval vr as IRVREG ptr, _
1972  byval label as FBSYMBOL ptr _
1973  ) static
1974 
1975  dim as string lname
1976  dim as integer v1_typ, v1_dtype, v1_dclass
1977  dim as integer v2_typ, v2_dtype, v2_dclass
1978  dim as integer vr_typ, vr_dtype, vr_dclass
1979  dim as IRVREG ptr va
1980  dim as integer doload
1981 
1982  ''
1983  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
1984  hGetVREG( v2, v2_dtype, v2_dclass, v2_typ )
1985  hGetVREG( vr, vr_dtype, vr_dclass, vr_typ )
1986 
1987  hLoadIDX( v1 )
1988  hLoadIDX( v2 )
1989  hLoadIDX( vr )
1990 
1991  '' load source if it's a reg, or if result was not allocated
1992  doload = FALSE
1993  if( vr = NULL ) then '' x86 assumption
1994  if( v2_dclass = FB_DATACLASS_INTEGER ) then '' /
1995  if( v2_typ <> IR_VREGTYPE_IMM ) then '' /
1996  if( v1_dclass <> FB_DATACLASS_FPOINT ) then
1997  doload = TRUE
1998  end if
1999  end if
2000  end if
2001  end if
2002 
2003  if( (v2_typ = IR_VREGTYPE_REG) or doload ) then
2004  '' handle longint
2005  if( ISLONGINT( v2_dtype ) ) then
2006  va = v2->vaux
2007  regTB(v2_dclass)->ensure( regTB(v2_dclass), va, v2, typeGetSize( FB_DATATYPE_INTEGER ) )
2008  v2_dtype = FB_DATATYPE_INTEGER
2009  end if
2010  regTB(v2_dclass)->ensure( regTB(v2_dclass), v2, NULL, typeGetSize( v2_dtype ) )
2011  v2_typ = IR_VREGTYPE_REG
2012  end if
2013 
2014  '' destine allocation comes *after* source, 'cause the FPU stack
2015  doload = FALSE
2016  if( (vr <> NULL) and (vr = v1) ) then '' x86 assumption
2017  doload = TRUE
2018  elseif( v1_dclass = FB_DATACLASS_FPOINT ) then '' /
2019  doload = TRUE
2020  elseif( v1_typ = IR_VREGTYPE_IMM) then '' /
2021  doload = TRUE
2022  elseif( v2_typ <> IR_VREGTYPE_REG ) then '' /
2023  if( v2_typ <> IR_VREGTYPE_IMM ) then
2024  doload = TRUE
2025  end if
2026  end if
2027 
2028  if( (v1_typ = IR_VREGTYPE_REG) or doload ) then
2029  '' handle longint
2030  if( ISLONGINT( v1_dtype ) ) then
2031  va = v1->vaux
2032  regTB(v1_dclass)->ensure( regTB(v1_dclass), va, v1, typeGetSize( FB_DATATYPE_INTEGER ) )
2033  v1_dtype = FB_DATATYPE_INTEGER
2034  end if
2035  regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
2036  end if
2037 
2038  '' result not equal destine? (can happen with DAG optimizations and floats comparations)
2039  if( vr <> NULL ) then
2040  if( vr <> v1 ) then
2041  vr->reg = regTB(vr_dclass)->_allocate( regTB(vr_dclass), vr, NULL, typeGetSize( vr_dtype ) )
2042  vr->typ = IR_VREGTYPE_REG
2043  end if
2044  end if
2045 
2046  ''
2047  select case as const op
2048  case AST_OP_EQ
2049  emitEQ( vr, label, v1, v2 )
2050  case AST_OP_NE
2051  emitNE( vr, label, v1, v2 )
2052  case AST_OP_GT
2053  emitGT( vr, label, v1, v2 )
2054  case AST_OP_LT
2055  emitLT( vr, label, v1, v2 )
2056  case AST_OP_LE
2057  emitLE( vr, label, v1, v2 )
2058  case AST_OP_GE
2059  emitGE( vr, label, v1, v2 )
2060  end select
2061 
2062  ''
2063  hFreeREG( v1 )
2064  hFreeREG( v2 )
2065  if( vr <> NULL ) then
2066  hFreeREG( vr )
2067  end if
2068 
2069 end sub
2070 
2072  dim as IRVREG ptr vr = any, vauxparent = any
2073  dim as integer reg = any
2074 
2075  '' for each reg class
2076  for class_ as integer = 0 to EMIT_REGCLASSES-1
2077  '' for each register on that class
2078  reg = regTB(class_)->getFirst( regTB(class_) )
2079  do until( reg = INVALID )
2080  '' if not free
2081  if( regTB(class_)->isFree( regTB(class_), reg ) = FALSE ) then
2082  '' get the attached vreg
2083  vr = regTB(class_)->getVreg( regTB(class_), reg, vauxparent )
2084  assert( irIsREG( vr ) )
2085  assert( vr->reg = reg )
2086 
2087  '' spill
2088  irStoreVR( vr, vauxparent )
2089  end if
2090 
2091  '' next reg
2092  reg = regTB(class_)->getNext( regTB(class_), reg )
2093  loop
2094  next
2095 end sub
2096 
2097 '':::::
2098 sub hFlushSTORE _
2099  ( _
2100  byval op as integer, _
2101  byval v1 as IRVREG ptr, _
2102  byval v2 as IRVREG ptr _
2103  ) static
2104 
2105  dim as integer v1_typ, v1_dtype, v1_dclass
2106  dim as integer v2_typ, v2_dtype, v2_dclass
2107  dim as IRVREG ptr va
2108 
2109  ''
2110  if( op = AST_OP_SPILLREGS ) then
2111  hSpillRegs( )
2112  exit sub
2113  end if
2114 
2115  ''
2116  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
2117  hGetVREG( v2, v2_dtype, v2_dclass, v2_typ )
2118 
2119  hLoadIDX( v1 )
2120  hLoadIDX( v2 )
2121 
2122  '' if dst is a fpoint, only load src if its a reg (x86 assumption)
2123  if( (v2_typ = IR_VREGTYPE_REG) or _
2124  ((v2_typ <> IR_VREGTYPE_IMM) and (v1_dclass = FB_DATACLASS_INTEGER)) ) then
2125  '' handle longint
2126  if( ISLONGINT( v2_dtype ) ) then
2127  va = v2->vaux
2128  regTB(v2_dclass)->ensure( regTB(v2_dclass), va, v2, typeGetSize( FB_DATATYPE_INTEGER ) )
2129  v2_dtype = FB_DATATYPE_INTEGER
2130  end if
2131  regTB(v2_dclass)->ensure( regTB(v2_dclass), v2, NULL, typeGetSize( v2_dtype ) )
2132  end if
2133 
2134  ''
2135  emitSTORE( v1, v2 )
2136 
2137  ''
2138  hFreeREG( v1 )
2139  hFreeREG( v2 )
2140 
2141 end sub
2142 
2143 '':::::
2144 sub hFlushLOAD _
2145  ( _
2146  byval op as integer, _
2147  byval v1 as IRVREG ptr, _
2148  byval vr as IRVREG ptr _
2149  ) static
2150 
2151  dim as integer v1_typ, v1_dtype, v1_dclass, v1_reg
2152  dim as IRVREG ptr va
2153 
2154  ''
2155  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
2156 
2157  hLoadIDX( v1 )
2158 
2159  ''
2160  select case op
2161  case AST_OP_LOAD
2162  '' handle longint
2163  if( ISLONGINT( v1_dtype ) ) then
2164  va = v1->vaux
2165  regTB(v1_dclass)->ensure( regTB(v1_dclass), va, v1, typeGetSize( FB_DATATYPE_INTEGER ) )
2166  v1_dtype = FB_DATATYPE_INTEGER
2167  end if
2168  regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
2169 
2170  case AST_OP_LOADRES
2171  if( v1_typ = IR_VREGTYPE_REG ) then
2172  '' handle longint
2173  if( ISLONGINT( v1_dtype ) ) then
2174  va = v1->vaux
2175  regTB(v1_dclass)->ensure( regTB(v1_dclass), va, v1, typeGetSize( FB_DATATYPE_INTEGER ) )
2176  '' can't change v1_dtype
2177  v1_reg = regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( FB_DATATYPE_INTEGER ) )
2178  else
2179  v1_reg = regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
2180  end if
2181  else
2182  v1_reg = INVALID
2183  end if
2184 
2185  dim as integer vr_reg, vr_reg2
2186 
2187  emitGetResultReg( v1_dtype, v1_dclass, vr_reg, vr_reg2 )
2188 
2189  if( vr_reg <> v1_reg ) then
2190  '' handle longint
2191  if( ISLONGINT( v1_dtype ) ) then
2192  va = vr->vaux
2193  va->reg = regTB(v1_dclass)->allocateReg( regTB(v1_dclass), vr_reg2, va, vr )
2194  va->typ = IR_VREGTYPE_REG
2195  end if
2196 
2197  vr->reg = regTB(v1_dclass)->allocateReg( regTB(v1_dclass), vr_reg, vr, NULL )
2198  vr->typ = IR_VREGTYPE_REG
2199 
2200  '' decide where to put the float (st(0) or xmm0) at the end of the function
2201  if( ast.proc.curr->sym->proc.returnMethod <> FB_RETURN_SSE ) then
2202  vr->regFamily = IR_REG_FPU_STACK
2203  end if
2204 
2205  ''
2206  emitLOAD( vr, v1 )
2207 
2208  ''
2209  hFreeREG( vr ) '' assuming this is the last operation
2210  end if
2211  end select
2212 
2213  ''
2214  hFreeREG( v1 )
2215 
2216 end sub
2217 
2218 '':::::
2219 sub hFlushCONVERT _
2220  ( _
2221  byval op as integer, _
2222  byval v1 as IRVREG ptr, _
2223  byval v2 as IRVREG ptr _
2224  ) static
2225 
2226  dim as integer v1_typ, v1_dtype, v1_dclass
2227  dim as integer v2_typ, v2_dtype, v2_dclass
2228  dim as integer reuse
2229  dim as IRVREG ptr va
2230 
2231  ''
2232  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
2233  hGetVREG( v2, v2_dtype, v2_dclass, v2_typ )
2234 
2235  hLoadIDX( v1 )
2236  hLoadIDX( v2 )
2237 
2238  '' x86 assumption: if src is a reg and if classes are the same and
2239  '' src won't be used (DAG?), reuse src
2240  reuse = FALSE
2241  if( (v1_dclass = v2_dclass) and (v2_typ = IR_VREGTYPE_REG) ) then
2242 
2243  '' fp to fp conversion with source already on stack? do nothing..
2244  if( v2_dclass = FB_DATACLASS_FPOINT ) then
2245  if( irGetOption( IR_OPT_FPUCONV ) ) then
2246  v1->regFamily = v2->regFamily
2247  if( v2->regFamily = IR_REG_FPU_STACK ) then exit sub
2248  else
2249  v1->reg = v2->reg
2250  v2->reg = INVALID
2251  v1->typ = IR_VREGTYPE_REG
2252  regTB(v1_dclass)->setOwner( regTB(v1_dclass), v1->reg, v1, NULL )
2253  exit sub
2254  end if
2255  end if
2256 
2257  '' it's an integer, check if used again
2258  if( irGetDistance( v2 ) = IR_MAXDIST ) then
2259  '' don't reuse if any operand is a byte (because [E]SI/[E]DI) or longint
2260  select case typeGetSize( v1_dtype )
2261  case 1, 8
2262 
2263  case else
2264  select case typeGetSize( v2_dtype )
2265  case 1, 8
2266 
2267  case else
2268  reuse = TRUE
2269  end select
2270  end select
2271  end if
2272  end if
2273 
2274  if( reuse ) then
2275  v1->reg = v2->reg
2276  v1->typ = IR_VREGTYPE_REG
2277  regTB(v1_dclass)->setOwner( regTB(v1_dclass), v1->reg, v1, NULL )
2278  else
2279  if( v2_typ = IR_VREGTYPE_REG ) then '' x86 assumption
2280  '' handle longint
2281  if( ISLONGINT( v2_dtype ) ) then
2282  va = v2->vaux
2283  regTB(v2_dclass)->ensure( regTB(v2_dclass), va, v2, typeGetSize( FB_DATATYPE_INTEGER ) )
2284  v2_dtype = FB_DATATYPE_INTEGER
2285  end if
2286  regTB(v2_dclass)->ensure( regTB(v2_dclass), v2, NULL, typeGetSize( v2_dtype ) )
2287  end if
2288 
2289  '' handle longint
2290  if( ISLONGINT( v1_dtype ) ) then
2291  va = v1->vaux
2292  va->reg = regTB(v1_dclass)->_allocate( regTB(v1_dclass), va, v1, typeGetSize( FB_DATATYPE_INTEGER ) )
2293  va->typ = IR_VREGTYPE_REG
2294  v1_dtype = FB_DATATYPE_INTEGER
2295  end if
2296  v1->reg = regTB(v1_dclass)->_allocate( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
2297  v1->typ = IR_VREGTYPE_REG
2298  end if
2299 
2300  ''
2301  emitLOAD( v1, v2 )
2302 
2303  ''
2304  if( reuse = FALSE ) then
2305  hFreeREG( v2 )
2306  else
2307  v2->reg = INVALID
2308  end if
2309 
2310  ''
2311  hFreeREG( v1 )
2312 
2313 end sub
2314 
2315 '':::::
2316 sub hFlushADDR _
2317  ( _
2318  byval op as integer, _
2319  byval v1 as IRVREG ptr, _
2320  byval vr as IRVREG ptr _
2321  ) static
2322 
2323  dim as integer v1_typ, v1_dtype, v1_dclass
2324  dim as integer vr_typ, vr_dtype, vr_dclass
2325 
2326  ''
2327  hGetVREG( v1, v1_dtype, v1_dclass, v1_typ )
2328  hGetVREG( vr, vr_dtype, vr_dclass, vr_typ )
2329 
2330  hLoadIDX( v1 )
2331  hLoadIDX( vr )
2332 
2333  ''
2334  if( v1_typ = IR_VREGTYPE_REG ) then '' x86 assumption
2335  regTB(v1_dclass)->ensure( regTB(v1_dclass), v1, NULL, typeGetSize( v1_dtype ) )
2336  end if
2337 
2338  if( vr_typ = IR_VREGTYPE_REG ) then '' x86 assumption
2339  regTB(vr_dclass)->ensure( regTB(vr_dclass), vr, NULL, typeGetSize( vr_dtype ) )
2340  end if
2341 
2342  ''
2343  select case op
2344  case AST_OP_ADDROF
2345  emitADDROF( vr, v1 )
2346  case AST_OP_DEREF
2347  emitDEREF( vr, v1 )
2348  end select
2349 
2350  ''
2351  hFreeREG( v1 )
2352  hFreeREG( vr )
2353 
2354 end sub
2355 
2356 '':::::
2357 sub hFlushMEM _
2358  ( _
2359  byval op as integer, _
2360  byval v1 as IRVREG ptr, _
2361  byval v2 as IRVREG ptr, _
2362  byval bytes as integer, _
2363  byval extra as any ptr _
2364  ) static
2365 
2366  ''
2367  hLoadIDX( v1 )
2368  hLoadIDX( v2 )
2369 
2370  ''
2371  select case as const op
2372  case AST_OP_MEMMOVE
2373  emitMEMMOVE( v1, v2, bytes )
2374 
2375  case AST_OP_MEMSWAP
2376  emitMEMSWAP( v1, v2, bytes )
2377 
2378  case AST_OP_MEMCLEAR
2379  emitMEMCLEAR( v1, v2 )
2380 
2381  case AST_OP_STKCLEAR
2382  emitSTKCLEAR( bytes, cint( extra ) )
2383  end select
2384 
2385  ''
2386  hFreeREG( v1 )
2387  hFreeREG( v2 )
2388 
2389 end sub
2390 
2391 '':::::
2392 sub hFlushDBG _
2393  ( _
2394  byval op as integer, _
2395  byval proc as FBSYMBOL ptr, _
2396  byval ex as integer _
2397  )
2398 
2399  select case as const op
2400  case AST_OP_DBG_LINEINI
2401  emitDBGLineBegin( proc, ex )
2402 
2403  case AST_OP_DBG_LINEEND
2404  emitDBGLineEnd( proc, ex )
2405 
2406  case AST_OP_DBG_SCOPEINI
2407  emitDBGScopeBegin( cast( FBSYMBOL ptr, ex ) )
2408 
2409  case AST_OP_DBG_SCOPEEND
2410  emitDBGScopeEnd( cast( FBSYMBOL ptr, ex ) )
2411  end select
2412 
2413 end sub
2414 
2415 sub hFlushLIT( byval op as integer, byval text as zstring ptr )
2416  select case op
2417  case AST_OP_LIT_COMMENT
2418  emitComment( text )
2419  case AST_OP_LIT_ASM
2420  emitASM( text )
2421  end select
2422 
2423  ZstrFree( text )
2424 end sub
2425 
2426 ''::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
2427 
2428 '':::::
2429 sub hFreeIDX _
2430  ( _
2431  byval vreg as IRVREG ptr, _
2432  byval force as integer = FALSE _
2433  )
2434 
2435  dim as IRVREG ptr vidx
2436 
2437  if( vreg = NULL ) then
2438  exit sub
2439  end if
2440 
2441  vidx = vreg->vidx
2442  if( vidx <> NULL ) then
2443  if( vidx->reg <> INVALID ) then
2444  hFreeREG( vidx, force ) '' recursively
2445  vreg->vidx = NULL
2446  end if
2447  end if
2448 
2449 end sub
2450 
2451 '':::::
2452 sub hFreeREG _
2453  ( _
2454  byval vreg as IRVREG ptr, _
2455  byval force as integer = FALSE _
2456  )
2457 
2458  dim as integer dclass, dist
2459  dim as IRVREG ptr vaux
2460 
2461  if( vreg = NULL ) then
2462  exit sub
2463  end if
2464 
2465  '' free any attached index
2466  hFreeIDX( vreg, force )
2467 
2468  ''
2469  if( vreg->typ <> IR_VREGTYPE_REG ) then
2470  exit sub
2471  end if
2472 
2473  if( vreg->reg = INVALID ) then
2474  exit sub
2475  end if
2476 
2477  ''
2478  dist = IR_MAXDIST
2479  if( force = FALSE ) then
2480  dist = irGetDistance( vreg )
2481  end if
2482 
2483  if( dist = IR_MAXDIST ) then
2484  '' aux?
2485  if( vreg->vaux <> NULL ) then
2486  vaux = vreg->vaux
2487  if( vaux->reg <> INVALID ) then
2488  hFreeREG( vaux, TRUE )
2489  end if
2490  end if
2491 
2492  dclass = typeGetClass(vreg->dtype)
2493  regTB(dclass)->free( regTB(dclass), vreg->reg )
2494  vreg->reg = INVALID
2495  end if
2496 
2497 end sub
2498 
2499 '':::::
2500 function _GetDistance _
2501  ( _
2502  byval vreg as IRVREG ptr _
2503  ) as uinteger
2504 
2505  dim as IRVREG ptr v
2506  dim as IRTAC ptr t
2507  dim as integer dist
2508 
2509  if( vreg = NULL ) then
2510  return IR_MAXDIST
2511  end if
2512 
2513  '' skip the current tac
2514  t = flistGetNext( ctx.tacidx )
2515 
2516  '' eol?
2517  if( t = NULL ) then
2518  return IR_MAXDIST
2519  end if
2520 
2521  ''
2522  dist = vreg->taclast->pos - t->pos
2523 
2524  '' not used anymore?
2525  if( dist < 0 ) then
2526  function = IR_MAXDIST
2527  else
2528  function = dist
2529  end if
2530 
2531 end function
2532 
2533 sub _loadVR _
2534  ( _
2535  byval reg as integer, _
2536  byval vreg as IRVREG ptr, _
2537  byval vauxparent as IRVREG ptr _
2538  )
2539 
2540  dim as IRVREG rvreg
2541 
2542  if( vreg->typ <> IR_VREGTYPE_REG ) then
2543  '' Don't load aux vregs now - they'll be loaded when their
2544  '' parent vreg is loaded
2545  if( vauxparent = NULL ) then
2546  rvreg.typ = IR_VREGTYPE_REG
2547  rvreg.dtype = vreg->dtype
2548  rvreg.reg = reg
2549  rvreg.vaux = vreg->vaux
2550  rvreg.regFamily = vreg->regFamily
2551  emitLOAD( @rvreg, vreg )
2552  end if
2553 
2554  '' free any attached reg, forcing if needed
2555  hFreeIDX( vreg, TRUE )
2556 
2557  vreg->typ = IR_VREGTYPE_REG
2558  end if
2559 
2560  vreg->reg = reg
2561 
2562  if( (env.clopt.fputype >= FB_FPUTYPE_SSE) and (vauxparent <> NULL) ) then
2563  vreg->regFamily = IR_REG_SSE
2564  end if
2565 
2566 end sub
2567 
2568 sub _storeVR _
2569  ( _
2570  byval vreg as IRVREG ptr, _
2571  byval vauxparent as IRVREG ptr _
2572  )
2573 
2574  dim as IRVREG origvreg = any, origvaux = any
2575  dim as integer vr_dclass = any
2576 
2577  if( vauxparent ) then
2578  assert( vauxparent->vaux = vreg )
2579  vreg = vauxparent
2580  end if
2581 
2582  '' Store a REG vreg into a temp var on stack (spilling registers)
2583  '' If this is a LONGINT vreg or the vaux of a LONGINT vreg, then the
2584  '' whole qword (both vregs) should be spilled, not just one dword.
2585  '' This way we ensure to always keep the two dwords together, either
2586  '' both in registers or both in consecutive memory.
2587  '' This also allows us to free up the registers used by the vreg(s).
2588 
2589  assert( irIsREG( vreg ) )
2590  assert( iif( vreg->vaux, irIsREG( vreg->vaux ), TRUE ) )
2591 
2592  '' Back up the old vreg
2593  origvreg = *vreg
2594  if( ISLONGINT( vreg->dtype ) ) then
2595  '' Back up the old vaux too
2596  origvaux = *vreg->vaux
2597  origvreg.vaux = @origvaux
2598  end if
2599 
2600  if( irGetDistance( vreg ) <> IR_MAXDIST ) then
2601  '' Turn the old vreg into a VAR
2602  vreg->typ = IR_VREGTYPE_VAR
2603  vreg->sym = symbAddAndAllocateTempVar( vreg->dtype )
2604  vreg->ofs = symbGetOfs( vreg->sym )
2605  vreg->reg = INVALID
2606  if( ISLONGINT( vreg->dtype ) ) then
2607  '' Turn the old vaux into a VAR
2608  vreg->vaux->reg = INVALID
2609  vreg->vaux->typ = IR_VREGTYPE_VAR
2610  vreg->vaux->ofs = vreg->ofs + 4 '' vaux = the upper 4 bytes
2611  end if
2612  if( env.clopt.fputype >= FB_FPUTYPE_SSE ) then
2613  vreg->regFamily = IR_REG_SSE
2614  end if
2615 
2616  '' Copy data from old vreg into new VAR vreg
2617  emitSTORE( vreg, @origvreg )
2618  end if
2619 
2620  if( ISLONGINT( origvreg.dtype ) ) then
2621  regTB(FB_DATACLASS_INTEGER)->free( regTB(FB_DATACLASS_INTEGER), origvaux.reg )
2622  end if
2623  vr_dclass = typeGetClass( origvreg.dtype )
2624  regTB(vr_dclass)->free( regTB(vr_dclass), origvreg.reg )
2625 
2626 end sub
2627 
2628 '':::::
2629 sub _xchgTOS _
2630  ( _
2631  byval reg as integer _
2632  ) static
2633 
2634  dim as IRVREG rvreg
2635 
2636  rvreg.typ = IR_VREGTYPE_REG
2637  rvreg.dtype = FB_DATATYPE_DOUBLE
2638  rvreg.reg = reg
2639 
2640  emitXchgTOS( @rvreg )
2641 
2642 end sub
2643 
2644 ''::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
2645 
2646 dim shared as IR_VTBL irtac_vtbl = _
2647 ( _
2648  @_init, _
2649  @_end, _
2650  @_emitBegin, _
2651  @_emitEnd, _
2652  @_getOptionValue, _
2653  @_procBegin, _
2654  @_procEnd, _
2655  @_procAllocArg, _
2656  @_procAllocLocal, _
2658  @_scopeBegin, _
2659  @_scopeEnd, _
2661  @_emitConvert, _
2662  @_emitLabel, _
2663  @_emitLabelNF, _
2664  @_emitReturn, _
2665  @_emitProcBegin, _
2666  @_emitProcEnd, _
2667  @_emitPushArg, _
2668  @_emitAsmBegin, _
2669  @_emitAsmText, _
2670  @_emitAsmSymb, _
2671  @_emitAsmEnd, _
2672  @_emitComment, _
2673  @_emitBop, _
2674  @_emitUop, _
2675  @_emitStore, _
2676  @_emitSpillRegs, _
2677  @_emitLoad, _
2678  @_emitLoadRes, _
2679  @_emitStack, _
2680  @_emitAddr, _
2681  @_emitCall, _
2682  @_emitCallPtr, _
2683  @_emitStackAlign, _
2684  @_emitJumpPtr, _
2685  @_emitBranch, _
2686  @_emitJmpTb, _
2687  @_emitMem, _
2688  @_emitScopeBegin, _
2689  @_emitScopeEnd, _
2690  @_emitDECL, _
2691  @_emitDBG, _
2692  @_emitVarIniBegin, _
2693  @_emitVarIniEnd, _
2694  @_emitVarIniI, _
2695  @_emitVarIniF, _
2696  @_emitVarIniOfs, _
2697  @_emitVarIniStr, _
2698  @_emitVarIniWstr, _
2699  @_emitVarIniPad, _
2702  @_emitFbctinfBegin, _
2703  @_emitFbctinfString, _
2704  @_emitFbctinfEnd, _
2705  @_allocVreg, _
2706  @_allocVrImm, _
2707  @_allocVrImmF, _
2708  @_allocVrVar, _
2709  @_allocVrIdx, _
2710  @_allocVrPtr, _
2711  @_allocVrOfs, _
2712  @_setVregDataType, _
2713  @_getDistance, _
2714  @_loadVr, _
2715  @_storeVr, _
2716  @_xchgTOS _
2717 )
2718