FoxAMDBackend.Mod 143 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710
  1. MODULE FoxAMDBackend; (** AUTHOR ""; PURPOSE ""; *)
  2. IMPORT
  3. Basic := FoxBasic, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Backend := FoxBackend, Sections := FoxSections,
  4. IntermediateCode := FoxIntermediateCode, IntermediateBackend := FoxIntermediateBackend, BinaryCode := FoxBinaryCode,
  5. InstructionSet := FoxAMD64InstructionSet, Assembler := FoxAMD64Assembler, SemanticChecker := FoxSemanticChecker, Formats := FoxFormats,
  6. Diagnostics, Streams, Options, Strings, ObjectFileFormat := FoxGenericObjectFile, Compiler,
  7. Machine, D := Debugging, CodeGenerators := FoxCodeGenerators, ObjectFile;
  8. CONST
  9. (* constants for the register allocator *)
  10. none=-1;
  11. RAX=InstructionSet.regRAX; RCX=InstructionSet.regRCX; RDX=InstructionSet.regRDX; RBX=InstructionSet.regRBX;
  12. RSP=InstructionSet.regRSP; RBP=InstructionSet.regRBP; RSI=InstructionSet.regRSI; RDI=InstructionSet.regRDI;
  13. R8=InstructionSet.regR8; R9=InstructionSet.regR9; R10=InstructionSet.regR10; R11=InstructionSet.regR11;
  14. R12=InstructionSet.regR12; R13=InstructionSet.regR13; R14=InstructionSet.regR14; R15=InstructionSet.regR15;
  15. EAX=InstructionSet.regEAX; ECX=InstructionSet.regECX; EDX=InstructionSet.regEDX; EBX=InstructionSet.regEBX;
  16. ESP=InstructionSet.regESP; EBP=InstructionSet.regEBP; ESI=InstructionSet.regESI; EDI=InstructionSet.regEDI;
  17. R8D=InstructionSet.regR8D; R9D=InstructionSet.regR9D; R10D=InstructionSet.regR10D; R11D=InstructionSet.regR11D;
  18. R12D=InstructionSet.regR12D; R13D=InstructionSet.regR13D; R14D=InstructionSet.regR14D; R15D=InstructionSet.regR15D;
  19. AX=InstructionSet.regAX; CX=InstructionSet.regCX; DX=InstructionSet.regDX; BX=InstructionSet.regBX;
  20. SI=InstructionSet.regSI; DI=InstructionSet.regDI; BP=InstructionSet.regBP; SP=InstructionSet.regSP;
  21. R8W=InstructionSet.regR8W; R9W=InstructionSet.regR9W; R10W=InstructionSet.regR10W; R11W=InstructionSet.regR11W;
  22. R12W=InstructionSet.regR12W; R13W=InstructionSet.regR13W; R14W=InstructionSet.regR14W; R15W=InstructionSet.regR15W;
  23. AL=InstructionSet.regAL; CL=InstructionSet.regCL; DL=InstructionSet.regDL; BL=InstructionSet.regBL; SIL=InstructionSet.regSIL;
  24. DIL=InstructionSet.regDIL; BPL=InstructionSet.regBPL; SPL=InstructionSet.regSPL;
  25. R8B=InstructionSet.regR8B; R9B=InstructionSet.regR9B; R10B=InstructionSet.regR10B; R11B=InstructionSet.regR11B;
  26. R12B=InstructionSet.regR12B; R13B=InstructionSet.regR13B; R14B=InstructionSet.regR14B; R15B=InstructionSet.regR15B;
  27. AH=InstructionSet.regAH; CH=InstructionSet.regCH; DH=InstructionSet.regDH; BH=InstructionSet.regBH;
  28. ST0=InstructionSet.regST0;
  29. XMM0 = InstructionSet.regXMM0;
  30. XMM7 = InstructionSet.regXMM7;
  31. YMM0 = InstructionSet.regYMM0;
  32. YMM7 = InstructionSet.regYMM7;
  33. Low=0; High=1;
  34. FrameSpillStack=TRUE;
  35. VAR registerOperands: ARRAY InstructionSet.numberRegisters OF Assembler.Operand;
  36. usePool: BOOLEAN;
  37. opEAX, opECX, opEDX, opEBX, opESP, opEBP,
  38. opESI, opEDI, opAX, opCX, opDX, opBX, opSI, opDI, opAL, opCL, opDL, opBL, opAH, opCH, opDH, opBH,opST0
  39. , opRSP, opRBP: Assembler.Operand;
  40. unusable,split,blocked,free: CodeGenerators.Ticket;
  41. traceStackSize: LONGINT;
  42. TYPE
  43. Ticket=CodeGenerators.Ticket;
  44. PhysicalRegisters*=OBJECT (CodeGenerators.PhysicalRegisters)
  45. VAR
  46. toVirtual: ARRAY InstructionSet.numberRegisters OF Ticket; (* registers real register -> none / reserved / split / blocked / virtual register (>0) *)
  47. reserved: ARRAY InstructionSet.numberRegisters OF BOOLEAN;
  48. hint: LONGINT;
  49. useFPU: BOOLEAN;
  50. PROCEDURE &InitPhysicalRegisters(fpu,cooperative: BOOLEAN);
  51. VAR i: LONGINT;
  52. BEGIN
  53. FOR i := 0 TO LEN(toVirtual)-1 DO
  54. toVirtual[i] := NIL;
  55. reserved[i] := FALSE;
  56. END;
  57. (* reserve stack and base pointer registers *)
  58. toVirtual[BPL] := unusable;
  59. toVirtual[SPL] := unusable;
  60. toVirtual[BP] := unusable;
  61. toVirtual[SP] := unusable;
  62. toVirtual[EBP] := unusable;
  63. toVirtual[ESP] := unusable;
  64. toVirtual[RBP] := unusable;
  65. toVirtual[RSP] := unusable;
  66. hint := none;
  67. useFPU := fpu
  68. END InitPhysicalRegisters;
  69. PROCEDURE AllocationHint*(index: LONGINT);
  70. BEGIN hint := index
  71. END AllocationHint;
  72. PROCEDURE NumberRegisters*(): LONGINT;
  73. BEGIN
  74. RETURN LEN(toVirtual)
  75. END NumberRegisters;
  76. END PhysicalRegisters;
  77. PhysicalRegisters32=OBJECT (PhysicalRegisters) (* 32 bit implementation *)
  78. PROCEDURE & InitPhysicalRegisters32(fpu,cooperative: BOOLEAN);
  79. VAR i: LONGINT;
  80. BEGIN
  81. InitPhysicalRegisters(fpu,cooperative);
  82. (* disable registers that are only usable in 64 bit mode *)
  83. FOR i := 0 TO 31 DO
  84. toVirtual[i+RAX] := unusable;
  85. END;
  86. FOR i := 8 TO 15 DO
  87. toVirtual[i+AL] := unusable;
  88. toVirtual[i+AH] := unusable;
  89. toVirtual[i+EAX] := unusable;
  90. toVirtual[i+AX] := unusable;
  91. END;
  92. FOR i := 4 TO 7 DO
  93. toVirtual[i+AL] := unusable;
  94. toVirtual[i+AH] := unusable;
  95. END;
  96. FOR i := 0 TO LEN(reserved)-1 DO reserved[i] := FALSE END;
  97. END InitPhysicalRegisters32;
  98. PROCEDURE Allocate*(index: LONGINT; virtualRegister: Ticket);
  99. BEGIN
  100. (*
  101. D.String("allocate register x : index="); D.Int(index,1); D.Ln;
  102. *)
  103. Assert(toVirtual[index] = free,"register already allocated");
  104. toVirtual[index] := virtualRegister;
  105. IF index DIV 32 = 2 THEN (* 32 bit *)
  106. Assert(toVirtual[index MOD 32 + AX] = free,"free register split");
  107. toVirtual[index MOD 32 + AX] := blocked;
  108. IF index MOD 32 < 4 THEN
  109. Assert(toVirtual[index MOD 32 + AL] = free,"register already allocated");
  110. Assert(toVirtual[index MOD 32 + AH] = free,"register already allocated");
  111. toVirtual[index MOD 32 + AL] := blocked;
  112. toVirtual[index MOD 32 + AH] := blocked;
  113. END;
  114. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  115. Assert(toVirtual[index MOD 8 + EAX] = free,"free register split");
  116. toVirtual[index MOD 32 + EAX] := split;
  117. IF index MOD 32 < 4 THEN
  118. Assert(toVirtual[index MOD 32 + AL] = free,"register already allocated");
  119. Assert(toVirtual[index MOD 32 + AH] = free,"register already allocated");
  120. toVirtual[index MOD 32 + AL] := blocked;
  121. toVirtual[index MOD 32 + AH] := blocked;
  122. END;
  123. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  124. Assert((toVirtual[index MOD 4 + EAX] = free) OR (toVirtual[index MOD 4 + EAX] = split),"free register blocked");
  125. Assert((toVirtual[index MOD 4 + AX] = free) OR (toVirtual[index MOD 4 + AX] = split),"free register blocked");
  126. toVirtual[index MOD 4 + EAX] := split;
  127. toVirtual[index MOD 4 + AX] := split;
  128. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  129. ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
  130. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  131. END;
  132. END Allocate;
  133. PROCEDURE SetReserved*(index: LONGINT; res: BOOLEAN);
  134. BEGIN
  135. IF index DIV 32 <=2 THEN
  136. index := index MOD 16;
  137. reserved[index+AH] := res;
  138. reserved[index+AL] := res;
  139. reserved[index+AX] := res;
  140. reserved[index+EAX] := res;
  141. ELSE
  142. reserved[index] := res;
  143. END;
  144. END SetReserved;
  145. PROCEDURE Reserved*(index: LONGINT): BOOLEAN;
  146. BEGIN
  147. RETURN (index>0) & reserved[index]
  148. END Reserved;
  149. PROCEDURE Free*(index: LONGINT);
  150. VAR x: Ticket;
  151. BEGIN
  152. (*
  153. D.String("free register x : index="); D.Int(index,1); D.Ln;
  154. *)
  155. x := toVirtual[index];
  156. Assert((toVirtual[index] # NIL),"register not reserved");
  157. toVirtual[index] := free;
  158. IF index DIV 32 =2 THEN (* 32 bit *)
  159. Assert(toVirtual[index MOD 32 + AX] = blocked,"reserved register did not block");
  160. toVirtual[index MOD 32 + AX] := free;
  161. IF index MOD 32 < 4 THEN
  162. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
  163. Assert(toVirtual[index MOD 32 + AH] = blocked,"reserved register did not block");
  164. toVirtual[index MOD 32 + AL] := free;
  165. toVirtual[index MOD 32 + AH] := free;
  166. END;
  167. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  168. Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
  169. toVirtual[index MOD 32 + EAX] := free;
  170. IF index MOD 32 < 4 THEN
  171. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
  172. Assert(toVirtual[index MOD 32 + AH] = blocked,"reserved register did not block");
  173. toVirtual[index MOD 32 + AL] := free;
  174. toVirtual[index MOD 32 + AH] := free;
  175. END;
  176. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  177. IF (toVirtual[index MOD 4 + AL] = free) & (toVirtual[index MOD 4 + AH] = free) THEN
  178. Assert(toVirtual[index MOD 4 + EAX] = split,"reserved register did not split");
  179. Assert(toVirtual[index MOD 4 + AX] = split,"reserved register did not split");
  180. toVirtual[index MOD 4 + EAX] := free;
  181. toVirtual[index MOD 4 + AX] := free;
  182. END;
  183. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  184. ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
  185. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  186. END;
  187. END Free;
  188. PROCEDURE NextFree*(CONST type: IntermediateCode.Type):LONGINT;
  189. VAR i,sizeInBits,length, form: LONGINT;
  190. PROCEDURE GetGPHint(offset: LONGINT): LONGINT;
  191. VAR res: WORD;
  192. BEGIN
  193. IF (hint # none) & (hint >= AL) & (hint <= EDI) & (toVirtual[hint MOD 32 + offset]=free) & ~Reserved(hint) THEN res := hint MOD 32 + offset ELSE res := none END;
  194. hint := none;
  195. RETURN res
  196. END GetGPHint;
  197. PROCEDURE GetHint(from,to: LONGINT): LONGINT;
  198. VAR res: WORD;
  199. BEGIN
  200. IF (hint # none) & (hint >= from) & (hint <= to) & (toVirtual[hint]=free) & ~Reserved(hint) THEN res := hint ELSE res := none END;
  201. hint := none;
  202. RETURN res
  203. END GetHint;
  204. PROCEDURE Get(from,to: LONGINT): LONGINT;
  205. VAR i: LONGINT;
  206. BEGIN
  207. i := from;
  208. IF from <= to THEN
  209. WHILE (i <= to) & ((toVirtual[i]#free) OR Reserved(i)) DO INC(i) END;
  210. IF i > to THEN i := none END;
  211. ELSE
  212. WHILE (i >=to) & ((toVirtual[i]#free) OR Reserved(i)) DO DEC(i) END;
  213. IF i < to THEN i := none END;
  214. END;
  215. RETURN i
  216. END Get;
  217. BEGIN
  218. length := type.length;
  219. sizeInBits := type.sizeInBits;
  220. form := type.form;
  221. IF (type.length > 1) THEN
  222. IF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =4) THEN
  223. i := Get(XMM7, XMM0);
  224. ELSIF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =8) THEN
  225. i := Get(YMM7, YMM0);
  226. ELSE
  227. HALT(100)
  228. END
  229. ELSIF type.form IN IntermediateCode.Integer THEN
  230. sizeInBits := type.sizeInBits;
  231. IF type.sizeInBits = IntermediateCode.Bits8 THEN
  232. i := GetGPHint(AL);
  233. IF i = none THEN i := Get(BL, AL) END;
  234. IF i = none THEN i := Get(BH, AH) END;
  235. ELSIF type.sizeInBits = IntermediateCode.Bits16 THEN
  236. i := GetGPHint(AX);
  237. IF i = none THEN i := Get(DI, SI) END;
  238. IF i = none THEN i := Get(BX, AX) END;
  239. ELSIF type.sizeInBits = IntermediateCode.Bits32 THEN
  240. i := GetGPHint(EAX);
  241. IF i = none THEN i := Get(EDI,ESI) END;
  242. IF i = none THEN i := Get(EBX,EAX) END;
  243. ELSE HALT(100)
  244. END;
  245. ELSE
  246. ASSERT(type.form = IntermediateCode.Float);
  247. IF useFPU THEN
  248. i := Get(InstructionSet.regST0, InstructionSet.regST6);
  249. (* ST7 unusable as it is overwritten during arithmetic instructions *)
  250. ELSE
  251. i := GetHint(XMM0, XMM7);
  252. IF i = none THEN i := Get(XMM7, XMM0) END
  253. END;
  254. END;
  255. hint := none; (* reset *)
  256. RETURN i
  257. END NextFree;
  258. PROCEDURE Mapped*(physical: LONGINT): Ticket;
  259. VAR virtual: Ticket;
  260. BEGIN
  261. virtual := toVirtual[physical];
  262. IF virtual = blocked THEN virtual := Mapped(physical+32)
  263. ELSIF virtual = split THEN
  264. IF physical < 32 THEN virtual := Mapped(physical+16 MOD 32)
  265. ELSE virtual := Mapped(physical-32)
  266. END;
  267. END;
  268. ASSERT((virtual = free) OR (virtual = unusable) OR (toVirtual[virtual.register] = virtual));
  269. RETURN virtual
  270. END Mapped;
  271. PROCEDURE Dump*(w: Streams.Writer);
  272. VAR i: LONGINT; virtual: Ticket;
  273. BEGIN
  274. w.String("; ---- registers ----"); w.Ln;
  275. FOR i := 0 TO LEN(toVirtual)-1 DO
  276. virtual := toVirtual[i];
  277. IF virtual # unusable THEN
  278. w.String("reg "); w.Int(i,1); w.String(": ");
  279. IF virtual = free THEN w.String("free")
  280. ELSIF virtual = blocked THEN w.String("blocked")
  281. ELSIF virtual = split THEN w.String("split")
  282. ELSE w.String(" r"); w.Int(virtual.register,1);
  283. END;
  284. IF reserved[i] THEN w.String("reserved") END;
  285. w.Ln;
  286. END;
  287. END;
  288. END Dump;
  289. END PhysicalRegisters32;
  290. PhysicalRegisters64=OBJECT (PhysicalRegisters) (* 64 bit implementation *)
  291. PROCEDURE & InitPhysicalRegisters64(fpu,cooperative: BOOLEAN);
  292. BEGIN
  293. InitPhysicalRegisters(fpu,cooperative);
  294. END InitPhysicalRegisters64;
  295. PROCEDURE SetReserved*(index: LONGINT; res: BOOLEAN);
  296. BEGIN
  297. (*
  298. IF res THEN D.String("reserve ") ELSE D.String("unreserve ") END;
  299. D.String("register: index="); D.Int(index,1); D.Ln;
  300. *)
  301. IF index DIV 32 <=2 THEN
  302. index := index MOD 16;
  303. reserved[index+AH] := res;
  304. reserved[index+AL] := res;
  305. reserved[index+AX] := res;
  306. reserved[index+EAX] := res;
  307. reserved[index+RAX] := res;
  308. ELSE
  309. reserved[index] := res
  310. END;
  311. END SetReserved;
  312. PROCEDURE Reserved*(index: LONGINT): BOOLEAN;
  313. BEGIN
  314. RETURN reserved[index]
  315. END Reserved;
  316. PROCEDURE Allocate*(index: LONGINT; virtualRegister: Ticket);
  317. BEGIN
  318. (*
  319. D.String("allocate register x : index="); D.Int(index,1); D.Ln;
  320. *)
  321. Assert(toVirtual[index] = free,"register already allocated");
  322. toVirtual[index] := virtualRegister;
  323. IF index DIV 32 = 3 THEN (* 64 bit *)
  324. Assert(toVirtual[index MOD 32 + EAX] = free,"free register split");
  325. toVirtual[index MOD 32 + EAX] := blocked;
  326. toVirtual[index MOD 32 + AX] := blocked;
  327. toVirtual[index MOD 32 + AL] := blocked;
  328. ELSIF index DIV 32 = 2 THEN (* 32 bit *)
  329. Assert(toVirtual[index MOD 32 + AX] = free,"free register split");
  330. toVirtual[index MOD 32 + RAX] := split;
  331. toVirtual[index MOD 32 + AX] := blocked;
  332. toVirtual[index MOD 32 + AL] := blocked;
  333. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  334. toVirtual[index MOD 32 + RAX] := split;
  335. toVirtual[index MOD 32 + EAX] := split;
  336. toVirtual[index MOD 32 + AL] := blocked;
  337. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  338. toVirtual[index MOD 32 + RAX] := split;
  339. toVirtual[index MOD 32 + EAX] := split;
  340. toVirtual[index MOD 32 + AX] := split;
  341. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  342. ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
  343. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  344. END;
  345. END Allocate;
  346. PROCEDURE Free*(index: LONGINT);
  347. BEGIN
  348. (*
  349. D.String("release register x : index="); D.Int(index,1); D.Ln;
  350. *)
  351. Assert(toVirtual[index]#NIL,"register not reserved");
  352. toVirtual[index] := free;
  353. IF index DIV 32 =3 THEN (* 64 bit *)
  354. Assert(toVirtual[index MOD 32 + EAX] = blocked,"reserved register did not block");
  355. toVirtual[index MOD 32 + EAX] := free;
  356. toVirtual[index MOD 32 + AX] := free;
  357. toVirtual[index MOD 32 + AL] := free;
  358. ELSIF index DIV 32 =2 THEN (* 32 bit *)
  359. Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
  360. Assert(toVirtual[index MOD 32 + AX] = blocked,"reserved register did not block");
  361. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
  362. toVirtual[index MOD 32 + RAX] := free;
  363. toVirtual[index MOD 32 + AX] := free;
  364. toVirtual[index MOD 32 + AL] := free;
  365. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  366. Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
  367. Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
  368. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not split");
  369. toVirtual[index MOD 32 + RAX] := free;
  370. toVirtual[index MOD 32 + EAX] := free;
  371. toVirtual[index MOD 32 + AL] := free;
  372. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  373. Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
  374. Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
  375. Assert(toVirtual[index MOD 32 + AX] = split,"reserved register did not split");
  376. toVirtual[index MOD 32 + RAX] := free;
  377. toVirtual[index MOD 32 + EAX] := free;
  378. toVirtual[index MOD 32 + AX] := free;
  379. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  380. ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
  381. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  382. END;
  383. END Free;
  384. PROCEDURE NextFree*(CONST type: IntermediateCode.Type): LONGINT;
  385. VAR i: LONGINT;
  386. PROCEDURE GetGPHint(offset: LONGINT): LONGINT;
  387. VAR res: WORD;
  388. BEGIN
  389. IF (hint # none) & (hint >= AL) & (hint <= R15) & (toVirtual[hint MOD 32 + offset]=free) & ~Reserved(hint) THEN res := hint MOD 32 + offset ELSE res := none END;
  390. hint := none;
  391. RETURN res
  392. END GetGPHint;
  393. PROCEDURE Get(from,to: LONGINT): LONGINT;
  394. VAR i: LONGINT;
  395. BEGIN
  396. i := from;
  397. IF from <= to THEN
  398. WHILE (i <= to) & ((toVirtual[i]#free) OR Reserved(i)) DO INC(i) END;
  399. IF i > to THEN i := none END;
  400. ELSE
  401. WHILE (i >=to) & ((toVirtual[i]#free) OR Reserved(i)) DO DEC(i) END;
  402. IF i < to THEN i := none END;
  403. END;
  404. RETURN i
  405. END Get;
  406. BEGIN
  407. IF (type.length > 1) THEN
  408. IF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =4) THEN
  409. i := Get(XMM7, XMM0);
  410. ELSIF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =8) THEN
  411. i := Get(YMM7, YMM0);
  412. ELSE
  413. HALT(100)
  414. END
  415. ELSIF type.form IN IntermediateCode.Integer THEN
  416. IF type.sizeInBits = IntermediateCode.Bits8 THEN
  417. i := GetGPHint(AL);
  418. IF i = none THEN i := Get(BL, AL) END;
  419. IF i = none THEN i := Get(BH, AH) END;
  420. IF i = none THEN
  421. i := Get(AL,R15B)
  422. END;
  423. ELSIF type.sizeInBits = IntermediateCode.Bits16 THEN
  424. i := GetGPHint(AX);
  425. IF i = none THEN i := Get(DI, SI) END;
  426. IF i = none THEN i := Get(BX, AX) END;
  427. IF i = none THEN
  428. i := Get(AX,R15W);
  429. END;
  430. ELSIF type.sizeInBits = IntermediateCode.Bits32 THEN
  431. i := GetGPHint(EAX);
  432. IF i = none THEN i := Get(EDI,ESI) END;
  433. IF i = none THEN i := Get(EBX,EAX) END;
  434. IF i = none THEN
  435. i := Get(EAX,R15D);
  436. END;
  437. ELSIF type.sizeInBits = IntermediateCode.Bits64 THEN
  438. i := GetGPHint(RAX);
  439. IF i = none THEN i := Get(RDI,RSI) END;
  440. IF i = none THEN i := Get(RBX,RAX) END;
  441. IF i = none THEN
  442. i := Get(RAX, R15)
  443. END;
  444. ELSE HALT(100)
  445. END;
  446. ELSE
  447. ASSERT(type.form = IntermediateCode.Float);
  448. IF useFPU THEN
  449. i := Get(InstructionSet.regST0, InstructionSet.regST6);
  450. (* ST7 unusable as it is overwritten during arithmetic instructions *)
  451. ELSE
  452. i := Get(XMM7, XMM0)
  453. END;
  454. END;
  455. RETURN i;
  456. END NextFree;
  457. PROCEDURE Mapped*(physical: LONGINT): Ticket;
  458. VAR virtual: Ticket;
  459. BEGIN
  460. virtual := toVirtual[physical];
  461. IF virtual = blocked THEN RETURN Mapped(physical+32) END;
  462. IF virtual = split THEN RETURN Mapped(physical-32) END;
  463. RETURN virtual
  464. END Mapped;
  465. END PhysicalRegisters64;
  466. CodeGeneratorAMD64 = OBJECT (CodeGenerators.GeneratorWithTickets)
  467. VAR
  468. (* static generator state variables, considered constant during generation *)
  469. builtinsModuleName: SyntaxTree.IdentifierString;
  470. cpuBits: LONGINT;
  471. opBP, opSP, opRA, opRB, opRC, opRD, opRSI, opRDI, opR8, opR9, opR10, opR11, opR12, opR13, opR14, opR15: Assembler.Operand; (* base pointer, stack pointer, register A, depends on cpuBits*)
  472. BP, SP, RA, RD, RS, RC: LONGINT; (* base pointer and stack pointer register index, depends on cpuBits *)
  473. emitter: Assembler.Emitter; (* assembler generating and containing the machine code *)
  474. backend: BackendAMD64;
  475. (* register spill state *)
  476. stackSize: LONGINT;
  477. spillStackStart: LONGINT;
  478. (* floating point stack state *)
  479. fpStackPointer: LONGINT; (* floating point stack pointer, increases with allocation, decreases with releasing, used to determine current relative position on stack (as is necessary for intel FP instructions) *)
  480. (*
  481. FP register usage scheme:
  482. sp=1> FP0 - temp
  483. sp=0> FP0 - reg0 FP1 - reg0 sp=0> FP0 - reg0
  484. FP1 - reg1 FP2 - reg1 FP1 - reg1
  485. FP2 - reg2 FP3 - reg2 FP2 - reg2
  486. FP3 - reg3 = load op1 => FP4 - reg3 = op => FP3 - reg3
  487. FP4 - reg4 FP5 - reg4 FP4 - reg4
  488. FP5 - reg5 FP6 - reg5 FP5 - reg5
  489. FP6 - reg6 FP7 - reg6 FP6 - reg6
  490. FP7 - reg7 (reg7 lost) FP7 - reg7
  491. *)
  492. ap: Ticket;
  493. (* -------------------------- constructor -------------------------------*)
  494. PROCEDURE &InitGeneratorAMD64(CONST runtime: SyntaxTree.IdentifierString; diagnostics: Diagnostics.Diagnostics; backend: BackendAMD64);
  495. VAR physicalRegisters: PhysicalRegisters; physicalRegisters32: PhysicalRegisters32; physicalRegisters64: PhysicalRegisters64;
  496. BEGIN
  497. SELF.backend := backend;
  498. builtinsModuleName := runtime;
  499. SELF.cpuBits := backend.bits;
  500. NEW(emitter,diagnostics);
  501. IF cpuBits=32 THEN
  502. NEW(physicalRegisters32, backend.forceFPU, backend.cooperative); physicalRegisters := physicalRegisters32; error := ~emitter.SetBits(32);
  503. opBP := opEBP; opSP := opESP; opRA := opEAX; opRB := opEBX; opRD := opEDX; opRDI := opEDI; opRSI := opESI; opRC := opECX;
  504. SP := ESP; BP := EBP; RA := EAX;
  505. RD := EDI; RS := ESI; RC := ECX;
  506. ASSERT(~error);
  507. ELSIF cpuBits=64 THEN
  508. NEW(physicalRegisters64, backend.forceFPU, backend.cooperative); physicalRegisters := physicalRegisters64; error := ~emitter.SetBits(64);
  509. opBP := opRBP; opSP := opRSP;
  510. opRA := registerOperands[RAX]; opRC := registerOperands[RCX];
  511. opRB := registerOperands[RBX]; opRD := registerOperands[RDX];
  512. opRDI := registerOperands[RDI]; opRSI := registerOperands[RSI];
  513. opR8 := registerOperands[R8]; opR9 := registerOperands[R9];
  514. opR10 := registerOperands[R10]; opR11 := registerOperands[R11];
  515. opR12 := registerOperands[R12]; opR13 := registerOperands[R13];
  516. opR14 := registerOperands[R14]; opR15 := registerOperands[R15];
  517. SP := RSP; BP := RBP; RA := RAX;
  518. RD := RDI; RS := RSI; RC := RCX;
  519. ASSERT(~error);
  520. ELSE Halt("no register allocator for bits other than 32 / 64 ");
  521. END;
  522. fpStackPointer := 0;
  523. InitTicketGenerator(diagnostics,backend.optimize,2,physicalRegisters);
  524. END InitGeneratorAMD64;
  525. (*------------------- overwritten methods ----------------------*)
  526. PROCEDURE Section*(in: IntermediateCode.Section; out: BinaryCode.Section);
  527. VAR oldSpillStackSize: LONGINT;
  528. PROCEDURE CheckEmptySpillStack;
  529. BEGIN
  530. IF spillStack.Size()#0 THEN Error(Basic.invalidPosition,"implementation error, spill stack not cleared") END;
  531. END CheckEmptySpillStack;
  532. BEGIN
  533. spillStack.Init;
  534. IF backend.cooperative THEN
  535. ap := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.UnsignedIntegerType(cpuBits),RC,in.pc);
  536. ap.spillable := FALSE;
  537. END;
  538. emitter.SetCode(out);
  539. Section^(in,out);
  540. IF FrameSpillStack & (spillStack.MaxSize() >0) THEN
  541. oldSpillStackSize := spillStack.MaxSize();
  542. out.Reset;
  543. CheckEmptySpillStack;
  544. Section^(in,out);
  545. ASSERT(spillStack.MaxSize() = oldSpillStackSize);
  546. END;
  547. ASSERT(fpStackPointer = 0);
  548. CheckEmptySpillStack;
  549. IF backend.cooperative THEN
  550. UnmapTicket(ap);
  551. END;
  552. error := error OR emitter.error;
  553. END Section;
  554. PROCEDURE Supported*(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  555. BEGIN
  556. COPY(builtinsModuleName, moduleName);
  557. IF (cpuBits=32) & (instruction.op2.type.sizeInBits = IntermediateCode.Bits64) & (instruction.op2.type.form IN IntermediateCode.Integer) THEN
  558. CASE instruction.opcode OF
  559. IntermediateCode.div:
  560. procedureName := "DivH"; RETURN FALSE
  561. | IntermediateCode.mul:
  562. procedureName := "MulH"; RETURN FALSE
  563. | IntermediateCode.mod :
  564. procedureName := "ModH"; RETURN FALSE
  565. | IntermediateCode.abs :
  566. procedureName := "AbsH"; RETURN FALSE;
  567. | IntermediateCode.shl :
  568. IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
  569. procedureName := "AslH"; RETURN FALSE;
  570. ELSE
  571. procedureName := "LslH"; RETURN FALSE;
  572. END;
  573. | IntermediateCode.shr :
  574. IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
  575. procedureName := "AsrH"; RETURN FALSE;
  576. ELSE
  577. procedureName := "LsrH"; RETURN FALSE;
  578. END;
  579. | IntermediateCode.ror :
  580. procedureName := "RorH"; RETURN FALSE;
  581. | IntermediateCode.rol :
  582. procedureName := "RolH"; RETURN FALSE;
  583. | IntermediateCode.cas :
  584. procedureName := "CasH"; RETURN FALSE;
  585. ELSE RETURN TRUE
  586. END;
  587. ELSIF ~backend.forceFPU & (instruction.opcode = IntermediateCode.conv) & (instruction.op1.type.form IN IntermediateCode.Integer) & (instruction.op2.type.form = IntermediateCode.Float) & IsComplex(instruction.op1) THEN
  588. IF instruction.op2.type.sizeInBits=32 THEN
  589. procedureName := "EntierRH"
  590. ELSE
  591. procedureName := "EntierXH"
  592. END;
  593. RETURN FALSE
  594. END;
  595. RETURN TRUE
  596. END Supported;
  597. (* input: type (such as that of an intermediate operand), output: low and high type (such as in low and high type of an operand) *)
  598. PROCEDURE GetPartType*(CONST type: IntermediateCode.Type; part: LONGINT; VAR typePart: IntermediateCode.Type);
  599. BEGIN
  600. ASSERT(type.sizeInBits >0);
  601. IF (type.sizeInBits > cpuBits) & (type.form IN IntermediateCode.Integer) THEN
  602. IntermediateCode.InitType(typePart,type.form,32);
  603. ELSE ASSERT((type.form IN IntermediateCode.Integer) OR (type.form = IntermediateCode.Float));
  604. IF part=Low THEN typePart := type ELSE typePart := IntermediateCode.undef END;
  605. END;
  606. END GetPartType;
  607. (* simple move without conversion *)
  608. PROCEDURE Move(VAR dest, src: Assembler.Operand; CONST type: IntermediateCode.Type);
  609. BEGIN
  610. IF type.length > 1 THEN
  611. IF type.length = 4 THEN
  612. (*ASSERT(type.form = IntermediateCode.Float);*)
  613. IF Assembler.IsRegisterOperand(dest) & Assembler.IsRegisterOperand(src) THEN
  614. SpecialMove(InstructionSet.opMOVUPS, InstructionSet.opMOVUPS, TRUE, dest, src, type);
  615. ELSIF (*(type.form = IntermediateCode.Float) & *) (type.sizeInBits = 32) THEN
  616. SpecialMove(InstructionSet.opMOVUPS, InstructionSet.opMOVUPS, TRUE, dest, src, type);
  617. ELSIF (type.sizeInBits = 16) THEN
  618. SpecialMove(InstructionSet.opMOVQ, InstructionSet.opMOVQ, TRUE, dest, src, type);
  619. ELSIF (type.sizeInBits = 8) THEN
  620. SpecialMove(InstructionSet.opMOVD, InstructionSet.opMOVD, TRUE, dest, src, type);
  621. END;
  622. ELSIF type.length = 8 THEN
  623. (*ASSERT(type.form = IntermediateCode.Float);*)
  624. IF Assembler.IsRegisterOperand(dest) & Assembler.IsRegisterOperand(src) THEN
  625. SpecialMove(InstructionSet.opMOVUPS, InstructionSet.opMOVUPS, TRUE, dest, src, type);
  626. ELSIF (*(type.form = IntermediateCode.Float) & *) (type.sizeInBits = 32) THEN
  627. SpecialMove(InstructionSet.opVMOVUPS, InstructionSet.opVMOVUPS, TRUE, dest, src, type);
  628. ELSIF (type.sizeInBits = 16) THEN
  629. SpecialMove(InstructionSet.opVMOVQ, InstructionSet.opVMOVQ, TRUE, dest, src, type);
  630. ELSIF (type.sizeInBits = 8) THEN
  631. SpecialMove(InstructionSet.opVMOVD, InstructionSet.opVMOVD, TRUE, dest, src, type);
  632. END;
  633. ELSE
  634. (*
  635. ASSERT(type.form = IntermediateCode.Float);
  636. *)
  637. ASSERT(type.sizeInBits = 64);
  638. SpecialMove(InstructionSet.opMOVUPD, InstructionSet.opMOVUPS, TRUE, dest, src, type);
  639. END;
  640. ELSIF type.form = IntermediateCode.Float THEN
  641. IF type.sizeInBits = 32 THEN
  642. SpecialMove(InstructionSet.opMOVSS, InstructionSet.opMOVSS, TRUE, dest, src, type);
  643. ELSE
  644. SpecialMove(InstructionSet.opMOVSD, InstructionSet.opMOVSD, TRUE, dest, src, type);
  645. END;
  646. ELSE
  647. SpecialMove(InstructionSet.opMOV, InstructionSet.opMOV, TRUE, dest, src, type);
  648. END;
  649. END Move;
  650. PROCEDURE ToSpillStack*(ticket: Ticket);
  651. VAR op: Assembler.Operand;
  652. BEGIN
  653. IF (ticket.type.form = IntermediateCode.Float) & backend.forceFPU THEN
  654. emitter.Emit1(InstructionSet.opFLD,registerOperands[ticket.register]);
  655. INC(fpStackPointer);
  656. GetSpillOperand(ticket,op);
  657. emitter.Emit1(InstructionSet.opFSTP,op);
  658. DEC(fpStackPointer);
  659. ELSE
  660. GetSpillOperand(ticket,op);
  661. Move(op, registerOperands[ticket.register], ticket.type)
  662. END;
  663. END ToSpillStack;
  664. PROCEDURE AllocateSpillStack*(size: LONGINT);
  665. BEGIN
  666. IF ~FrameSpillStack THEN
  667. AllocateStack(cpuBits DIV 8*size)
  668. END;
  669. END AllocateSpillStack;
  670. PROCEDURE ToRegister*(ticket: Ticket);
  671. VAR op: Assembler.Operand;
  672. BEGIN
  673. GetSpillOperand(ticket,op);
  674. emitter.Emit2(InstructionSet.opMOV,registerOperands[ticket.register],op);
  675. END ToRegister;
  676. PROCEDURE ExchangeTickets*(ticket1,ticket2: Ticket);
  677. VAR op1,op2: Assembler.Operand;
  678. BEGIN
  679. TicketToOperand(ticket1, op1);
  680. TicketToOperand(ticket2, op2);
  681. emitter.Emit2(InstructionSet.opXCHG, op1,op2);
  682. END ExchangeTickets;
  683. (*------------------- particular register mappings / operands ----------------------*)
  684. (* returns if a virtual register is mapped to the register set described by virtualRegisterMapping*)
  685. PROCEDURE MappedTo(CONST virtualRegister: LONGINT; part:LONGINT; physicalRegister: LONGINT): BOOLEAN;
  686. VAR ticket: Ticket;
  687. BEGIN
  688. IF (virtualRegister > 0) THEN
  689. ticket := virtualRegisters.Mapped(virtualRegister,part);
  690. RETURN (ticket # NIL) & ~(ticket.spilled) & (ticket.register = physicalRegister)
  691. ELSIF (virtualRegister = IntermediateCode.FP) THEN
  692. RETURN physicalRegister= BP
  693. ELSIF (virtualRegister = IntermediateCode.SP) THEN
  694. RETURN physicalRegister = SP
  695. ELSIF (virtualRegister = IntermediateCode.AP) THEN
  696. ASSERT(backend.cooperative);
  697. RETURN ~(ap.spilled) & (ap.register = physicalRegister)
  698. ELSE
  699. RETURN FALSE
  700. END;
  701. END MappedTo;
  702. PROCEDURE ResultRegister(CONST type: IntermediateCode.Type; part: LONGINT): LONGINT;
  703. BEGIN
  704. IF type.form IN IntermediateCode.Integer THEN
  705. CASE type.sizeInBits OF
  706. | 64:
  707. IF cpuBits = 32 THEN
  708. IF part = Low THEN RETURN EAX
  709. ELSE RETURN EDX
  710. END;
  711. ELSE
  712. ASSERT(part = Low);
  713. RETURN RAX
  714. END;
  715. | 32: ASSERT(part=Low); RETURN EAX
  716. | 16: ASSERT(part=Low); RETURN AX
  717. | 8: ASSERT(part=Low); RETURN AL
  718. END;
  719. ELSIF ~backend.forceFPU THEN
  720. RETURN XMM0
  721. ELSE ASSERT(type.form = IntermediateCode.Float);ASSERT(part=Low);
  722. RETURN ST0
  723. END;
  724. END ResultRegister;
  725. (*------------------- operand reflection ----------------------*)
  726. PROCEDURE IsMemoryOperand(vop: IntermediateCode.Operand; part: LONGINT): BOOLEAN;
  727. VAR ticket: Ticket;
  728. BEGIN
  729. IF vop.mode = IntermediateCode.ModeMemory THEN RETURN TRUE
  730. ELSIF vop.mode = IntermediateCode.ModeRegister THEN
  731. ticket := virtualRegisters.Mapped(vop.register,part);
  732. RETURN (ticket # NIL) & (ticket.spilled);
  733. ELSE RETURN FALSE
  734. END;
  735. END IsMemoryOperand;
  736. PROCEDURE IsRegister(CONST vop: IntermediateCode.Operand): BOOLEAN;
  737. BEGIN
  738. RETURN (vop.mode = IntermediateCode.ModeRegister) & (vop.offset = 0)
  739. END IsRegister;
  740. (* infer intermediate code type from physical operand as far as possible *)
  741. PROCEDURE PhysicalOperandType(CONST op:Assembler.Operand): IntermediateCode.Type;
  742. VAR type:IntermediateCode.Type;
  743. BEGIN
  744. IF op.type = Assembler.sti THEN
  745. IntermediateCode.InitType(type, IntermediateCode.Float, op.sizeInBytes*8)
  746. ELSE
  747. IntermediateCode.InitType(type, IntermediateCode.SignedInteger, op.sizeInBytes*8)
  748. END;
  749. RETURN type
  750. END PhysicalOperandType;
  751. (*------------------- operand generation ----------------------*)
  752. PROCEDURE GetSpillOperand(ticket: Ticket; VAR op: Assembler.Operand);
  753. BEGIN
  754. IF FrameSpillStack THEN
  755. op := Assembler.NewMem(SHORTINT(ticket.type.sizeInBits*ticket.type.length DIV 8), BP , -(spillStackStart + cpuBits DIV 8 + ticket.offset*cpuBits DIV 8));
  756. ELSE
  757. op := Assembler.NewMem(SHORTINT(ticket.type.sizeInBits*ticket.type.length DIV 8),SP , (spillStack.Size()-ticket.offset)*cpuBits DIV 8);
  758. END;
  759. END GetSpillOperand;
  760. PROCEDURE TicketToOperand(ticket: Ticket; VAR op: Assembler.Operand);
  761. BEGIN
  762. IF (ticket = NIL) THEN
  763. Assembler.InitOperand(op)
  764. ELSIF ticket.spilled THEN
  765. GetSpillOperand(ticket,op)
  766. ELSE
  767. IF ticket.register = none THEN physicalRegisters.Dump(D.Log); tickets.Dump(D.Log); virtualRegisters.Dump(D.Log); D.Update; END;
  768. ASSERT(ticket.register # none);
  769. IF (ticket.type.form = IntermediateCode.Float) & backend.forceFPU THEN
  770. op := registerOperands[ticket.register+fpStackPointer]
  771. ELSE
  772. op := registerOperands[ticket.register];
  773. END;
  774. END;
  775. END TicketToOperand;
  776. PROCEDURE GetTemporaryRegister(type: IntermediateCode.Type; VAR op: Assembler.Operand);
  777. BEGIN
  778. TicketToOperand(TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type),op)
  779. END GetTemporaryRegister;
  780. PROCEDURE GetImmediateMem(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR imm: Assembler.Operand);
  781. VAR data: IntermediateCode.Section;pc: LONGINT; source, dest: Assembler.Operand; ticket: Ticket;
  782. BEGIN
  783. data := GetDataSection();
  784. pc := IntermediateBackend.EnterImmediate(data,vop);
  785. IF cpuBits = 64 THEN
  786. Assembler.InitImm(source,8,0);
  787. Assembler.SetSymbol(source,data.name,0,pc,0);
  788. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateBackend.GetType(module.system,module.system.addressType));
  789. TicketToOperand(ticket,dest);
  790. emitter.Emit2(InstructionSet.opMOV,dest,source);
  791. Assembler.InitMem(imm, SHORT(vop.type.sizeInBits DIV 8), ticket.register, 0);
  792. ELSE
  793. Assembler.InitMem(imm, SHORT(vop.type.sizeInBits DIV 8) , Assembler.none,0);
  794. Assembler.SetSymbol(imm,data.name,0,pc,0);
  795. END;
  796. END GetImmediateMem;
  797. PROCEDURE GetImmediate(CONST virtual: IntermediateCode.Operand; part: LONGINT; VAR physical: Assembler.Operand; forbidden16Bit: BOOLEAN);
  798. VAR type: IntermediateCode.Type; temp: Assembler.Operand; size: SHORTINT; value: HUGEINT;
  799. PROCEDURE IsImm8(value: HUGEINT): BOOLEAN;
  800. BEGIN
  801. RETURN (value >= -80H) & (value < 80H)
  802. END IsImm8;
  803. PROCEDURE IsImm16(value: HUGEINT): BOOLEAN;
  804. BEGIN
  805. RETURN (value >= -8000H) & (value < 10000H)
  806. END IsImm16;
  807. PROCEDURE IsImm32(value: HUGEINT): BOOLEAN;
  808. BEGIN
  809. value := value DIV 10000H DIV 10000H;
  810. RETURN (value = 0) OR (value=-1);
  811. END IsImm32;
  812. BEGIN
  813. ASSERT(virtual.mode = IntermediateCode.ModeImmediate);
  814. GetPartType(virtual.type,part,type);
  815. IF virtual.type.form IN IntermediateCode.Integer THEN
  816. IF IsComplex(virtual) THEN
  817. IF part = High THEN value := SHORT(virtual.intValue DIV 10000H DIV 10000H)
  818. ELSE value := virtual.intValue
  819. END;
  820. ELSE value := virtual.intValue
  821. END;
  822. IF virtual.symbol.name # "" THEN size := SHORT(type.sizeInBits DIV 8);
  823. ELSIF forbidden16Bit & IsImm16(value) & ~(IsImm8(value)) THEN size := Assembler.bits32;
  824. ELSIF (type.sizeInBits = 64) & (type.form = IntermediateCode.UnsignedInteger) & (value > MAX(LONGINT)) THEN
  825. size := 8; (* don't use negative signed 32-bit value to encode 64-bit unsigned value! *)
  826. ELSE size := 0
  827. END;
  828. Assembler.InitImm(physical,size ,value);
  829. IF virtual.symbol.name # "" THEN Assembler.SetSymbol(physical,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset+part*Assembler.bits32) END;
  830. IF (cpuBits=64) & ((physical.sizeInBytes=8) OR ~IsImm32(value)) THEN
  831. ASSERT(cpuBits=64);
  832. GetTemporaryRegister(IntermediateCode.int64,temp);
  833. emitter.Emit2(InstructionSet.opMOV,temp,physical);
  834. physical := temp;
  835. END;
  836. ELSE
  837. GetImmediateMem(virtual,part,physical);
  838. END;
  839. END GetImmediate;
  840. PROCEDURE GetMemory(CONST virtual: IntermediateCode.Operand; part: LONGINT; VAR physical: Assembler.Operand);
  841. VAR type: IntermediateCode.Type; virtualRegister, physicalRegister,offset: LONGINT; ticket,orig: Ticket; dest, source: Assembler.Operand;
  842. BEGIN
  843. ASSERT(virtual.mode = IntermediateCode.ModeMemory);
  844. GetPartType(virtual.type,part,type);
  845. IF virtual.register # IntermediateCode.None THEN
  846. virtualRegister := virtual.register;
  847. IF virtualRegister = IntermediateCode.FP THEN physicalRegister := BP;
  848. ELSIF virtualRegister = IntermediateCode.SP THEN physicalRegister := SP;
  849. ELSE
  850. IF virtualRegister = IntermediateCode.AP THEN
  851. ticket := ap;
  852. ELSE
  853. ticket := virtualRegisters.Mapped(virtualRegister,Low);
  854. END;
  855. IF ticket.spilled THEN
  856. IF physicalRegisters.Reserved(ticket.register) THEN
  857. orig := ticket;
  858. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateBackend.GetType(module.system,module.system.addressType));
  859. TicketToOperand(orig,source);
  860. TicketToOperand(ticket,dest);
  861. Move(dest,source,PhysicalOperandType(dest));
  862. physicalRegister := ticket.register;
  863. ELSE
  864. UnSpill(ticket);
  865. physicalRegister := ticket.register;
  866. END;
  867. ELSE
  868. physicalRegister := ticket.register;
  869. END;
  870. END;
  871. offset := virtual.offset;
  872. ASSERT(virtual.intValue = 0);
  873. ELSIF virtual.symbol.name = "" THEN
  874. physicalRegister := Assembler.none;
  875. offset := SHORT(virtual.intValue);
  876. ASSERT(virtual.offset = 0);
  877. ELSIF cpuBits = 64 THEN
  878. Assembler.InitImm(source,8,0);
  879. Assembler.SetSymbol(source,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset);
  880. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateBackend.GetType(module.system,module.system.addressType));
  881. TicketToOperand(ticket,dest);
  882. emitter.Emit2(InstructionSet.opMOV,dest,source);
  883. physicalRegister := ticket.register;
  884. offset := 0;
  885. ASSERT(virtual.intValue = 0);
  886. ELSE
  887. physicalRegister := Assembler.none;
  888. offset := virtual.offset;
  889. ASSERT(virtual.intValue = 0);
  890. END;
  891. Assembler.InitMem(physical, SHORTINT(type.length * type.sizeInBits DIV 8) , physicalRegister, offset+ (cpuBits DIV 8) *part);
  892. IF (virtual.symbol.name # "") & (cpuBits # 64) THEN
  893. Assembler.SetSymbol(physical,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset+ (cpuBits DIV 8) *part);
  894. END;
  895. END GetMemory;
  896. PROCEDURE GetRegister(CONST virtual: IntermediateCode.Operand; part:LONGINT; VAR physical: Assembler.Operand; VAR ticket: Ticket);
  897. VAR type: IntermediateCode.Type; virtualRegister, tempReg: LONGINT;
  898. tmp,imm: Assembler.Operand; index: LONGINT;
  899. BEGIN
  900. ASSERT(virtual.mode = IntermediateCode.ModeRegister);
  901. GetPartType(virtual.type,part,type);
  902. virtualRegister := virtual.register;
  903. IF (virtual.register > 0) THEN
  904. TicketToOperand(virtualRegisters.Mapped(virtual.register,part), physical);
  905. ELSIF virtual.register = IntermediateCode.FP THEN
  906. Assert(part=Low,"forbidden partitioned register on BP");
  907. physical := opBP;
  908. ELSIF virtual.register = IntermediateCode.SP THEN
  909. Assert(part=Low,"forbidden partitioned register on SP");
  910. physical := opSP;
  911. ELSIF virtual.register = IntermediateCode.AP THEN
  912. ASSERT(backend.cooperative);
  913. Assert(part=Low,"forbidden partitioned register on AP");
  914. TicketToOperand(ap, physical);
  915. ELSE HALT(100);
  916. END;
  917. IF virtual.offset # 0 THEN
  918. Assert(type.form # IntermediateCode.Float,"forbidden offset on float");
  919. IF ticket = NIL THEN
  920. tempReg := ForceFreeRegister(type);
  921. TicketToOperand(ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,type,tempReg,inPC),tmp);
  922. ELSE
  923. TicketToOperand(ticket, tmp);
  924. ticket := NIL;
  925. END;
  926. IF Assembler.IsRegisterOperand(physical) & (type.sizeInBits > 8) THEN
  927. Assembler.InitMem(physical,SHORTINT(type.length * type.sizeInBits DIV 8) , physical.register, virtual.offset);
  928. emitter.Emit2(InstructionSet.opLEA, tmp,physical);
  929. ELSE
  930. emitter.Emit2(InstructionSet.opMOV,tmp,physical);
  931. Assembler.InitImm(imm,0 ,virtual.offset);
  932. emitter.Emit2(InstructionSet.opADD,tmp,imm);
  933. END;
  934. physical := tmp;
  935. END;
  936. END GetRegister;
  937. (* make physical operand from virtual operand, if ticket given then write result into phyiscal register represented by ticket *)
  938. PROCEDURE MakeOperand(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Assembler.Operand; ticket: Ticket);
  939. VAR tmp: Assembler.Operand;
  940. BEGIN
  941. TryAllocate(vop,part);
  942. CASE vop.mode OF
  943. IntermediateCode.ModeMemory: GetMemory(vop,part,op);
  944. |IntermediateCode.ModeRegister: GetRegister(vop,part,op,ticket);
  945. |IntermediateCode.ModeImmediate: GetImmediate(vop,part,op,FALSE);
  946. END;
  947. IF ticket # NIL THEN
  948. TicketToOperand(ticket, tmp);
  949. emitter.Emit2(InstructionSet.opMOV, tmp, op);
  950. (* should work but does not
  951. IF Assembler.IsRegisterOperand(op) THEN ReleaseHint(op.register) END;
  952. *)
  953. op := tmp;
  954. END;
  955. END MakeOperand;
  956. (* make physical register operand from virtual operand *)
  957. PROCEDURE MakeRegister(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Assembler.Operand);
  958. VAR previous: Assembler.Operand; temp: Ticket;
  959. BEGIN
  960. MakeOperand(vop,part,op,NIL);
  961. IF ~Assembler.IsRegisterOperand(op) THEN
  962. previous := op;
  963. temp := TemporaryTicket(vop.registerClass,vop.type);
  964. TicketToOperand(temp,op);
  965. Move(op, previous, vop.type);
  966. END;
  967. END MakeRegister;
  968. (*------------------- helpers for code generation ----------------------*)
  969. (* move, potentially with conversion. parameter back used for moving back from temporary operand*)
  970. PROCEDURE SpecialMove(op, back: LONGINT; canStoreToMemory: BOOLEAN; VAR dest,src: Assembler.Operand; type: IntermediateCode.Type);
  971. VAR temp: Assembler.Operand; ticket: Ticket;
  972. BEGIN
  973. IF Assembler.SameOperand(src,dest) THEN (* do nothing *)
  974. ELSIF ~Assembler.IsMemoryOperand(dest) OR (~Assembler.IsMemoryOperand(src) & canStoreToMemory) THEN
  975. emitter.Emit2(op,dest,src);
  976. ELSE
  977. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
  978. TicketToOperand(ticket,temp);
  979. emitter.Emit2(op,temp,src);
  980. emitter.Emit2(back,dest,temp);
  981. UnmapTicket(ticket);
  982. END;
  983. END SpecialMove;
  984. PROCEDURE AllocateStack(sizeInBytes: LONGINT);
  985. VAR sizeOp: Assembler.Operand; opcode: LONGINT;
  986. BEGIN
  987. ASSERT(sizeInBytes MOD (cpuBits DIV 8) = 0);
  988. IF sizeInBytes < 0 THEN
  989. sizeInBytes := -sizeInBytes; opcode := InstructionSet.opADD;
  990. ELSIF sizeInBytes > 0 THEN
  991. opcode := InstructionSet.opSUB;
  992. ELSE RETURN
  993. END;
  994. IF sizeInBytes < 128 THEN sizeOp := Assembler.NewImm8(sizeInBytes);
  995. ELSE sizeOp := Assembler.NewImm32(sizeInBytes);
  996. END;
  997. emitter.Emit2(opcode,opSP,sizeOp);
  998. END AllocateStack;
  999. (*------------------- generation = emit dispatch / emit procedures ----------------------*)
  1000. PROCEDURE IsFloat(CONST operand: IntermediateCode.Operand): BOOLEAN;
  1001. BEGIN RETURN operand.type.form = IntermediateCode.Float
  1002. END IsFloat;
  1003. PROCEDURE IsComplex(CONST operand: IntermediateCode.Operand): BOOLEAN;
  1004. BEGIN RETURN (operand.type.form IN IntermediateCode.Integer) & (operand.type.sizeInBits > cpuBits)
  1005. END IsComplex;
  1006. PROCEDURE Generate*(VAR instruction: IntermediateCode.Instruction);
  1007. VAR opcode: SHORTINT; ticket: Ticket; hwreg, lastUse, i, part: LONGINT;
  1008. BEGIN
  1009. (*!IF ((instruction.opcode = IntermediateCode.mov) OR (instruction.opcode = IntermediateCode.pop)) & (instruction.op1.register <= IntermediateCode.ParameterRegister) THEN
  1010. hwreg := ParameterRegister(IntermediateCode.ParameterRegister-instruction.op1.register, instruction.op1.type);
  1011. Spill(physicalRegisters.Mapped(hwreg));
  1012. lastUse := inPC+1;
  1013. WHILE (lastUse < in.pc) &
  1014. ((in.instructions[lastUse].opcode # IntermediateCode.push) OR (in.instructions[lastUse].op1.register # instruction.op1.register)) & (in.instructions[lastUse].opcode # IntermediateCode.call) DO
  1015. INC(lastUse)
  1016. END;
  1017. ticket := ReservePhysicalRegister(instruction.op1.type,hwreg,lastUse);
  1018. END;
  1019. *)
  1020. ReserveOperandRegisters(instruction.op1,TRUE); ReserveOperandRegisters(instruction.op2,TRUE);ReserveOperandRegisters(instruction.op3,TRUE);
  1021. (*TryAllocate(instruction.op1,Low);
  1022. IF IsComplex(instruction.op1) THEN TryAllocate(instruction.op1,High) END;
  1023. *)
  1024. opcode := instruction.opcode;
  1025. CASE opcode OF
  1026. IntermediateCode.nop: (* do nothing *)
  1027. |IntermediateCode.mov:
  1028. IF IsFloat(instruction.op1) OR IsFloat(instruction.op2) THEN
  1029. EmitMovFloat(instruction.op1,instruction.op2)
  1030. ELSE EmitMov(instruction.op1,instruction.op2,Low);
  1031. IF IsComplex(instruction.op1) THEN EmitMov(instruction.op1,instruction.op2, High) END;
  1032. END;
  1033. |IntermediateCode.conv:
  1034. IF IsFloat(instruction.op1) OR IsFloat(instruction.op2) THEN
  1035. EmitConvertFloat(instruction)
  1036. ELSE
  1037. EmitConvert(instruction.op1,instruction.op2,Low);
  1038. IF IsComplex(instruction.op1) THEN EmitConvert(instruction.op1,instruction.op2,High) END;
  1039. END;
  1040. |IntermediateCode.call: EmitCall(instruction);
  1041. |IntermediateCode.enter: EmitEnter(instruction);
  1042. |IntermediateCode.leave: EmitLeave(instruction);
  1043. |IntermediateCode.exit: EmitExit(instruction);
  1044. |IntermediateCode.result:
  1045. IF IsFloat(instruction.op1) & backend.forceFPU THEN
  1046. EmitResultFPU(instruction)
  1047. ELSE
  1048. EmitResult(instruction);
  1049. END;
  1050. |IntermediateCode.return:
  1051. IF IsFloat(instruction.op1) & backend.forceFPU THEN
  1052. EmitReturnFPU(instruction)
  1053. ELSE
  1054. EmitReturn(instruction,Low);
  1055. IF IsComplex(instruction.op1) THEN EmitReturn(instruction, High) END;
  1056. END;
  1057. |IntermediateCode.trap: EmitTrap(instruction);
  1058. |IntermediateCode.br .. IntermediateCode.brlt: EmitBr(instruction)
  1059. |IntermediateCode.pop:
  1060. IF IsFloat(instruction.op1) THEN
  1061. EmitPopFloat(instruction.op1)
  1062. ELSE
  1063. EmitPop(instruction.op1,Low);
  1064. IF IsComplex(instruction.op1) THEN
  1065. EmitPop(instruction.op1,High)
  1066. END;
  1067. END;
  1068. |IntermediateCode.push:
  1069. IF IsFloat(instruction.op1) THEN
  1070. EmitPushFloat(instruction.op1)
  1071. ELSE
  1072. IF IsComplex(instruction.op1) THEN
  1073. EmitPush(instruction.op1,High);
  1074. END;
  1075. EmitPush(instruction.op1,Low)
  1076. END;
  1077. |IntermediateCode.neg:
  1078. IF IsFloat(instruction.op1) THEN
  1079. IF backend.forceFPU THEN
  1080. EmitArithmetic2FPU(instruction,InstructionSet.opFCHS)
  1081. ELSE
  1082. EmitNegXMM(instruction)
  1083. END;
  1084. ELSE EmitNeg(instruction);
  1085. END;
  1086. |IntermediateCode.not:
  1087. Assert(~IsFloat(instruction.op1),"instruction not supported for float");
  1088. EmitArithmetic2(instruction,Low,InstructionSet.opNOT);
  1089. IF IsComplex(instruction.op1) THEN EmitArithmetic2(instruction, High, InstructionSet.opNOT) END;
  1090. |IntermediateCode.abs:
  1091. IF IsFloat(instruction.op1) THEN
  1092. IF backend.forceFPU THEN
  1093. EmitArithmetic2FPU(instruction,InstructionSet.opFABS)
  1094. ELSE
  1095. EmitAbsXMM(instruction)
  1096. END;
  1097. ELSE EmitAbs(instruction);
  1098. END;
  1099. |IntermediateCode.mul:
  1100. IF IsFloat(instruction.op1) THEN
  1101. IF backend.forceFPU THEN
  1102. EmitArithmetic3FPU(instruction,InstructionSet.opFMUL)
  1103. ELSE
  1104. EmitArithmetic3XMM(instruction, InstructionSet.opMULSS, InstructionSet.opMULSD)
  1105. END;
  1106. ELSE
  1107. EmitMul(instruction);
  1108. END;
  1109. |IntermediateCode.div:
  1110. IF IsFloat(instruction.op1 )THEN
  1111. IF backend.forceFPU THEN
  1112. EmitArithmetic3FPU(instruction,InstructionSet.opFDIV)
  1113. ELSE
  1114. EmitArithmetic3XMM(instruction, InstructionSet.opDIVSS, InstructionSet.opDIVSD)
  1115. END;
  1116. ELSE
  1117. EmitDivMod(instruction);
  1118. END;
  1119. |IntermediateCode.mod:
  1120. Assert(~IsFloat(instruction.op1),"instruction not supported for float");
  1121. EmitDivMod(instruction);
  1122. |IntermediateCode.sub:
  1123. IF IsFloat(instruction.op1) THEN
  1124. IF backend.forceFPU THEN
  1125. EmitArithmetic3FPU(instruction,InstructionSet.opFSUB)
  1126. ELSE
  1127. EmitArithmetic3XMM(instruction, InstructionSet.opSUBSS, InstructionSet.opSUBSD)
  1128. END;
  1129. ELSE EmitArithmetic3Part(instruction,Low,InstructionSet.opSUB);
  1130. IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, InstructionSet.opSBB) END;
  1131. END;
  1132. |IntermediateCode.add:
  1133. IF IsFloat(instruction.op1) THEN
  1134. IF backend.forceFPU THEN
  1135. EmitArithmetic3FPU(instruction,InstructionSet.opFADD)
  1136. ELSE
  1137. EmitArithmetic3XMM(instruction, InstructionSet.opADDSS, InstructionSet.opADDSD)
  1138. END;
  1139. ELSE EmitArithmetic3Part(instruction,Low,InstructionSet.opADD);
  1140. IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, InstructionSet.opADC) END;
  1141. END;
  1142. |IntermediateCode.and:
  1143. Assert(~IsFloat(instruction.op1),"operation not defined on float");
  1144. EmitArithmetic3(instruction,InstructionSet.opAND);
  1145. |IntermediateCode.or:
  1146. Assert(~IsFloat(instruction.op1),"operation not defined on float");
  1147. EmitArithmetic3(instruction,InstructionSet.opOR);
  1148. |IntermediateCode.xor:
  1149. Assert(~IsFloat(instruction.op1),"operation not defined on float");
  1150. EmitArithmetic3(instruction,InstructionSet.opXOR);
  1151. |IntermediateCode.shl: EmitShift(instruction);
  1152. |IntermediateCode.shr: EmitShift(instruction);
  1153. |IntermediateCode.rol: EmitShift(instruction);
  1154. |IntermediateCode.ror: EmitShift(instruction);
  1155. |IntermediateCode.cas: EmitCas(instruction);
  1156. |IntermediateCode.copy: EmitCopy(instruction);
  1157. |IntermediateCode.fill: EmitFill(instruction,FALSE);
  1158. |IntermediateCode.asm: EmitAsm(instruction);
  1159. END;
  1160. ReserveOperandRegisters(instruction.op3,FALSE); ReserveOperandRegisters(instruction.op2,FALSE); ReserveOperandRegisters(instruction.op1,FALSE);
  1161. END Generate;
  1162. PROCEDURE PostGenerate*(CONST instruction: IntermediateCode.Instruction);
  1163. VAR ticket: Ticket;
  1164. BEGIN
  1165. TryUnmap(instruction.op3); TryUnmap(instruction.op2); TryUnmap(instruction.op1);
  1166. ticket := tickets.live;
  1167. WHILE (ticket # NIL) & (ticket.lastuse = inPC) DO
  1168. UnmapTicket(ticket);
  1169. ticket := tickets.live
  1170. END;
  1171. END PostGenerate;
  1172. (* enter procedure: generate PAF and clear stack *)
  1173. PROCEDURE EmitEnter(CONST instruction: IntermediateCode.Instruction);
  1174. VAR op1,imm,target: Assembler.Operand; cc,size,numberMachineWords,destPC,firstPC,secondPC,x: LONGINT; body: SyntaxTree.Body; name: Basic.SegmentedName;
  1175. parametersSize: SIZE;
  1176. CONST initialize=TRUE; FirstOffset = 5; SecondOffset = 11;
  1177. BEGIN
  1178. stackSize := SHORT(instruction.op2.intValue);
  1179. size := stackSize;
  1180. INC(traceStackSize, stackSize);
  1181. IF initialize THEN
  1182. (* always including this instruction make trace insertion possible *)
  1183. IF backend.traceable THEN
  1184. emitter.Emit2(InstructionSet.opXOR,opRA,opRA);
  1185. END;
  1186. ASSERT(size MOD opRA.sizeInBytes = 0);
  1187. numberMachineWords := size DIV opRA.sizeInBytes;
  1188. IF numberMachineWords >0 THEN
  1189. IF ~backend.traceable THEN
  1190. emitter.Emit2(InstructionSet.opXOR,opRA,opRA);
  1191. END;
  1192. WHILE numberMachineWords MOD 4 # 0 DO
  1193. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1194. DEC(numberMachineWords);
  1195. END;
  1196. IF numberMachineWords >4 THEN
  1197. Assembler.InitImm(imm, 0, numberMachineWords DIV 4);
  1198. (* do not use EBX because it is not volative in WINAPI, do not use ECX: special register in COOP, do not use RD: register param in SysVABI *)
  1199. IF cpuBits = 64 THEN
  1200. emitter.Emit2(InstructionSet.opMOV, opR10, imm);
  1201. destPC := out.pc;
  1202. emitter.Emit1(InstructionSet.opDEC, opR10);
  1203. ELSE
  1204. emitter.Emit2(InstructionSet.opMOV, opRD, imm);
  1205. destPC := out.pc;
  1206. emitter.Emit1(InstructionSet.opDEC, opRD);
  1207. END;
  1208. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1209. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1210. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1211. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1212. Assembler.InitOffset8(target,destPC);
  1213. emitter.Emit1(InstructionSet.opJNZ, target)
  1214. ELSE
  1215. WHILE numberMachineWords >0 DO
  1216. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1217. DEC(numberMachineWords);
  1218. END;
  1219. END;
  1220. END;
  1221. IF spillStack.MaxSize()>0 THEN (* register spill stack, does not have to be initialized *)
  1222. op1 := Assembler.NewImm32(spillStack.MaxSize()*cpuBits DIV 8);
  1223. emitter.Emit2(InstructionSet.opSUB,opSP,op1);
  1224. END;
  1225. ELSE
  1226. op1 := Assembler.NewImm32(size+ spillStack.MaxSize());
  1227. emitter.Emit2(InstructionSet.opSUB,opSP,op1);
  1228. END;
  1229. cc := SHORT(instruction.op1.intValue);
  1230. IF (cc = SyntaxTree.WinAPICallingConvention) OR (cc = SyntaxTree.CCallingConvention) THEN
  1231. IF cpuBits = 32 THEN
  1232. (* the winapi calling convention presumes that all registers except EAX, EDX and ECX are retained by the callee *)
  1233. emitter.Emit1(InstructionSet.opPUSH,opEBX);
  1234. emitter.Emit1(InstructionSet.opPUSH,opEDI);
  1235. emitter.Emit1(InstructionSet.opPUSH,opESI);
  1236. ELSE ASSERT(cpuBits =64);
  1237. emitter.Emit1(InstructionSet.opPUSH,opRB);
  1238. emitter.Emit1(InstructionSet.opPUSH,opRDI);
  1239. emitter.Emit1(InstructionSet.opPUSH,opRSI);
  1240. emitter.Emit1(InstructionSet.opPUSH,opR12);
  1241. emitter.Emit1(InstructionSet.opPUSH,opR13);
  1242. emitter.Emit1(InstructionSet.opPUSH,opR14);
  1243. emitter.Emit1(InstructionSet.opPUSH,opR15);
  1244. END;
  1245. END;
  1246. spillStackStart := stackSize;
  1247. END EmitEnter;
  1248. PROCEDURE EmitLeave(CONST instruction: IntermediateCode.Instruction);
  1249. VAR cc: LONGINT; offset: Assembler.Operand;
  1250. BEGIN
  1251. cc := SHORT(instruction.op1.intValue);
  1252. IF (cc = SyntaxTree.WinAPICallingConvention) OR (cc = SyntaxTree.CCallingConvention) THEN
  1253. IF cpuBits = 32 THEN
  1254. emitter.Emit1(InstructionSet.opPOP,opESI);
  1255. emitter.Emit1(InstructionSet.opPOP,opEDI);
  1256. emitter.Emit1(InstructionSet.opPOP,opEBX);
  1257. ELSE ASSERT(cpuBits =64);
  1258. emitter.Emit1(InstructionSet.opPOP,opR15);
  1259. emitter.Emit1(InstructionSet.opPOP,opR14);
  1260. emitter.Emit1(InstructionSet.opPOP,opR13);
  1261. emitter.Emit1(InstructionSet.opPOP,opR12);
  1262. emitter.Emit1(InstructionSet.opPOP,opRSI);
  1263. emitter.Emit1(InstructionSet.opPOP,opRDI);
  1264. emitter.Emit1(InstructionSet.opPOP,opRB);
  1265. END;
  1266. END;
  1267. END EmitLeave;
  1268. PROCEDURE EmitExit(CONST instruction: IntermediateCode.Instruction);
  1269. VAR parSize,cc: LONGINT; operand: Assembler.Operand;
  1270. BEGIN
  1271. cc := SHORT(instruction.op2.intValue);
  1272. parSize := SHORT(instruction.op3.intValue);
  1273. IF (parSize = 0) OR (cc = SyntaxTree.WinAPICallingConvention) & (cpuBits = 64) THEN
  1274. emitter.Emit0(InstructionSet.opRET)
  1275. ELSE (* e.g. for WINAPI calling convention *)
  1276. operand := Assembler.NewImm16(parSize);
  1277. emitter.Emit1(InstructionSet.opRET,operand)
  1278. END;
  1279. IF fpStackPointer # 0 THEN Error(instruction.textPosition,"compiler implementation error: fp stack not cleared") END;
  1280. END EmitExit;
  1281. PROCEDURE EmitReturnFPU(CONST instruction: IntermediateCode.Instruction);
  1282. VAR operand: Assembler.Operand;
  1283. BEGIN
  1284. IF IsRegister(instruction.op1) & MappedTo(instruction.op1.register,Low, ST0) THEN
  1285. (* nothing to do: result is already in return register *)
  1286. ELSE
  1287. MakeOperand(instruction.op1, Low, operand,NIL);
  1288. emitter.Emit1(InstructionSet.opFLD,operand);
  1289. (*
  1290. not necessary to clear from top of stack as callee will clear
  1291. INC(fpStackPointer);
  1292. emitter.Emit1(InstructionSet.opFSTP,registerOperands[ST0+1]);
  1293. DEC(fpStackPointer);
  1294. *)
  1295. END;
  1296. END EmitReturnFPU;
  1297. (* return operand
  1298. store operand in return register or on fp stack
  1299. *)
  1300. PROCEDURE EmitReturn(CONST instruction: IntermediateCode.Instruction; part: LONGINT);
  1301. VAR return,operand: Assembler.Operand; register: LONGINT; ticket: Ticket; type: IntermediateCode.Type;
  1302. BEGIN
  1303. register := ResultRegister(instruction.op1.type, part);
  1304. IF IsRegister(instruction.op1) & MappedTo(instruction.op1.register,part, register) THEN
  1305. (* nothing to do: result is already in return register *)
  1306. ELSE
  1307. GetPartType(instruction.op1.type,part, type);
  1308. MakeOperand(instruction.op1, part, operand,NIL);
  1309. Spill(physicalRegisters.Mapped(register));
  1310. ticket := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,type,register,inPC);
  1311. TicketToOperand(ticket, return);
  1312. (* Mov takes care of potential register overlaps *)
  1313. Move(return, operand, type);
  1314. UnmapTicket(ticket);
  1315. END;
  1316. END EmitReturn;
  1317. PROCEDURE EmitMovFloat(CONST vdest,vsrc:IntermediateCode.Operand);
  1318. VAR dest,src, espm: Assembler.Operand; sizeInBytes: SHORTINT; stackSize: LONGINT; vcopy: IntermediateCode.Operand;
  1319. BEGIN
  1320. sizeInBytes := SHORTINT(vdest.type.sizeInBits DIV 8);
  1321. stackSize := sizeInBytes;
  1322. Basic.Align(stackSize, cpuBits DIV 8);
  1323. IF vdest.type.form IN IntermediateCode.Integer THEN
  1324. (* e.g. in SYSTEM.VAL(LONGINT, r) *)
  1325. IF vsrc.mode = IntermediateCode.ModeMemory THEN
  1326. vcopy := vsrc; IntermediateCode.SetType(vcopy,vdest.type);
  1327. EmitMov(vdest, vcopy,Low);
  1328. IF IsComplex(vdest) THEN
  1329. EmitMov(vdest,vcopy,High);
  1330. END;
  1331. ELSE
  1332. IF backend.forceFPU THEN
  1333. MakeOperand(vsrc,Low,src,NIL);
  1334. emitter.Emit1(InstructionSet.opFLD,src);
  1335. INC(fpStackPointer);
  1336. IF vdest.mode = IntermediateCode.ModeMemory THEN
  1337. MakeOperand(vdest,Low,dest,NIL);
  1338. Assembler.SetSize(dest,sizeInBytes);
  1339. emitter.Emit1(InstructionSet.opFSTP,dest);
  1340. DEC(fpStackPointer);
  1341. ELSE
  1342. AllocateStack(stackSize);
  1343. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1344. emitter.Emit1(InstructionSet.opFSTP,espm);
  1345. DEC(fpStackPointer);
  1346. MakeOperand(vdest,Low,dest,NIL);
  1347. EmitPop(vdest,Low);
  1348. IF IsComplex(vdest) THEN
  1349. EmitPop(vdest,High);
  1350. END;
  1351. END;
  1352. ELSE
  1353. MakeOperand(vsrc, Low, src, NIL);
  1354. IF vdest.mode = IntermediateCode.ModeMemory THEN
  1355. MakeOperand(vdest, Low, dest, NIL);
  1356. Move(dest, src, vsrc.type);
  1357. ELSE (* need temporary stack argument *)
  1358. AllocateStack(stackSize);
  1359. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1360. Move(espm, src, vsrc.type);
  1361. MakeOperand(vdest,Low,dest,NIL);
  1362. EmitPop(vdest,Low);
  1363. IF IsComplex(vdest) THEN
  1364. EmitPop(vdest,High);
  1365. END;
  1366. END;
  1367. END;
  1368. END;
  1369. ELSIF vsrc.type.form IN IntermediateCode.Integer THEN
  1370. (* e.g. in SYSTEM.VAL(REAL, i) *)
  1371. IF vdest.mode = IntermediateCode.ModeMemory THEN
  1372. vcopy := vdest; IntermediateCode.SetType(vcopy,vsrc.type);
  1373. EmitMov(vcopy, vsrc,Low);
  1374. IF IsComplex(vsrc) THEN
  1375. EmitMov(vcopy,vsrc,High);
  1376. END;
  1377. ELSE
  1378. IF backend.forceFPU THEN
  1379. IF vsrc.mode = IntermediateCode.ModeMemory THEN
  1380. MakeOperand(vsrc,Low,src,NIL);
  1381. Assembler.SetSize(src,sizeInBytes);
  1382. emitter.Emit1(InstructionSet.opFLD,src);
  1383. ELSE
  1384. IF IsComplex(vsrc) THEN
  1385. EmitPush(vsrc,High);
  1386. END;
  1387. EmitPush(vsrc,Low);
  1388. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1389. emitter.Emit1(InstructionSet.opFLD,espm);
  1390. ASSERT(sizeInBytes >0);
  1391. AllocateStack(-stackSize);
  1392. END;
  1393. INC(fpStackPointer);
  1394. MakeOperand(vdest,Low,dest,NIL);
  1395. emitter.Emit1(InstructionSet.opFSTP,dest);
  1396. DEC(fpStackPointer);
  1397. ELSE
  1398. IF vsrc.mode = IntermediateCode.ModeMemory THEN
  1399. MakeOperand(vsrc,Low,src,NIL);
  1400. Assembler.SetSize(src,sizeInBytes);
  1401. MakeOperand(vdest,Low,dest,NIL);
  1402. Move(dest, src, vdest.type);
  1403. ELSE
  1404. IF IsComplex(vsrc) THEN
  1405. EmitPush(vsrc,High);
  1406. END;
  1407. EmitPush(vsrc,Low);
  1408. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1409. MakeOperand(vdest, Low, dest, NIL);
  1410. Move(dest, espm, vdest.type);
  1411. AllocateStack(-stackSize);
  1412. END;
  1413. END;
  1414. END;
  1415. ELSE
  1416. IF backend.forceFPU THEN
  1417. MakeOperand(vsrc,Low,src,NIL);
  1418. emitter.Emit1(InstructionSet.opFLD,src);
  1419. INC(fpStackPointer);
  1420. MakeOperand(vdest,Low,dest,NIL);
  1421. emitter.Emit1(InstructionSet.opFSTP,dest);
  1422. DEC(fpStackPointer);
  1423. ELSE
  1424. MakeOperand(vsrc, Low, src, NIL);
  1425. MakeOperand(vdest, Low, dest, NIL);
  1426. Move(dest, src, vdest.type)
  1427. END;
  1428. END;
  1429. END EmitMovFloat;
  1430. PROCEDURE EmitMov(CONST vdest,vsrc: IntermediateCode.Operand; part: LONGINT);
  1431. VAR op1,op2: Assembler.Operand; tmp: IntermediateCode.Operand;
  1432. t: CodeGenerators.Ticket;
  1433. type: IntermediateCode.Type;
  1434. offset: LONGINT;
  1435. BEGIN
  1436. IF (vdest.mode = IntermediateCode.ModeRegister) & (vsrc.mode = IntermediateCode.ModeRegister) & (vsrc.type.sizeInBits > 8) & (vsrc.offset # 0)THEN
  1437. (* MOV R1, R2+offset => LEA EAX, [EBX+offset] *)
  1438. tmp := vsrc;
  1439. IntermediateCode.MakeMemory(tmp,vsrc.type);
  1440. MakeOperand(tmp,part,op2,NIL);
  1441. (*
  1442. ReleaseHint(op2.register);
  1443. *)
  1444. MakeOperand(vdest,part,op1,NIL);
  1445. t := virtualRegisters.Mapped(vdest.register,part);
  1446. IF (t # NIL) & (t.spilled) THEN
  1447. UnSpill(t); (* make sure this has not spilled *)
  1448. MakeOperand(vdest,part, op1,NIL);
  1449. END;
  1450. emitter.Emit2(InstructionSet.opLEA,op1,op2);
  1451. ELSE
  1452. MakeOperand(vsrc,part,op2,NIL);
  1453. MakeOperand(vdest,part,op1,NIL);
  1454. GetPartType(vsrc.type, part, type);
  1455. Move(op1,op2, type);
  1456. END;
  1457. END EmitMov;
  1458. PROCEDURE EmitConvertFloat(CONST instruction: IntermediateCode.Instruction);
  1459. VAR destType, srcType, dtype: IntermediateCode.Type; dest,src,espm,imm: Assembler.Operand; sizeInBytes, index: LONGINT;
  1460. temp, temp2, temp3, temp4, zero: Assembler.Operand; ticket: Ticket; vdest, vsrc: IntermediateCode.Operand;
  1461. unsigned: BOOLEAN;
  1462. BEGIN
  1463. vdest := instruction.op1; vsrc := instruction.op2;
  1464. srcType := vsrc.type;
  1465. destType := vdest.type;
  1466. IF destType.form = IntermediateCode.Float THEN
  1467. CASE srcType.form OF
  1468. |IntermediateCode.Float: (* just a move *)
  1469. IF backend.forceFPU THEN
  1470. EmitMovFloat(vdest, vsrc);
  1471. ELSE
  1472. MakeOperand(vsrc,Low,src,NIL);
  1473. MakeOperand(vdest, Low, dest, NIL);
  1474. IF srcType.sizeInBits = 32 THEN
  1475. SpecialMove(InstructionSet.opCVTSS2SD, InstructionSet.opMOVSS, FALSE, dest, src, destType)
  1476. ELSE
  1477. SpecialMove(InstructionSet.opCVTSD2SS, InstructionSet.opMOVSD, FALSE, dest, src, destType)
  1478. END;
  1479. END;
  1480. |IntermediateCode.SignedInteger, IntermediateCode.UnsignedInteger:
  1481. (* put value to stack and then read from stack via Float *)
  1482. unsigned := srcType.form = IntermediateCode.UnsignedInteger;
  1483. IF vsrc.type.sizeInBits < IntermediateCode.Bits32 THEN
  1484. MakeOperand(vsrc,Low,src,NIL);
  1485. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1486. TicketToOperand(ticket,temp);
  1487. IF unsigned THEN
  1488. emitter.Emit2(InstructionSet.opMOVZX,temp,src);
  1489. ELSE
  1490. emitter.Emit2(InstructionSet.opMOVSX,temp,src);
  1491. END;
  1492. IF backend.forceFPU THEN (* via stack *)
  1493. emitter.Emit1(InstructionSet.opPUSH,temp);
  1494. UnmapTicket(ticket);
  1495. sizeInBytes := temp.sizeInBytes;
  1496. ELSE (* via register *)
  1497. espm := temp;
  1498. sizeInBytes := 0
  1499. END;
  1500. ELSIF IsComplex(vsrc) THEN (* via stack *)
  1501. EmitPush(vsrc,High);
  1502. EmitPush(vsrc,Low);
  1503. sizeInBytes := 8
  1504. ELSIF unsigned & (cpuBits=32) & ( vsrc.type.sizeInBits = IntermediateCode.Bits32) THEN (* UNSIGNED32 *)
  1505. sizeInBytes := 8;
  1506. Assembler.InitImm(zero,0,0);
  1507. emitter.Emit1(InstructionSet.opPUSH,zero);
  1508. EmitPush(vsrc,Low);
  1509. ELSIF unsigned & ( vsrc.type.sizeInBits = IntermediateCode.Bits32) THEN (* UNSIGNED32 on 64-bit *)
  1510. MakeRegister(vsrc, Low, src);
  1511. index := src.register;
  1512. index := index MOD 32 + RAX;
  1513. src := registerOperands[index];
  1514. espm := src;
  1515. ELSE
  1516. IF backend.forceFPU THEN (* via stack *)
  1517. EmitPush(vsrc,Low);
  1518. sizeInBytes := SHORTINT(cpuBits DIV 8);
  1519. ELSE (* via memory or register *)
  1520. sizeInBytes := 0;
  1521. MakeOperand(vsrc,Low,src,NIL);
  1522. IF Assembler.IsImmediateOperand(src) THEN (* use temporary register *)
  1523. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1524. TicketToOperand(ticket,temp);
  1525. IF unsigned THEN
  1526. emitter.Emit2(InstructionSet.opMOVZX,temp,src);
  1527. ELSE
  1528. emitter.Emit2(InstructionSet.opMOVSX,temp,src);
  1529. END;
  1530. espm := temp
  1531. ELSE
  1532. espm := src
  1533. END;
  1534. END
  1535. END;
  1536. IF sizeInBytes > 0 THEN
  1537. Assembler.InitMem(espm, SHORTINT(sizeInBytes),SP,0);
  1538. END;
  1539. IF backend.forceFPU THEN
  1540. emitter.Emit1(InstructionSet.opFILD,espm);
  1541. INC(fpStackPointer);
  1542. ASSERT(sizeInBytes >0);
  1543. Basic.Align(sizeInBytes, cpuBits DIV 8);
  1544. AllocateStack(-sizeInBytes);
  1545. MakeOperand(vdest,Low,dest,NIL);
  1546. emitter.Emit1(InstructionSet.opFSTP,dest);
  1547. DEC(fpStackPointer);
  1548. ELSIF IsComplex(vsrc) OR unsigned & (cpuBits=32) & ( vsrc.type.sizeInBits = IntermediateCode.Bits32) THEN
  1549. emitter.Emit1(InstructionSet.opFILD,espm);
  1550. MakeOperand(vdest,Low,dest,NIL);
  1551. IF Assembler.IsMemoryOperand(dest) THEN
  1552. emitter.Emit1(InstructionSet.opFSTP,dest);
  1553. ELSE (* must be register *)
  1554. emitter.Emit1(InstructionSet.opFSTP,espm);
  1555. emitter.Emit2(InstructionSet.opMOVQ,dest,espm);
  1556. IF destType.sizeInBits = 32 THEN
  1557. emitter.Emit2(InstructionSet.opCVTSD2SS, dest,dest);
  1558. END;
  1559. END;
  1560. AllocateStack(-sizeInBytes);
  1561. ELSE
  1562. MakeOperand(vdest,Low,dest,NIL);
  1563. IF destType.sizeInBits = 32 THEN
  1564. emitter.Emit2(InstructionSet.opCVTSI2SS, dest, espm)
  1565. ELSE
  1566. emitter.Emit2(InstructionSet.opCVTSI2SD, dest, espm)
  1567. END;
  1568. AllocateStack(-sizeInBytes);
  1569. END;
  1570. END;
  1571. ELSE
  1572. ASSERT(destType.form IN IntermediateCode.Integer);
  1573. ASSERT(srcType.form = IntermediateCode.Float);
  1574. Assert(vdest.type.form = IntermediateCode.SignedInteger, "no entier as result for unsigned integer");
  1575. MakeOperand(vsrc,Low,src,NIL);
  1576. IF ~backend.forceFPU THEN
  1577. MakeOperand(vdest,Low,dest,ticket);
  1578. GetTemporaryRegister(srcType, temp);
  1579. GetTemporaryRegister(srcType, temp3);
  1580. IF destType.sizeInBits < 32 THEN
  1581. IntermediateCode.InitType(dtype, destType.form, 32);
  1582. GetTemporaryRegister(dtype, temp4);
  1583. ELSE
  1584. dtype := destType;
  1585. temp4 := dest;
  1586. END;
  1587. GetTemporaryRegister(dtype, temp2);
  1588. IF srcType.sizeInBits = 32 THEN
  1589. (* convert truncated -> negative numbers round up !*)
  1590. emitter.Emit2(InstructionSet.opCVTTSS2SI, temp4, src);
  1591. (* back to temporary mmx register *)
  1592. emitter.Emit2(InstructionSet.opCVTSI2SS, temp, temp4);
  1593. (* subtract *)
  1594. emitter.Emit2(InstructionSet.opMOVSS, temp3, src);
  1595. emitter.Emit2(InstructionSet.opSUBSS, temp3, temp);
  1596. (* back to a GP register in order to determine the sign bit *)
  1597. ELSE
  1598. emitter.Emit2(InstructionSet.opCVTTSD2SI, temp4, src);
  1599. emitter.Emit2(InstructionSet.opCVTSI2SD, temp, temp4);
  1600. emitter.Emit2(InstructionSet.opMOVSD, temp3, src);
  1601. emitter.Emit2(InstructionSet.opSUBSD, temp3, temp);
  1602. emitter.Emit2(InstructionSet.opCVTSD2SS, temp3, temp3);
  1603. END;
  1604. emitter.Emit2(InstructionSet.opMOVD, temp2, temp3);
  1605. Assembler.InitImm(imm, 0 ,srcType.sizeInBits-1);
  1606. emitter.Emit2(InstructionSet.opBT, temp2, imm);
  1607. Assembler.InitImm(imm, 0 ,0);
  1608. emitter.Emit2(InstructionSet.opSBB, temp4, imm);
  1609. IF dtype.sizeInBits # destType.sizeInBits THEN
  1610. index := temp4.register;
  1611. CASE destType.sizeInBits OF (* choose low part accordingly *)
  1612. IntermediateCode.Bits8: index := index MOD 32 + AL;
  1613. |IntermediateCode.Bits16: index := index MOD 32 + AX;
  1614. |IntermediateCode.Bits32: index := index MOD 32 + EAX;
  1615. END;
  1616. temp4 := registerOperands[index];
  1617. emitter.Emit2(InstructionSet.opMOV, dest, temp4);
  1618. END
  1619. ELSE
  1620. emitter.Emit1(InstructionSet.opFLD,src); INC(fpStackPointer);
  1621. MakeOperand(vdest,Low,dest,NIL);
  1622. IF destType.sizeInBits = IntermediateCode.Bits64 THEN AllocateStack(12) ELSE AllocateStack(8) END;
  1623. Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,0);
  1624. emitter.Emit1(InstructionSet.opFNSTCW,espm);
  1625. emitter.Emit0(InstructionSet.opFWAIT);
  1626. Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,0);
  1627. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1628. TicketToOperand(ticket,temp);
  1629. emitter.Emit2(InstructionSet.opMOV,temp,espm);
  1630. imm := Assembler.NewImm32(0F3FFH);
  1631. emitter.Emit2(InstructionSet.opAND,temp,imm);
  1632. imm := Assembler.NewImm32(0400H);
  1633. emitter.Emit2(InstructionSet.opOR,temp,imm);
  1634. Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,4);
  1635. emitter.Emit2(InstructionSet.opMOV,espm,temp);
  1636. Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,4);
  1637. emitter.Emit1(InstructionSet.opFLDCW,espm);
  1638. IF destType.sizeInBits = IntermediateCode.Bits64 THEN
  1639. Assembler.InitMem(espm,IntermediateCode.Bits64 DIV 8,SP,4);
  1640. emitter.Emit1(InstructionSet.opFISTP,espm);DEC(fpStackPointer);
  1641. emitter.Emit0(InstructionSet.opFWAIT);
  1642. ELSE
  1643. Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,4);
  1644. emitter.Emit1(InstructionSet.opFISTP,espm); DEC(fpStackPointer);
  1645. emitter.Emit0(InstructionSet.opFWAIT);
  1646. END;
  1647. Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,0);
  1648. emitter.Emit1(InstructionSet.opFLDCW,espm);
  1649. emitter.Emit1(InstructionSet.opPOP,temp);
  1650. UnmapTicket(ticket);
  1651. emitter.Emit1(InstructionSet.opPOP,dest);
  1652. IF IsComplex(vdest) THEN
  1653. MakeOperand(vdest,High,dest,NIL);
  1654. emitter.Emit1(InstructionSet.opPOP,dest);
  1655. END;
  1656. END;
  1657. END;
  1658. END EmitConvertFloat;
  1659. PROCEDURE EmitConvert(CONST vdest, vsrc: IntermediateCode.Operand; part: LONGINT);
  1660. VAR destType, srcType: IntermediateCode.Type; op1,op2: Assembler.Operand; index: LONGINT; nul: Assembler.Operand;
  1661. ticket: Ticket; vop: IntermediateCode.Operand; ediReserved, esiReserved: BOOLEAN;
  1662. eax, edx: Ticket; symbol: ObjectFile.Identifier; offset: LONGINT;
  1663. BEGIN
  1664. GetPartType(vdest.type,part, destType);
  1665. GetPartType(vsrc.type,part,srcType);
  1666. ASSERT(vdest.type.form IN IntermediateCode.Integer);
  1667. ASSERT(destType.form IN IntermediateCode.Integer);
  1668. IF destType.sizeInBits < srcType.sizeInBits THEN (* SHORT *)
  1669. ASSERT(part # High);
  1670. MakeOperand(vdest,part,op1,NIL);
  1671. IF vsrc.mode = IntermediateCode.ModeImmediate THEN
  1672. vop := vsrc;
  1673. IntermediateCode.SetType(vop,destType);
  1674. MakeOperand(vop,part,op2,NIL);
  1675. ELSE
  1676. MakeOperand(vsrc,part,op2,NIL);
  1677. IF Assembler.IsRegisterOperand(op1) & ((op1.register DIV 32 >0) (* not 8 bit register *) OR (op1.register DIV 16 = 0) & (physicalRegisters.Mapped(op1.register MOD 16 + AH)=free) (* low 8 bit register with free upper part *)) THEN
  1678. (* try EAX <- EDI for dest = AL or AX, src=EDI *)
  1679. index := op1.register;
  1680. CASE srcType.sizeInBits OF
  1681. IntermediateCode.Bits16: index := index MOD 32 + AX;
  1682. |IntermediateCode.Bits32: index := index MOD 32 + EAX;
  1683. |IntermediateCode.Bits64: index := index MOD 32 + RAX;
  1684. END;
  1685. op1 := registerOperands[index];
  1686. ELSE
  1687. (* reserve register with a low part *)
  1688. IF destType.sizeInBits=8 THEN (* make sure that allocated temporary register has a low part with 8 bits, i.e. exclude ESI or EDI *)
  1689. ediReserved := physicalRegisters.Reserved(EDI);
  1690. esiReserved := physicalRegisters.Reserved(ESI);
  1691. physicalRegisters.SetReserved(EDI,TRUE); physicalRegisters.SetReserved(ESI,TRUE);
  1692. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,srcType); (* register with low part *)
  1693. physicalRegisters.SetReserved(EDI,ediReserved); physicalRegisters.SetReserved(ESI,esiReserved);
  1694. ELSE
  1695. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,srcType); (* any register with low part *)
  1696. END;
  1697. MakeOperand(vsrc,part,op2,ticket); (* stores op2 in ticket register *)
  1698. index := op2.register;
  1699. CASE destType.sizeInBits OF (* choose low part accordingly *)
  1700. IntermediateCode.Bits8: index := index MOD 32 + AL;
  1701. |IntermediateCode.Bits16: index := index MOD 32 + AX;
  1702. |IntermediateCode.Bits32: index := index MOD 32 + EAX;
  1703. END;
  1704. op2 := registerOperands[index];
  1705. END;
  1706. Move(op1,op2,PhysicalOperandType(op1));
  1707. END;
  1708. ELSIF destType.sizeInBits > srcType.sizeInBits THEN (* (implicit) LONG *)
  1709. IF part = High THEN
  1710. IF destType.form = IntermediateCode.SignedInteger THEN
  1711. Spill(physicalRegisters.Mapped(EAX));
  1712. eax := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
  1713. Spill(physicalRegisters.Mapped(EDX));
  1714. edx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EDX,inPC);
  1715. IF vsrc.type.sizeInBits < 32 THEN
  1716. MakeOperand(vsrc,Low,op2,NIL);
  1717. SpecialMove(InstructionSet.opMOVSX,InstructionSet.opMOV, FALSE, opEAX,op2,PhysicalOperandType(opEAX));
  1718. ELSE
  1719. MakeOperand(vsrc,Low,op2,eax);
  1720. END;
  1721. emitter.Emit0(InstructionSet.opCDQ);
  1722. MakeOperand(vdest,High,op1,NIL);
  1723. emitter.Emit2(InstructionSet.opMOV,op1,opEDX);
  1724. UnmapTicket(eax); UnmapTicket(edx);
  1725. ELSE
  1726. MakeOperand(vdest,part,op1,NIL);
  1727. IF (vdest.mode = IntermediateCode.ModeRegister) THEN
  1728. emitter.Emit2(InstructionSet.opXOR,op1,op1)
  1729. ELSE
  1730. Assembler.InitImm(nul,0,0);
  1731. emitter.Emit2(InstructionSet.opMOV,op1,nul);
  1732. END;
  1733. END;
  1734. ELSE
  1735. ASSERT(part=Low);
  1736. MakeOperand(vdest,part,op1,NIL);
  1737. MakeOperand(vsrc,part,op2,NIL);
  1738. IF srcType.sizeInBits = destType.sizeInBits THEN
  1739. Move(op1,op2,PhysicalOperandType(op1));
  1740. ELSIF srcType.form = IntermediateCode.SignedInteger THEN
  1741. IF srcType.sizeInBits=32 THEN (* 64 bits only *)
  1742. ASSERT(cpuBits=64);
  1743. SpecialMove(InstructionSet.opMOVSXD,InstructionSet.opMOV, FALSE, op1,op2,PhysicalOperandType(op1));
  1744. ELSE
  1745. SpecialMove(InstructionSet.opMOVSX,InstructionSet.opMOV, FALSE, op1,op2,PhysicalOperandType(op1));
  1746. END;
  1747. ELSE
  1748. ASSERT(srcType.form = IntermediateCode.UnsignedInteger);
  1749. IF srcType.sizeInBits=32 THEN (* 64 bits only *)
  1750. ASSERT(cpuBits=64);
  1751. IF Assembler.IsRegisterOperand(op1) THEN
  1752. Move( registerOperands[op1.register MOD 32 + EAX], op2,srcType);
  1753. ELSE
  1754. ASSERT(Assembler.IsMemoryOperand(op1));
  1755. symbol := op1.symbol; offset := op1.offset;
  1756. Assembler.InitMem(op1,Assembler.bits32,op1.register, op1.displacement);
  1757. Assembler.SetSymbol(op1,symbol.name,symbol.fingerprint,offset,op1.displacement);
  1758. Move( op1, op2, srcType);
  1759. Assembler.InitMem(op1,Assembler.bits32,op1.register, op1.displacement+Assembler.bits32);
  1760. Assembler.SetSymbol(op1,symbol.name, symbol.fingerprint,offset,op1.displacement);
  1761. Assembler.InitImm(op2,0,0);
  1762. Move( op1, op2,srcType);
  1763. END;
  1764. ELSE
  1765. SpecialMove(InstructionSet.opMOVZX, InstructionSet.opMOV, FALSE, op1, op2,PhysicalOperandType(op1))
  1766. END;
  1767. END;
  1768. END;
  1769. ELSE (* destType.sizeInBits = srcType.sizeInBits) *)
  1770. EmitMov(vdest,vsrc,part);
  1771. END;
  1772. END EmitConvert;
  1773. PROCEDURE EmitResult(CONST instruction: IntermediateCode.Instruction);
  1774. VAR result, resultHigh, op, opHigh: Assembler.Operand; register, highRegister: LONGINT; lowReserved, highReserved: BOOLEAN; type: IntermediateCode.Type;
  1775. BEGIN
  1776. IF ~IsComplex(instruction.op1) THEN
  1777. register := ResultRegister(instruction.op1.type,Low);
  1778. result := registerOperands[register];
  1779. MakeOperand(instruction.op1,Low,op,NIL);
  1780. GetPartType(instruction.op1.type, Low, type);
  1781. Move(op,result,type);
  1782. ELSE
  1783. register := ResultRegister(instruction.op1.type,Low);
  1784. result := registerOperands[register];
  1785. highRegister := ResultRegister(instruction.op1.type, High);
  1786. resultHigh := registerOperands[highRegister];
  1787. (* make sure that result registers are not used during emission of Low / High *)
  1788. lowReserved := physicalRegisters.Reserved(register);
  1789. physicalRegisters.SetReserved(register, TRUE);
  1790. highReserved := physicalRegisters.Reserved(highRegister);
  1791. physicalRegisters.SetReserved(highRegister,TRUE);
  1792. MakeOperand(instruction.op1,Low,op, NIL);
  1793. IF Assembler.SameOperand(op, resultHigh) THEN
  1794. emitter.Emit2(InstructionSet.opXCHG, result, resultHigh); (* low register already mapped ok *)
  1795. MakeOperand(instruction.op1, High, opHigh, NIL);
  1796. GetPartType(instruction.op1.type, High, type);
  1797. Move(opHigh, result, type);
  1798. ELSE
  1799. GetPartType(instruction.op1.type, Low, type);
  1800. Move(op, result, type);
  1801. MakeOperand(instruction.op1,High, opHigh, NIL);
  1802. GetPartType(instruction.op1.type, High, type);
  1803. Move(opHigh, resultHigh, type);
  1804. END;
  1805. physicalRegisters.SetReserved(register, lowReserved);
  1806. physicalRegisters.SetReserved(highRegister, highReserved);
  1807. END;
  1808. END EmitResult;
  1809. PROCEDURE EmitResultFPU(CONST instruction: IntermediateCode.Instruction);
  1810. VAR op: Assembler.Operand;
  1811. BEGIN
  1812. INC(fpStackPointer); (* callee has left the result on top of stack, don't have to allocate here *)
  1813. MakeOperand(instruction.op1,Low,op,NIL);
  1814. emitter.Emit1(InstructionSet.opFSTP,op);
  1815. DEC(fpStackPointer);
  1816. (*
  1817. UnmapTicket(ticket);
  1818. *)
  1819. END EmitResultFPU;
  1820. PROCEDURE EmitCall(CONST instruction: IntermediateCode.Instruction);
  1821. VAR fixup: Sections.Section; target, op, parSize: Assembler.Operand;
  1822. code: SyntaxTree.Code; emitterFixup,newFixup: BinaryCode.Fixup; resolved: BinaryCode.Section; pc: LONGINT;
  1823. BEGIN
  1824. IF fpStackPointer # 0 THEN Error(instruction.textPosition,"compiler implementation error: fp stack not cleared before call") END;
  1825. IF instruction.op1.mode = IntermediateCode.ModeImmediate THEN
  1826. fixup := module.allSections.FindByName(instruction.op1.symbol.name);
  1827. IF (fixup # NIL) & (fixup.type = Sections.InlineCodeSection) THEN
  1828. pc := out.pc;
  1829. (* resolved must be available at this point ! *)
  1830. resolved := fixup(IntermediateCode.Section).resolved;
  1831. IF resolved # NIL THEN
  1832. emitter.code.CopyBits(resolved.os.bits,0,resolved.os.bits.GetSize());
  1833. emitterFixup := resolved.fixupList.firstFixup;
  1834. WHILE (emitterFixup # NIL) DO
  1835. newFixup := BinaryCode.NewFixup(emitterFixup.mode,emitterFixup.offset+pc,emitterFixup.symbol,emitterFixup.symbolOffset,emitterFixup.displacement,emitterFixup.scale,emitterFixup.pattern);
  1836. out.fixupList.AddFixup(newFixup);
  1837. emitterFixup := emitterFixup.nextFixup;
  1838. END;
  1839. END;
  1840. ELSIF cpuBits = 64 THEN
  1841. MakeOperand(instruction.op1,Low,op,NIL);
  1842. emitter.Emit1(InstructionSet.opCALL,op);
  1843. Assembler.InitOffset32(parSize,instruction.op2.intValue);
  1844. IF parSize.val # 0 THEN emitter.Emit2(InstructionSet.opADD,opSP,parSize) END;
  1845. ELSE
  1846. Assembler.InitOffset32(target,instruction.op1.intValue);
  1847. Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.offset,0);
  1848. emitter.Emit1(InstructionSet.opCALL,target);
  1849. Assembler.InitOffset32(parSize,instruction.op2.intValue);
  1850. IF parSize.val # 0 THEN emitter.Emit2(InstructionSet.opADD,opSP,parSize) END;
  1851. END;
  1852. ELSE
  1853. MakeOperand(instruction.op1,Low,op,NIL);
  1854. emitter.Emit1(InstructionSet.opCALL,op);
  1855. Assembler.InitOffset32(parSize,instruction.op2.intValue);
  1856. IF parSize.val # 0 THEN emitter.Emit2(InstructionSet.opADD,opSP,parSize) END;
  1857. END;
  1858. END EmitCall;
  1859. (*
  1860. register allocation
  1861. instruction dest, src1, src2
  1862. preconditions
  1863. dest is memory operand or dest is register with offset = 0
  1864. src1 and src2 may be immediates, registers with or without offset and memory operands
  1865. 1.) translation into two-operand code
  1866. a) dest = src1 (no assumption on src2, src2=src1 is permitted )
  1867. i) dest and src2 are both memory operands or src2 is a register with offset # 0
  1868. alloc temp register
  1869. mov temp, src2
  1870. instruction2 dest, temp
  1871. ii) dest or src2 is not a memory operand
  1872. instruction2 dest, src2
  1873. b) dest = src2
  1874. => src2 is not a register with offset # 0
  1875. alloc temp register
  1876. mov dest, src1
  1877. mov temp, src2
  1878. instruction2 dest, temp
  1879. c) dest # src2
  1880. mov dest, src1
  1881. i) dest and src2 are both memory operands or src2 is a register with offset # 0
  1882. allocate temp register
  1883. mov temp, src2
  1884. instruction2 dest, temp
  1885. ii)
  1886. instruction2 dest, src2
  1887. 1'.) translation into one operand code
  1888. instruction dest, src1
  1889. a) dest = src1
  1890. => src1 is not a register with offset # 0
  1891. instruction1 dest
  1892. b) dest # src1
  1893. mov dest, src1
  1894. instruction1 dest
  1895. 2.) register allocation
  1896. precondition: src1 and src2 are already allocated
  1897. a) dest is already allocated
  1898. go on according to 1.
  1899. b) dest needs to be allocated
  1900. check if register is free
  1901. i) yes: allocate free register and go on with 1.
  1902. ii) no: spill last register in livelist, map register and go on with 1.
  1903. *)
  1904. PROCEDURE PrepareOp3(CONST instruction: IntermediateCode.Instruction;part: LONGINT; VAR left, right: Assembler.Operand; VAR ticket: Ticket);
  1905. VAR vop1,vop2, vop3: IntermediateCode.Operand; op1,op2,op3,temp: Assembler.Operand; type: IntermediateCode.Type;
  1906. t: Ticket;
  1907. BEGIN
  1908. ticket := NIL;
  1909. GetPartType(instruction.op1.type,part,type);
  1910. vop1 := instruction.op1; vop2 := instruction.op2; vop3 := instruction.op3;
  1911. IF IntermediateCode.OperandEquals(vop1,vop3) & (IntermediateCode.Commute23 IN IntermediateCode.instructionFormat[instruction.opcode].flags) THEN
  1912. vop3 := instruction.op2; vop2 := instruction.op3;
  1913. END;
  1914. MakeOperand(vop3,part, op3,NIL);
  1915. IF (vop1.mode = IntermediateCode.ModeRegister) & (~IsMemoryOperand(vop1,part)) & (vop1.register # vop3.register) THEN
  1916. IF (vop2.mode = IntermediateCode.ModeRegister) & (vop2.register = vop1.register) & (vop2.offset = 0) THEN
  1917. (* same register *)
  1918. MakeOperand(vop1,part, op1,NIL);
  1919. ELSE
  1920. MakeOperand(vop2,part, op2,NIL);
  1921. (*
  1922. ReleaseHint(op2.register);
  1923. *)
  1924. MakeOperand(vop1,part, op1,NIL);
  1925. Move(op1, op2, type);
  1926. t := virtualRegisters.Mapped(vop1.register,part);
  1927. IF (t # NIL) & (t.spilled) THEN
  1928. UnSpill(t); (* make sure this has not spilled *)
  1929. MakeOperand(vop1,part, op1,NIL);
  1930. END;
  1931. END;
  1932. left := op1; right := op3;
  1933. ELSIF IntermediateCode.OperandEquals(vop1,vop2) & (~IsMemoryOperand(vop1,part) OR ~IsMemoryOperand(vop3,part)) THEN
  1934. MakeOperand(vop1,part, op1,NIL);
  1935. left := op1; right := op3;
  1936. ELSE
  1937. MakeOperand(vop1,part, op1,NIL);
  1938. MakeOperand(vop2,part, op2,NIL);
  1939. (*ReleaseHint(op2.register);*)
  1940. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
  1941. TicketToOperand(ticket,temp);
  1942. Move(temp, op2, type);
  1943. left := temp; right := op3;
  1944. END;
  1945. END PrepareOp3;
  1946. PROCEDURE PrepareOp2(CONST instruction: IntermediateCode.Instruction; part: LONGINT; VAR left: Assembler.Operand;VAR ticket: Ticket);
  1947. VAR op2: Assembler.Operand; imm: Assembler.Operand; sizeInBits: INTEGER; type: IntermediateCode.Type;
  1948. BEGIN
  1949. ticket := NIL;
  1950. GetPartType(instruction.op1.type,part,type);
  1951. IF (instruction.op1.mode = IntermediateCode.ModeRegister) THEN
  1952. MakeOperand(instruction.op1,part,left,NIL);
  1953. MakeOperand(instruction.op2,part,op2,NIL);
  1954. IF (instruction.op2.mode = IntermediateCode.ModeRegister) & (instruction.op2.register = instruction.op1.register) & (instruction.op2.offset = 0) THEN
  1955. ELSE
  1956. Move(left, op2, type);
  1957. IF (instruction.op2.offset # 0) & ~IsMemoryOperand(instruction.op2,part) THEN
  1958. GetPartType(instruction.op2.type,part,type);
  1959. sizeInBits := type.sizeInBits;
  1960. Assembler.InitImm(imm,0,instruction.op2.offset);
  1961. emitter.Emit2(InstructionSet.opADD,left,imm);
  1962. END;
  1963. END;
  1964. ELSIF IntermediateCode.OperandEquals(instruction.op1,instruction.op2) & ((instruction.op1.mode # IntermediateCode.ModeMemory) OR (instruction.op3.mode # IntermediateCode.ModeMemory)) THEN
  1965. MakeOperand(instruction.op1,part,left,NIL);
  1966. ELSE
  1967. MakeOperand(instruction.op2,part, op2,NIL);
  1968. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
  1969. TicketToOperand(ticket,left);
  1970. Move(left, op2, type);
  1971. END;
  1972. END PrepareOp2;
  1973. PROCEDURE FinishOp(CONST vop: IntermediateCode.Operand; part: LONGINT; left: Assembler.Operand; ticket: Ticket);
  1974. VAR op1: Assembler.Operand;
  1975. BEGIN
  1976. IF ticket # NIL THEN
  1977. MakeOperand(vop,part, op1,NIL);
  1978. Move(op1,left,vop.type);
  1979. UnmapTicket(ticket);
  1980. END;
  1981. END FinishOp;
  1982. PROCEDURE EmitArithmetic3Part(CONST instruction: IntermediateCode.Instruction; part: LONGINT; opcode: LONGINT);
  1983. VAR left,right: Assembler.Operand; ticket: Ticket;
  1984. BEGIN
  1985. PrepareOp3(instruction, part, left,right,ticket);
  1986. emitter.Emit2(opcode,left,right);
  1987. FinishOp(instruction.op1,part,left,ticket);
  1988. END EmitArithmetic3Part;
  1989. PROCEDURE EmitArithmetic3(CONST instruction: IntermediateCode.Instruction; opcode: LONGINT);
  1990. BEGIN
  1991. EmitArithmetic3Part(instruction,Low,opcode);
  1992. IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, opcode) END;
  1993. END EmitArithmetic3;
  1994. PROCEDURE EmitArithmetic3XMM(CONST instruction: IntermediateCode.Instruction; op32, op64: LONGINT);
  1995. VAR op: LONGINT;
  1996. BEGIN
  1997. IF instruction.op1.type.sizeInBits = 32 THEN op := op32 ELSE op := op64 END;
  1998. EmitArithmetic3Part(instruction, Low, op);
  1999. END EmitArithmetic3XMM;
  2000. PROCEDURE EmitArithmetic2(CONST instruction: IntermediateCode.Instruction; part: LONGINT; opcode: LONGINT);
  2001. VAR left:Assembler.Operand;ticket: Ticket;
  2002. BEGIN
  2003. PrepareOp2(instruction,part,left,ticket);
  2004. emitter.Emit1(opcode,left);
  2005. FinishOp(instruction.op1,part,left,ticket);
  2006. END EmitArithmetic2;
  2007. PROCEDURE EmitArithmetic2XMM(CONST instruction: IntermediateCode.Instruction; op32, op64: LONGINT);
  2008. VAR op: LONGINT;
  2009. BEGIN
  2010. IF instruction.op1.type.sizeInBits = 32 THEN op := op32 ELSE op := op64 END;
  2011. EmitArithmetic2(instruction, Low, op);
  2012. END EmitArithmetic2XMM;
  2013. PROCEDURE EmitArithmetic3FPU(CONST instruction: IntermediateCode.Instruction; op: LONGINT);
  2014. VAR op1,op2,op3: Assembler.Operand;
  2015. BEGIN
  2016. MakeOperand(instruction.op2,Low,op2,NIL);
  2017. emitter.Emit1(InstructionSet.opFLD,op2);
  2018. INC(fpStackPointer);
  2019. MakeOperand(instruction.op3,Low,op3,NIL);
  2020. IF instruction.op3.mode = IntermediateCode.ModeRegister THEN
  2021. emitter.Emit2(op,opST0,op3);
  2022. ELSE
  2023. emitter.Emit1(op,op3);
  2024. END;
  2025. MakeOperand(instruction.op1,Low,op1,NIL);
  2026. emitter.Emit1(InstructionSet.opFSTP,op1);
  2027. DEC(fpStackPointer);
  2028. END EmitArithmetic3FPU;
  2029. PROCEDURE EmitArithmetic2FPU(CONST instruction: IntermediateCode.Instruction; opcode: LONGINT);
  2030. VAR op1,op2: Assembler.Operand;
  2031. BEGIN
  2032. MakeOperand(instruction.op2,Low,op2,NIL);
  2033. emitter.Emit1(InstructionSet.opFLD,op2);
  2034. INC(fpStackPointer);
  2035. emitter.Emit0(opcode);
  2036. MakeOperand(instruction.op1,Low,op1,NIL);
  2037. emitter.Emit1(InstructionSet.opFSTP,op1);
  2038. DEC(fpStackPointer);
  2039. END EmitArithmetic2FPU;
  2040. PROCEDURE EmitMul(CONST instruction: IntermediateCode.Instruction);
  2041. VAR op1,op2,op3,temp: Assembler.Operand; ra,rd: Ticket;
  2042. value: HUGEINT; exp: LONGINT; iop3: IntermediateCode.Operand;
  2043. inst: IntermediateCode.Instruction;
  2044. BEGIN
  2045. IF IntermediateCode.IsConstantInteger(instruction.op3,value) & IntermediateBackend.PowerOf2(value,exp) THEN
  2046. IntermediateCode.InitImmediate(iop3, IntermediateCode.uint32, exp);
  2047. IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.shl, instruction.op1, instruction.op2, iop3);
  2048. EmitShift(inst);
  2049. RETURN;
  2050. END;
  2051. ASSERT(~IsComplex(instruction.op1));
  2052. ASSERT(instruction.op1.type.form IN IntermediateCode.Integer);
  2053. IF (instruction.op1.type.sizeInBits = IntermediateCode.Bits8) THEN
  2054. Spill(physicalRegisters.Mapped(AL));
  2055. Spill(physicalRegisters.Mapped(AH));
  2056. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AL,inPC);
  2057. rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AH,inPC);
  2058. MakeOperand(instruction.op1,Low,op1,NIL);
  2059. MakeOperand(instruction.op2,Low,op2,ra);
  2060. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2061. MakeOperand(instruction.op3,Low,op3,rd);
  2062. ELSE
  2063. MakeOperand(instruction.op3,Low,op3,NIL);
  2064. END;
  2065. emitter.Emit1(InstructionSet.opIMUL,op3);
  2066. emitter.Emit2(InstructionSet.opMOV,op1,opAL);
  2067. UnmapTicket(ra);
  2068. UnmapTicket(rd);
  2069. ELSE
  2070. MakeOperand(instruction.op1,Low,op1,NIL);
  2071. MakeOperand(instruction.op2,Low,op2,NIL);
  2072. MakeOperand(instruction.op3,Low,op3,NIL);
  2073. IF ~Assembler.IsRegisterOperand(op1) THEN
  2074. temp := op1;
  2075. ra := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
  2076. TicketToOperand(ra,op1);
  2077. END;
  2078. IF Assembler.SameOperand(op1,op3) THEN temp := op2; op2 := op3; op3 := temp END;
  2079. IF Assembler.IsRegisterOperand(op2) OR Assembler.IsMemoryOperand(op2) THEN
  2080. IF Assembler.IsImmediateOperand(op3) THEN
  2081. emitter.Emit3(InstructionSet.opIMUL,op1,op2,op3);
  2082. ELSIF Assembler.IsRegisterOperand(op2) & (op2.register = op1.register) THEN
  2083. IF Assembler.IsRegisterOperand(op3) OR Assembler.IsMemoryOperand(op3) THEN
  2084. emitter.Emit2(InstructionSet.opIMUL,op1,op3);
  2085. ELSE
  2086. rd := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
  2087. TicketToOperand(rd,temp);
  2088. Move(temp,op3,instruction.op1.type);
  2089. emitter.Emit2(InstructionSet.opIMUL,op1,temp);
  2090. UnmapTicket(rd);
  2091. END;
  2092. ELSE
  2093. Move(op1,op3,PhysicalOperandType(op1));
  2094. emitter.Emit2(InstructionSet.opIMUL,op1,op2);
  2095. END
  2096. ELSIF Assembler.IsRegisterOperand(op3) OR Assembler.IsMemoryOperand(op3) THEN
  2097. IF Assembler.IsImmediateOperand(op2) THEN
  2098. emitter.Emit3(InstructionSet.opIMUL,op1,op3,op2);
  2099. ELSIF Assembler.IsRegisterOperand(op3) & (op2.register = op1.register) THEN
  2100. IF Assembler.IsRegisterOperand(op2) OR Assembler.IsMemoryOperand(op2) THEN
  2101. emitter.Emit2(InstructionSet.opIMUL,op1,op2);
  2102. ELSE
  2103. rd := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
  2104. TicketToOperand(rd,temp);
  2105. Move(temp,op2,instruction.op1.type);
  2106. emitter.Emit2(InstructionSet.opIMUL,op1,temp);
  2107. UnmapTicket(rd);
  2108. END;
  2109. ELSE
  2110. Move(op1,op2,PhysicalOperandType(op1));
  2111. emitter.Emit2(InstructionSet.opIMUL,op1,op3);
  2112. END;
  2113. END;
  2114. IF ra # NIL THEN
  2115. Move(temp,op1,PhysicalOperandType(op1));
  2116. UnmapTicket(ra);
  2117. END;
  2118. END;
  2119. END EmitMul;
  2120. PROCEDURE EmitDivMod(CONST instruction: IntermediateCode.Instruction);
  2121. VAR
  2122. dividend,quotient,remainder,imm,target,memop: Assembler.Operand;
  2123. op1,op2,op3: Assembler.Operand; ra,rd: Ticket;
  2124. size: LONGINT;
  2125. value: HUGEINT; exp: LONGINT; iop3: IntermediateCode.Operand;
  2126. inst: IntermediateCode.Instruction;
  2127. BEGIN
  2128. IF IntermediateCode.IsConstantInteger(instruction.op3,value) & IntermediateBackend.PowerOf2(value,exp) THEN
  2129. IF instruction.opcode = IntermediateCode.div THEN
  2130. IntermediateCode.InitImmediate(iop3, IntermediateCode.uint32, exp);
  2131. IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.shr, instruction.op1, instruction.op2, iop3);
  2132. EmitShift(inst);
  2133. RETURN;
  2134. ELSE
  2135. IntermediateCode.InitImmediate(iop3, instruction.op3.type, value-1);
  2136. IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.and, instruction.op1, instruction.op2, iop3);
  2137. EmitArithmetic3(inst,InstructionSet.opAND);
  2138. RETURN;
  2139. END;
  2140. END;
  2141. (*
  2142. In general it must obviously hold that
  2143. a = (a div b) * b + a mod b and
  2144. for all integers a,b#0, and c.
  2145. For positive numbers a and b this holds if
  2146. a div b = max{integer i: i*b <= b} = Entier(a/b)
  2147. and
  2148. a mod b = a-(a div b)*b = min{c >=0: c = a-i*b, integer i}
  2149. Example
  2150. 11 div 3 = 3 (3*3 = 9)
  2151. 11 mod 3 = 2 (=11-9)
  2152. for negative a there are two definitions for mod possible:
  2153. (i) mathematical definition with
  2154. a mod b >= 0:
  2155. a mod b = min{ c >=0: c = a-i*b, integer i} >= 0
  2156. this corresponds with rounding down
  2157. a div b = Entier(a/b) <= a/b
  2158. (ii) symmetric definition with
  2159. (-a) mod' b = -(a mod' b) and
  2160. (-a) div' b = -(a div' b)
  2161. corresponding with rounding to zero
  2162. a div' b = RoundToZero(a/b)
  2163. Examples
  2164. (i) -11 div 3 = -4 (3*(-4) = -12)
  2165. -11 mod 3 = 1 (=-11-(-12))
  2166. (ii) -11 div' 3 = -(11 div 3) = -3 (3*(-3)= -9)
  2167. -11 mod' 3 = -2 (=-11-(-9))
  2168. The behaviour for negative b can, in the symmetrical case, be deduced as
  2169. (ii) symmetric definition
  2170. a div' (-b) = (-a) div' b = -(a div' b)
  2171. a mod' (-b) = a- a div' (-b) * (-b) = a mod' b
  2172. In the mathematical case it is not so easy. It turns out that the definitions
  2173. a DIV b = Entier(a/b) = max{integer i: i*b <= b}
  2174. and
  2175. a MOD b = min { c >=0 : c = a-i*b, integer i} >= 0
  2176. are not compliant with
  2177. a = (a DIV b) * b + a MOD b
  2178. if b <= 0.
  2179. Proof: assume that b<0, then
  2180. a - Entier(a/b) * b >= 0
  2181. <=_> a >= Entier(a/b) * b
  2182. <=> Entier(a/b) >= a/b (contradiction to definition of Entier).
  2183. OBERON ADOPTS THE MATHEMATICAL DEFINITION !
  2184. For integers a and b (b>0) it holds that
  2185. a DIV b = Entier(a/b) <= a/b
  2186. a MOD b = min{ c >=0: c = b-i*a, integer i} = a - a DIV b * b
  2187. The behaviour for b < 0 is explicitely undefined.
  2188. *)
  2189. (*
  2190. AX / regMem8 = AL (remainder AH)
  2191. DX:AX / regmem16 = AX (remainder DX)
  2192. EDX:EAX / regmem32 = EAX (remainder EDX)
  2193. RDX:EAX / regmem64 = RAX (remainder RDX)
  2194. 1.) EAX <- source1
  2195. 2.) CDQ
  2196. 3.) IDIV source2
  2197. 3.) SHL EDX
  2198. 4.) SBB EAX,1
  2199. result is in EAX
  2200. *)
  2201. MakeOperand(instruction.op2,Low,op2,NIL);
  2202. CASE instruction.op1.type.sizeInBits OF
  2203. IntermediateCode.Bits8:
  2204. Spill(physicalRegisters.Mapped(AL)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AL,inPC);
  2205. emitter.Emit2(InstructionSet.opMOV,opAL,op2);
  2206. dividend := opAX;
  2207. quotient := opAL;
  2208. remainder := opAH;
  2209. emitter.Emit0(InstructionSet.opCBW);
  2210. | IntermediateCode.Bits16:
  2211. Spill(physicalRegisters.Mapped(AX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int16,AX,inPC);
  2212. emitter.Emit2(InstructionSet.opMOV,opAX,op2);
  2213. Spill(physicalRegisters.Mapped(DX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int16,DX,inPC);
  2214. dividend := opAX;
  2215. quotient := dividend;
  2216. remainder := opDX;
  2217. emitter.Emit0(InstructionSet.opCWD);
  2218. | IntermediateCode.Bits32:
  2219. Spill(physicalRegisters.Mapped(EAX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
  2220. emitter.Emit2(InstructionSet.opMOV,opEAX,op2);
  2221. Spill(physicalRegisters.Mapped(EDX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EDX,inPC);
  2222. dividend := opEAX;
  2223. quotient := dividend;
  2224. remainder := opEDX;
  2225. emitter.Emit0(InstructionSet.opCDQ);
  2226. | IntermediateCode.Bits64:
  2227. Spill(physicalRegisters.Mapped(RAX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int64,RAX,inPC);
  2228. emitter.Emit2(InstructionSet.opMOV,opRA,op2);
  2229. Spill(physicalRegisters.Mapped(RDX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int64,RDX,inPC);
  2230. dividend := opRA;
  2231. quotient := dividend;
  2232. remainder := registerOperands[RDX];
  2233. emitter.Emit0(InstructionSet.opCQO);
  2234. END;
  2235. (* registers might have been changed, so we make the operands now *)
  2236. MakeOperand(instruction.op1,Low,op1,NIL);
  2237. MakeOperand(instruction.op2,Low,op2,NIL);
  2238. MakeOperand(instruction.op3,Low,op3,NIL);
  2239. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2240. size := instruction.op3.type.sizeInBits DIV 8;
  2241. Basic.Align(size, cpuBits DIV 8 );
  2242. AllocateStack(size);
  2243. Assembler.InitMem(memop,SHORT(instruction.op3.type.sizeInBits DIV 8),SP,0);
  2244. emitter.Emit2(InstructionSet.opMOV,memop,op3);
  2245. op3 := memop;
  2246. END;
  2247. emitter.Emit1(InstructionSet.opIDIV,op3);
  2248. IF instruction.opcode = IntermediateCode.mod THEN
  2249. imm := Assembler.NewImm8 (0);
  2250. emitter.Emit2(InstructionSet.opCMP, remainder, imm);
  2251. Assembler.InitImm8(target,0);
  2252. emitter.Emit1(InstructionSet.opJGE, target);
  2253. emitter.Emit2( InstructionSet.opADD, remainder, op3);
  2254. emitter.code.PutByteAt(target.pc,(emitter.code.pc -target.pc )-1);
  2255. emitter.Emit2(InstructionSet.opMOV, op1, remainder);
  2256. ELSE
  2257. imm := Assembler.NewImm8 (1);
  2258. emitter.Emit2(InstructionSet.opSHL, remainder, imm);
  2259. imm := Assembler.NewImm8 (0);
  2260. emitter.Emit2(InstructionSet.opSBB, quotient, imm);
  2261. emitter.Emit2(InstructionSet.opMOV, op1, quotient);
  2262. END;
  2263. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2264. size := instruction.op3.type.sizeInBits DIV 8;
  2265. Basic.Align(size, cpuBits DIV 8 );
  2266. AllocateStack(-size);
  2267. END;
  2268. END EmitDivMod;
  2269. PROCEDURE EmitShift(CONST instruction: IntermediateCode.Instruction);
  2270. VAR
  2271. shift: Assembler.Operand;
  2272. op: LONGINT;
  2273. op1,op2,op3,dest,temporary,op1High,op2High: Assembler.Operand;
  2274. index: SHORTINT; temp: Assembler.Operand;
  2275. left: BOOLEAN;
  2276. ecx,ticket: Ticket;
  2277. BEGIN
  2278. Assert(instruction.op1.type.form IN IntermediateCode.Integer,"must be integer operand");
  2279. IF instruction.op1.type.form = IntermediateCode.UnsignedInteger THEN
  2280. IF instruction.opcode = IntermediateCode.shr THEN op := InstructionSet.opSHR; left := FALSE;
  2281. ELSIF instruction.opcode = IntermediateCode.shl THEN op := InstructionSet.opSHL; left := TRUE;
  2282. ELSIF instruction.opcode = IntermediateCode.ror THEN op := InstructionSet.opROR; left := FALSE;
  2283. ELSIF instruction.opcode = IntermediateCode.rol THEN op := InstructionSet.opROL; left := TRUE;
  2284. END;
  2285. ELSE
  2286. IF instruction.opcode = IntermediateCode.shr THEN op := InstructionSet.opSAR; left := FALSE;
  2287. ELSIF instruction.opcode = IntermediateCode.shl THEN op := InstructionSet.opSAL; left := TRUE;
  2288. ELSIF instruction.opcode = IntermediateCode.ror THEN op := InstructionSet.opROR; left := FALSE;
  2289. ELSIF instruction.opcode = IntermediateCode.rol THEN op := InstructionSet.opROL; left := TRUE;
  2290. END;
  2291. END;
  2292. IF instruction.op3.mode # IntermediateCode.ModeImmediate THEN
  2293. IF backend.cooperative THEN ap.spillable := TRUE END;
  2294. Spill(physicalRegisters.Mapped(ECX));
  2295. ecx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,ECX,inPC);
  2296. END;
  2297. (*GetTemporaryRegister(instruction.op2.type,dest);*)
  2298. MakeOperand(instruction.op1,Low,op1,NIL);
  2299. IF ~Assembler.IsRegisterOperand(op1) THEN GetTemporaryRegister(instruction.op2.type,dest) ELSE dest := op1 END;
  2300. MakeOperand(instruction.op2,Low,op2,NIL);
  2301. MakeOperand(instruction.op3,Low,op3,NIL);
  2302. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2303. Assembler.InitImm8(shift,instruction.op3.intValue);
  2304. ELSE
  2305. CASE instruction.op3.type.sizeInBits OF
  2306. IntermediateCode.Bits8: index := CL;
  2307. |IntermediateCode.Bits16: index := CX;
  2308. |IntermediateCode.Bits32: index := ECX;
  2309. |IntermediateCode.Bits64: index := RCX;
  2310. END;
  2311. (*
  2312. IF (physicalRegisters.toVirtual[index] # free) & ((physicalRegisters.toVirtual[index] # instruction.op1.register) OR (instruction.op1.mode # IntermediateCode.ModeRegister)) THEN
  2313. Spill();
  2314. (*
  2315. emitter.Emit1(InstructionSet.opPUSH,opECX);
  2316. ecxPushed := TRUE;
  2317. *)
  2318. END;
  2319. *)
  2320. ticket := virtualRegisters.Mapped(instruction.op3.register,Low);
  2321. IF (instruction.op3.mode # IntermediateCode.ModeRegister) OR (ticket = NIL) OR (ticket.spilled) OR (ticket.register # index) THEN
  2322. emitter.Emit2(InstructionSet.opMOV,registerOperands[index],op3);
  2323. END;
  2324. shift := opCL;
  2325. END;
  2326. IF ~IsComplex(instruction.op1) THEN
  2327. Move(dest,op2,PhysicalOperandType(dest));
  2328. emitter.Emit2 (op, dest,shift);
  2329. Move(op1,dest,PhysicalOperandType(op1));
  2330. ELSIF left THEN
  2331. MakeOperand(instruction.op1,High,op1High,NIL);
  2332. MakeOperand(instruction.op2,High,op2High,NIL);
  2333. IF ~IntermediateCode.OperandEquals(instruction.op1,instruction.op2) THEN
  2334. Move(op1,op2,PhysicalOperandType(op1));
  2335. Move(op1High,op2High,PhysicalOperandType(op1High))
  2336. END;
  2337. IF (instruction.opcode=IntermediateCode.rol) THEN
  2338. (* |high| <- |low| <- |temp=high| *)
  2339. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  2340. TicketToOperand(ticket,temp);
  2341. emitter.Emit2( InstructionSet.opMOV, temp, op1High);
  2342. emitter.Emit3( InstructionSet.opSHLD,op1High, op1, shift);
  2343. emitter.Emit3( InstructionSet.opSHLD, op1, temp, shift);
  2344. UnmapTicket(ticket);
  2345. ELSE
  2346. (* |high| <- |low| *)
  2347. emitter.Emit3( InstructionSet.opSHLD, op1,op1High,shift);
  2348. emitter.Emit2( op, op1,shift);
  2349. END;
  2350. ELSE
  2351. IF ~IntermediateCode.OperandEquals(instruction.op1,instruction.op2) THEN
  2352. Move(op1,op2,PhysicalOperandType(op1))
  2353. END;
  2354. IF instruction.opcode=IntermediateCode.ror THEN
  2355. (* |temp=low| -> |high| -> |low| *)
  2356. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  2357. TicketToOperand(ticket,temp);
  2358. emitter.Emit2( InstructionSet.opMOV, temporary, op1);
  2359. emitter.Emit3( InstructionSet.opSHRD,op1, op1High, shift);
  2360. emitter.Emit3( InstructionSet.opSHRD, op1High, temporary, shift);
  2361. UnmapTicket(ticket);
  2362. ELSE
  2363. (* |high| -> |low| *)
  2364. emitter.Emit3( InstructionSet.opSHRD, op1,op1High,shift);
  2365. emitter.Emit2( op, op1High, shift);
  2366. END;
  2367. END;
  2368. IF backend.cooperative & (instruction.op3.mode # IntermediateCode.ModeImmediate) THEN
  2369. UnmapTicket(ecx);
  2370. UnSpill(ap);
  2371. ap.spillable := FALSE;
  2372. END;
  2373. END EmitShift;
  2374. PROCEDURE EmitCas(CONST instruction: IntermediateCode.Instruction);
  2375. VAR ra: Ticket; op1,op2,op3,mem: Assembler.Operand; register: LONGINT;
  2376. BEGIN
  2377. CASE instruction.op2.type.sizeInBits OF
  2378. | IntermediateCode.Bits8: register := AL;
  2379. | IntermediateCode.Bits16: register := AX;
  2380. | IntermediateCode.Bits32: register := EAX;
  2381. | IntermediateCode.Bits64: register := RAX;
  2382. END;
  2383. Spill(physicalRegisters.Mapped(register));
  2384. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op2.type,register,inPC);
  2385. IF IntermediateCode.OperandEquals (instruction.op2,instruction.op3) THEN
  2386. MakeRegister(instruction.op1,Low,op1(*,ra*));
  2387. Assembler.InitMem(mem,SHORT(instruction.op2.type.sizeInBits DIV 8),op1.register,0);
  2388. TicketToOperand(ra, op2);
  2389. emitter.Emit2(InstructionSet.opMOV,op2,mem);
  2390. ELSE
  2391. MakeOperand(instruction.op2,Low,op2,ra);
  2392. MakeRegister(instruction.op1,Low,op1);
  2393. Assembler.InitMem(mem,SHORT(instruction.op2.type.sizeInBits DIV 8),op1.register,0);
  2394. MakeRegister(instruction.op3,Low,op3);
  2395. emitter.EmitPrefix (InstructionSet.prfLOCK);
  2396. emitter.Emit2(InstructionSet.opCMPXCHG,mem,op3);
  2397. END;
  2398. END EmitCas;
  2399. PROCEDURE EmitCopy(CONST instruction: IntermediateCode.Instruction);
  2400. VAR op1,op2,op3: Assembler.Operand; rs, rd, rc, t: Ticket; temp,imm: Assembler.Operand; source, dest: IntermediateCode.Operand; size: HUGEINT;type: IntermediateCode.Type;
  2401. BEGIN
  2402. IF IntermediateCode.IsConstantInteger(instruction.op3, size) & ((size=8) OR (size = 4) OR (size = 2) OR (size=1)) & (size * 8 <= cpuBits) THEN
  2403. MakeRegister(instruction.op1,Low,op1);
  2404. Assembler.InitMem(op1,SHORTINT(size),op1.register,0);
  2405. MakeRegister(instruction.op2,Low,op2);
  2406. Assembler.InitMem(op2,SHORTINT(size),op2.register,0);
  2407. type := IntermediateCode.NewType(IntermediateCode.SignedInteger, SHORTINT(size*8));
  2408. rd := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, type);
  2409. TicketToOperand(rd,op3);
  2410. Move(op3, op2, type);
  2411. Move(op1, op3, type);
  2412. ELSE
  2413. Spill(physicalRegisters.Mapped(RS));
  2414. Spill(physicalRegisters.Mapped(RD));
  2415. IF backend.cooperative THEN ap.spillable := TRUE END;
  2416. Spill(physicalRegisters.Mapped(RC));
  2417. rs := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RS,inPC);
  2418. rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RD,inPC);
  2419. rc := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RC,inPC);
  2420. MakeOperand(instruction.op1,Low,op1,rd);
  2421. MakeOperand(instruction.op2,Low,op2,rs);
  2422. IF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) & IntermediateCode.IsConstantInteger(instruction.op3, size) & (size >= 4096) THEN
  2423. (* special case on stack: copy downwards for possible stack allocation *)
  2424. IF size MOD 4 # 0 THEN
  2425. imm := Assembler.NewImm32(size-1);
  2426. emitter.Emit2(InstructionSet.opADD, opRDI, imm);
  2427. emitter.Emit2(InstructionSet.opADD, opRSI, imm);
  2428. imm := Assembler.NewImm32(size MOD 4);
  2429. emitter.Emit2(InstructionSet.opMOV, opRC, imm);
  2430. emitter.Emit0(InstructionSet.opSTD); (* copy down *)
  2431. emitter.EmitPrefix (InstructionSet.prfREP);
  2432. emitter.Emit0(InstructionSet.opMOVSB);
  2433. imm := Assembler.NewImm32(size DIV 4);
  2434. emitter.Emit2(InstructionSet.opMOV, opRC, imm);
  2435. emitter.EmitPrefix (InstructionSet.prfREP);
  2436. emitter.Emit0(InstructionSet.opMOVSD);
  2437. ELSE
  2438. imm := Assembler.NewImm32(size-4);
  2439. emitter.Emit2(InstructionSet.opADD, opRDI, imm);
  2440. emitter.Emit2(InstructionSet.opADD, opRSI, imm);
  2441. imm := Assembler.NewImm32(size DIV 4);
  2442. emitter.Emit2(InstructionSet.opMOV, opRC, imm);
  2443. emitter.Emit0(InstructionSet.opSTD); (* copy down *)
  2444. emitter.EmitPrefix (InstructionSet.prfREP);
  2445. emitter.Emit0(InstructionSet.opMOVSD);
  2446. END
  2447. ELSIF IntermediateCode.IsConstantInteger(instruction.op3, size) THEN
  2448. imm := Assembler.NewImm32(size DIV 4);
  2449. emitter.Emit2(InstructionSet.opMOV, opRC, imm);
  2450. emitter.Emit0(InstructionSet.opCLD); (* copy upwards *)
  2451. emitter.EmitPrefix (InstructionSet.prfREP);
  2452. emitter.Emit0(InstructionSet.opMOVSD);
  2453. IF size MOD 4 # 0 THEN
  2454. imm := Assembler.NewImm32(size MOD 4);
  2455. emitter.Emit2(InstructionSet.opMOV, opRC, imm);
  2456. emitter.EmitPrefix (InstructionSet.prfREP);
  2457. emitter.Emit0(InstructionSet.opMOVSB);
  2458. END;
  2459. (* this does not work in the kernel -- for whatever reasons *)
  2460. ELSIF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) THEN
  2461. MakeOperand(instruction.op3,Low,op3,rc);
  2462. t := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, instruction.op1.type);
  2463. TicketToOperand(t, temp);
  2464. emitter.Emit2(InstructionSet.opADD, opRSI, opRC);
  2465. emitter.Emit2(InstructionSet.opADD, opRDI, opRC);
  2466. imm := Assembler.NewImm8(1);
  2467. emitter.Emit2(InstructionSet.opSUB, opRSI, imm);
  2468. emitter.Emit2(InstructionSet.opSUB, opRDI, imm);
  2469. emitter.Emit2(InstructionSet.opMOV, temp, opRC);
  2470. imm := Assembler.NewImm8(3);
  2471. emitter.Emit2(InstructionSet.opAND, opRC, imm);
  2472. emitter.Emit0(InstructionSet.opSTD); (* copy downwards *)
  2473. emitter.EmitPrefix (InstructionSet.prfREP);
  2474. emitter.Emit0(InstructionSet.opMOVSB);
  2475. imm := Assembler.NewImm8(2);
  2476. emitter.Emit2(InstructionSet.opMOV, opRC, temp);
  2477. emitter.Emit2(InstructionSet.opSHR, opRC, imm);
  2478. imm := Assembler.NewImm8(3);
  2479. emitter.Emit2(InstructionSet.opSUB, opRSI, imm);
  2480. emitter.Emit2(InstructionSet.opSUB, opRDI, imm);
  2481. emitter.EmitPrefix (InstructionSet.prfREP);
  2482. emitter.Emit0(InstructionSet.opMOVSD);
  2483. emitter.Emit0(InstructionSet.opCLD);
  2484. ELSE
  2485. MakeOperand(instruction.op3,Low,op3,rc);
  2486. t := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, instruction.op1.type);
  2487. TicketToOperand(t, temp);
  2488. emitter.Emit2(InstructionSet.opMOV, temp, opRC);
  2489. imm := Assembler.NewImm8(3);
  2490. emitter.Emit2(InstructionSet.opAND, temp, imm);
  2491. imm := Assembler.NewImm8(2);
  2492. emitter.Emit2(InstructionSet.opSHR, opRC, imm);
  2493. emitter.Emit0(InstructionSet.opCLD); (* copy upwards *)
  2494. emitter.EmitPrefix (InstructionSet.prfREP);
  2495. emitter.Emit0(InstructionSet.opMOVSD);
  2496. emitter.Emit2(InstructionSet.opMOV, opRC, temp);
  2497. emitter.EmitPrefix (InstructionSet.prfREP);
  2498. emitter.Emit0(InstructionSet.opMOVSB);
  2499. END;
  2500. UnmapTicket(rs);
  2501. UnmapTicket(rd);
  2502. UnmapTicket(rc);
  2503. IF backend.cooperative THEN
  2504. UnSpill(ap);
  2505. ap.spillable := FALSE;
  2506. END;
  2507. END;
  2508. END EmitCopy;
  2509. PROCEDURE EmitFill(CONST instruction: IntermediateCode.Instruction; down: BOOLEAN);
  2510. VAR reg,sizeInBits,i: LONGINT;val, value, size, dest: Assembler.Operand;
  2511. op: LONGINT;
  2512. rd, rc: Ticket;
  2513. BEGIN
  2514. IF FALSE & (instruction.op2.mode = IntermediateCode.ModeImmediate) & (instruction.op2.symbol.name = "") & (instruction.op2.intValue < 5) THEN
  2515. sizeInBits := instruction.op3.type.sizeInBits;
  2516. IF sizeInBits = IntermediateCode.Bits8 THEN value := opAL;
  2517. ELSIF sizeInBits = IntermediateCode.Bits16 THEN value := opAX;
  2518. ELSIF sizeInBits = IntermediateCode.Bits32 THEN value := opEAX;
  2519. ELSE HALT(200)
  2520. END;
  2521. MakeOperand(instruction.op1,Low,dest,NIL);
  2522. IF instruction.op1.mode = IntermediateCode.ModeRegister THEN reg := dest.register
  2523. ELSE emitter.Emit2(InstructionSet.opMOV,opEDX,dest); reg := EDX;
  2524. END;
  2525. IF (instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.type.form IN IntermediateCode.Integer) & (instruction.op3.intValue = 0) THEN
  2526. emitter.Emit2(InstructionSet.opXOR,opEAX,opEAX);
  2527. ELSE
  2528. MakeOperand(instruction.op3,Low,value,NIL);
  2529. END;
  2530. FOR i := 0 TO SHORT(instruction.op2.intValue)-1 DO
  2531. IF down THEN
  2532. Assembler.InitMem(dest,SHORT(SHORT(sizeInBits DIV 8)),reg,-i*sizeInBits DIV 8);
  2533. ELSE
  2534. Assembler.InitMem(dest,SHORT(SHORT(sizeInBits DIV 8 )),reg,i*sizeInBits DIV 8);
  2535. END;
  2536. emitter.Emit2(InstructionSet.opMOV,dest,value);
  2537. END;
  2538. ELSE
  2539. Spill(physicalRegisters.Mapped(RD));
  2540. IF backend.cooperative THEN ap.spillable := TRUE END;
  2541. Spill(physicalRegisters.Mapped(RC));
  2542. rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RD,inPC);
  2543. rc := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RC,inPC);
  2544. MakeOperand(instruction.op1,Low,dest,rd);
  2545. MakeOperand(instruction.op2,Low,size,rc);
  2546. MakeOperand(instruction.op3,Low,value,NIL);
  2547. (*
  2548. emitter.Emit2(InstructionSet.opMOV,opRDI, op1[Low]);
  2549. emitter.Emit2(InstructionSet.opMOV,opRC, op3[Low]);
  2550. *)
  2551. CASE instruction.op3.type.sizeInBits OF
  2552. IntermediateCode.Bits8: val := opAL; op := InstructionSet.opSTOSB;
  2553. |IntermediateCode.Bits16: val := opAX; op := InstructionSet.opSTOSW;
  2554. |IntermediateCode.Bits32: val := opEAX; op := InstructionSet.opSTOSD;
  2555. ELSE Halt("only supported for upto 32 bit integers ");
  2556. END;
  2557. IF (instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.type.form IN IntermediateCode.Integer) & (instruction.op3.intValue = 0) THEN
  2558. emitter.Emit2(InstructionSet.opXOR,opEAX,opEAX);
  2559. ELSE
  2560. emitter.Emit2(InstructionSet.opMOV,val,value);
  2561. END;
  2562. IF down THEN
  2563. emitter.Emit0(InstructionSet.opSTD); (* fill downwards *)
  2564. ELSE
  2565. emitter.Emit0(InstructionSet.opCLD); (* fill upwards *)
  2566. END;
  2567. emitter.EmitPrefix (InstructionSet.prfREP);
  2568. emitter.Emit0(op);
  2569. IF down THEN (* needed as calls to windows crash otherwise *)
  2570. emitter.Emit0(InstructionSet.opCLD);
  2571. END;
  2572. UnmapTicket(rc);
  2573. IF backend.cooperative THEN
  2574. UnSpill(ap);
  2575. ap.spillable := FALSE;
  2576. END;
  2577. END;
  2578. END EmitFill;
  2579. PROCEDURE EmitBr (CONST instruction: IntermediateCode.Instruction);
  2580. VAR dest,destPC,offset: LONGINT; target: Assembler.Operand;hit,fail: LONGINT; reverse: BOOLEAN;
  2581. (* jump operands *) left,right,temp: Assembler.Operand;
  2582. failOp: Assembler.Operand; failPC: LONGINT;
  2583. PROCEDURE JmpDest(brop: LONGINT);
  2584. BEGIN
  2585. IF instruction.op1.mode = IntermediateCode.ModeImmediate THEN
  2586. IF instruction.op1.symbol.name = in.name THEN
  2587. dest := (instruction.op1.symbolOffset); (* this is the offset in the in-data section (intermediate code), it is not byte- *)
  2588. destPC := (in.instructions[dest].pc );
  2589. offset := destPC - (out.pc );
  2590. IF dest > inPC THEN (* forward jump *)
  2591. Assembler.InitOffset32(target,0);
  2592. Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.symbolOffset,instruction.op1.offset);
  2593. emitter.Emit1(brop,target);
  2594. ELSIF ABS(offset) <= 126 THEN
  2595. Assembler.InitOffset8(target,destPC);
  2596. emitter.Emit1(brop,target);
  2597. ELSE
  2598. Assembler.InitOffset32(target,destPC);
  2599. emitter.Emit1(brop,target);
  2600. END;
  2601. ELSIF cpuBits = 64 THEN
  2602. MakeOperand(instruction.op1,Low,target,NIL);
  2603. emitter.Emit1(brop,target);
  2604. ELSE
  2605. Assembler.InitOffset32(target,instruction.op1.intValue);
  2606. Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.symbolOffset,instruction.op1.offset);
  2607. emitter.Emit1(brop,target);
  2608. END;
  2609. ELSE
  2610. MakeOperand(instruction.op1,Low,target,NIL);
  2611. emitter.Emit1(brop,target);
  2612. END;
  2613. END JmpDest;
  2614. PROCEDURE CmpFloat;
  2615. BEGIN
  2616. IF backend.forceFPU THEN
  2617. MakeOperand(instruction.op2,Low,left,NIL);
  2618. emitter.Emit1(InstructionSet.opFLD,left); INC(fpStackPointer);
  2619. MakeOperand(instruction.op3,Low,right,NIL);
  2620. emitter.Emit1(InstructionSet.opFCOMP,right); DEC(fpStackPointer);
  2621. emitter.Emit1(InstructionSet.opFNSTSW,opAX);
  2622. emitter.Emit0(InstructionSet.opSAHF);
  2623. ELSE
  2624. MakeRegister(instruction.op2,Low,left);
  2625. MakeOperand(instruction.op3,Low,right,NIL);
  2626. IF instruction.op2.type.sizeInBits = 32 THEN
  2627. emitter.Emit2(InstructionSet.opCOMISS, left, right);
  2628. ELSE
  2629. emitter.Emit2(InstructionSet.opCOMISD, left, right);
  2630. END
  2631. END;
  2632. END CmpFloat;
  2633. PROCEDURE Cmp(part: LONGINT; VAR reverse: BOOLEAN);
  2634. VAR type: IntermediateCode.Type; left,right: Assembler.Operand;
  2635. BEGIN
  2636. IF (instruction.op2.mode = IntermediateCode.ModeImmediate) & (instruction.op3.mode = IntermediateCode.ModeImmediate) THEN
  2637. reverse := FALSE;
  2638. GetPartType(instruction.op2.type,part,type);
  2639. GetTemporaryRegister(type,temp);
  2640. MakeOperand(instruction.op2,part,left,NIL);
  2641. MakeOperand(instruction.op3,part,right,NIL);
  2642. Move(temp,left, type);
  2643. left := temp;
  2644. ELSIF instruction.op2.mode = IntermediateCode.ModeImmediate THEN
  2645. reverse := TRUE;
  2646. MakeOperand(instruction.op2,part,right,NIL);
  2647. MakeOperand(instruction.op3,part,left,NIL);
  2648. ELSIF IsMemoryOperand(instruction.op2,part) & IsMemoryOperand(instruction.op3,part) THEN
  2649. reverse := FALSE;
  2650. GetPartType(instruction.op2.type,part,type);
  2651. GetTemporaryRegister(type,temp);
  2652. MakeOperand(instruction.op2,part,left,NIL);
  2653. MakeOperand(instruction.op3,part,right,NIL);
  2654. Move(temp,right,type);
  2655. right := temp;
  2656. ELSE
  2657. reverse := FALSE;
  2658. MakeOperand(instruction.op2,part,left,NIL);
  2659. MakeOperand(instruction.op3,part,right,NIL);
  2660. END;
  2661. emitter.Emit2(InstructionSet.opCMP,left,right);
  2662. END Cmp;
  2663. BEGIN
  2664. IF (instruction.op1.symbol.name = in.name) & (instruction.op1.symbolOffset = inPC +1) THEN (* jump to next instruction can be ignored *)
  2665. IF dump # NIL THEN dump.String("jump to next instruction ignored"); dump.Ln END;
  2666. RETURN
  2667. END;
  2668. failPC := 0;
  2669. IF instruction.opcode = IntermediateCode.br THEN
  2670. hit := InstructionSet.opJMP
  2671. ELSIF instruction.op2.type.form = IntermediateCode.Float THEN
  2672. CmpFloat;
  2673. CASE instruction.opcode OF
  2674. IntermediateCode.breq: hit := InstructionSet.opJE;
  2675. |IntermediateCode.brne:hit := InstructionSet.opJNE;
  2676. |IntermediateCode.brge: hit := InstructionSet.opJAE
  2677. |IntermediateCode.brlt: hit := InstructionSet.opJB
  2678. END;
  2679. ELSE
  2680. IF ~IsComplex(instruction.op2) THEN
  2681. Cmp(Low,reverse);
  2682. CASE instruction.opcode OF
  2683. IntermediateCode.breq: hit := InstructionSet.opJE;
  2684. |IntermediateCode.brne: hit := InstructionSet.opJNE;
  2685. |IntermediateCode.brge:
  2686. IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
  2687. IF reverse THEN hit := InstructionSet.opJLE ELSE hit := InstructionSet.opJGE END;
  2688. ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2689. IF reverse THEN hit := InstructionSet.opJBE ELSE hit := InstructionSet.opJAE END;
  2690. END;
  2691. |IntermediateCode.brlt:
  2692. IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
  2693. IF reverse THEN hit := InstructionSet.opJG ELSE hit := InstructionSet.opJL END;
  2694. ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2695. IF reverse THEN hit := InstructionSet.opJA ELSE hit := InstructionSet.opJB END;
  2696. END;
  2697. END;
  2698. ELSE
  2699. Cmp(High,reverse);
  2700. CASE instruction.opcode OF
  2701. IntermediateCode.breq: hit := 0; fail := InstructionSet.opJNE;
  2702. |IntermediateCode.brne: hit := InstructionSet.opJNE; fail := 0;
  2703. |IntermediateCode.brge:
  2704. IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
  2705. IF reverse THEN hit := InstructionSet.opJL; fail := InstructionSet.opJG ELSE hit := InstructionSet.opJG; fail := InstructionSet.opJL END;
  2706. ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2707. IF reverse THEN hit := InstructionSet.opJB; fail := InstructionSet.opJA ELSE hit := InstructionSet.opJA; fail := InstructionSet.opJB END;
  2708. END;
  2709. |IntermediateCode.brlt:
  2710. IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
  2711. IF reverse THEN hit := InstructionSet.opJG; fail := InstructionSet.opJL ELSE hit := InstructionSet.opJL; fail := InstructionSet.opJG END;
  2712. ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2713. IF reverse THEN hit := InstructionSet.opJA; fail := InstructionSet.opJB ELSE hit := InstructionSet.opJB; fail := InstructionSet.opJA END;
  2714. END;
  2715. END;
  2716. IF hit # 0 THEN JmpDest(hit) END;
  2717. IF fail # 0 THEN
  2718. failPC := out.pc; (* to avoid potential value overflow problem, will be patched anyway *)
  2719. Assembler.InitOffset8(failOp,failPC );
  2720. emitter.Emit1(fail,failOp);
  2721. failPC := failOp.pc;
  2722. END;
  2723. Cmp(Low,reverse);
  2724. CASE instruction.opcode OF
  2725. IntermediateCode.breq: hit := InstructionSet.opJE
  2726. |IntermediateCode.brne: hit := InstructionSet.opJNE
  2727. |IntermediateCode.brge:
  2728. IF reverse THEN hit := InstructionSet.opJBE ELSE hit := InstructionSet.opJAE END;
  2729. |IntermediateCode.brlt:
  2730. IF reverse THEN hit := InstructionSet.opJA ELSE hit := InstructionSet.opJB END;
  2731. END;
  2732. END;
  2733. END;
  2734. JmpDest(hit);
  2735. IF failPC > 0 THEN out.PutByteAt(failPC,(out.pc-failPC)-1); END;
  2736. END EmitBr;
  2737. PROCEDURE EmitPush(CONST vop: IntermediateCode.Operand; part: LONGINT);
  2738. VAR index: LONGINT; type,cpuType: IntermediateCode.Type; op1: Assembler.Operand; ra: Ticket;
  2739. BEGIN
  2740. GetPartType(vop.type,part,type);
  2741. ASSERT(type.form IN IntermediateCode.Integer);
  2742. IF vop.mode = IntermediateCode.ModeImmediate THEN (* may not push 16 bit immediate: strange instruction in 32 / 64 bit mode *)
  2743. GetImmediate(vop,part,op1,TRUE);
  2744. emitter.Emit1(InstructionSet.opPUSH,op1);
  2745. ELSIF (type.sizeInBits = cpuBits) THEN
  2746. MakeOperand(vop,part,op1,NIL);
  2747. emitter.Emit1(InstructionSet.opPUSH,op1);
  2748. ELSE
  2749. ASSERT(type.sizeInBits < cpuBits);
  2750. MakeOperand(vop,part,op1,NIL);
  2751. IF Assembler.IsRegisterOperand(op1) & ~((cpuBits=32) & (type.sizeInBits=8) & (op1.register >= AH)) THEN
  2752. index := op1.register MOD 32 + opRA.register;
  2753. emitter.Emit1(InstructionSet.opPUSH, registerOperands[index]);
  2754. ELSE
  2755. WHILE physicalRegisters.Mapped(opRA.register) # free DO Spill(physicalRegisters.Mapped(opRA.register)) END;
  2756. IntermediateCode.InitType(cpuType,IntermediateCode.SignedInteger,SHORT(cpuBits));
  2757. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,cpuType,opRA.register,inPC);
  2758. CASE type.sizeInBits OF
  2759. 8: index := AL
  2760. |16: index := AX
  2761. |32: index := EAX
  2762. |64: index := RAX
  2763. END;
  2764. emitter.Emit2(InstructionSet.opMOV,registerOperands[index],op1);
  2765. emitter.Emit1(InstructionSet.opPUSH,opRA);
  2766. UnmapTicket(ra);
  2767. END;
  2768. END;
  2769. END EmitPush;
  2770. PROCEDURE EmitPop(CONST vop: IntermediateCode.Operand; part: LONGINT);
  2771. VAR index: LONGINT; type,cpuType: IntermediateCode.Type; op1: Assembler.Operand; ra: Ticket;
  2772. BEGIN
  2773. GetPartType(vop.type,part,type);
  2774. ASSERT(type.form IN IntermediateCode.Integer);
  2775. IF (type.sizeInBits = cpuBits) THEN
  2776. MakeOperand(vop,part,op1,NIL);
  2777. emitter.Emit1(InstructionSet.opPOP,op1);
  2778. ELSE
  2779. ASSERT(type.sizeInBits < cpuBits);
  2780. MakeOperand(vop,part,op1,NIL);
  2781. IF Assembler.IsRegisterOperand(op1) & ~((cpuBits=32) & (type.sizeInBits=8) & (op1.register >= AH)) THEN
  2782. index := op1.register MOD 32 + opRA.register;
  2783. emitter.Emit1(InstructionSet.opPOP, registerOperands[index]);
  2784. ELSE
  2785. WHILE physicalRegisters.Mapped(opRA.register) # free DO Spill(physicalRegisters.Mapped(opRA.register)) END;
  2786. IntermediateCode.InitType(cpuType, IntermediateCode.SignedInteger, SHORT(cpuBits));
  2787. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,cpuType,opRA.register,inPC);
  2788. emitter.Emit1(InstructionSet.opPOP,opRA);
  2789. CASE type.sizeInBits OF
  2790. 8: index := AL
  2791. |16: index := AX
  2792. |32: index := EAX
  2793. |64: index := RAX
  2794. END;
  2795. emitter.Emit2(InstructionSet.opMOV, op1, registerOperands[index]);
  2796. UnmapTicket(ra);
  2797. END;
  2798. END;
  2799. END EmitPop;
  2800. PROCEDURE EmitPushFloat(CONST vop: IntermediateCode.Operand);
  2801. VAR sizeInBytes,length: LONGINT; memop: Assembler.Operand; op: Assembler.Operand;
  2802. BEGIN
  2803. MakeOperand(vop,Low,op,NIL);
  2804. length := vop.type.length;
  2805. IF (vop.mode = IntermediateCode.ModeMemory) & (vop.type.sizeInBits*length =cpuBits) THEN
  2806. emitter.Emit1(InstructionSet.opPUSH,op);
  2807. ELSE
  2808. sizeInBytes := vop.type.sizeInBits DIV 8;
  2809. length := vop.type.length;
  2810. IF sizeInBytes * length * 8 < cpuBits THEN
  2811. AllocateStack(cpuBits DIV 8);
  2812. ELSE
  2813. AllocateStack(sizeInBytes*length);
  2814. END;
  2815. Assembler.InitMem(memop, SHORTINT(sizeInBytes*length),SP,0);
  2816. IF backend.forceFPU THEN
  2817. emitter.Emit1(InstructionSet.opFLD,op); INC(fpStackPointer);
  2818. emitter.Emit1(InstructionSet.opFSTP,memop); DEC(fpStackPointer);
  2819. ELSE
  2820. Move(memop, op, vop.type)
  2821. END
  2822. END;
  2823. END EmitPushFloat;
  2824. PROCEDURE EmitPopFloat(CONST vop: IntermediateCode.Operand);
  2825. VAR sizeInBytes,length: LONGINT; memop: Assembler.Operand; op: Assembler.Operand;
  2826. BEGIN
  2827. sizeInBytes := vop.type.sizeInBits DIV 8;
  2828. length := vop.type.length;
  2829. IF (vop.mode = IntermediateCode.ModeMemory) & (vop.type.sizeInBits*length =cpuBits) THEN
  2830. MakeOperand(vop,Low,op,NIL);
  2831. emitter.Emit1(InstructionSet.opPOP,op);
  2832. ELSE
  2833. Assembler.InitMem(memop, SHORTINT(sizeInBytes*length),SP,0);
  2834. IF backend.forceFPU THEN
  2835. emitter.Emit1(InstructionSet.opFLD,memop);
  2836. INC(fpStackPointer);
  2837. MakeOperand(vop,Low,op,NIL);
  2838. emitter.Emit1(InstructionSet.opFSTP,op);
  2839. DEC(fpStackPointer);
  2840. ASSERT(sizeInBytes > 0);
  2841. ELSE
  2842. MakeOperand(vop,Low,op,NIL);
  2843. Move(op, memop, vop.type)
  2844. END;
  2845. IF sizeInBytes * length * 8 < cpuBits THEN
  2846. AllocateStack(-cpuBits DIV 8);
  2847. ELSE
  2848. AllocateStack(-sizeInBytes*length);
  2849. END;
  2850. END;
  2851. END EmitPopFloat;
  2852. PROCEDURE EmitNeg(CONST instruction: IntermediateCode.Instruction);
  2853. VAR opLow,opHigh: Assembler.Operand; minusOne: Assembler.Operand; ticketLow,ticketHigh: Ticket;
  2854. BEGIN
  2855. IF IsComplex(instruction.op1) THEN
  2856. PrepareOp2(instruction,High,opHigh,ticketHigh);
  2857. PrepareOp2(instruction,Low,opLow,ticketLow);
  2858. emitter.Emit1(InstructionSet.opNOT,opHigh);
  2859. emitter.Emit1(InstructionSet.opNEG,opLow);
  2860. Assembler.InitImm8(minusOne,-1);
  2861. emitter.Emit2(InstructionSet.opSBB,opHigh,minusOne);
  2862. FinishOp(instruction.op1,High,opHigh,ticketHigh);
  2863. FinishOp(instruction.op1,Low,opLow,ticketLow);
  2864. ELSE
  2865. EmitArithmetic2(instruction,Low,InstructionSet.opNEG);
  2866. END;
  2867. END EmitNeg;
  2868. PROCEDURE EmitNegXMM(CONST instruction: IntermediateCode.Instruction);
  2869. VAR temp, op: Assembler.Operand; ticket: Ticket;
  2870. BEGIN
  2871. PrepareOp2(instruction, Low, op, ticket);
  2872. GetTemporaryRegister(instruction.op1.type,temp);
  2873. IF instruction.op1.type.sizeInBits = 32 THEN
  2874. emitter.Emit2(InstructionSet.opXORPS, temp, temp);
  2875. emitter.Emit2(InstructionSet.opSUBPS, temp, op);
  2876. emitter.Emit2(InstructionSet.opMOVAPS, op, temp);
  2877. ELSE
  2878. emitter.Emit2(InstructionSet.opXORPD, temp, temp);
  2879. emitter.Emit2(InstructionSet.opSUBPD, temp, op);
  2880. emitter.Emit2(InstructionSet.opMOVAPS, op, temp);
  2881. END;
  2882. FinishOp(instruction.op1, Low, op, ticket);
  2883. END EmitNegXMM;
  2884. PROCEDURE EmitAbs(CONST instruction: IntermediateCode.Instruction);
  2885. VAR op1,op2: Assembler.Operand; source,imm: Assembler.Operand; eax: Ticket;
  2886. BEGIN
  2887. Assert(~IsComplex(instruction.op1),"complex Abs not supported");
  2888. IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
  2889. Spill(physicalRegisters.Mapped(EAX));
  2890. eax := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
  2891. MakeOperand(instruction.op1,Low,op1,NIL);
  2892. MakeOperand(instruction.op2,Low,op2,NIL);
  2893. CASE instruction.op1.type.sizeInBits OF
  2894. | IntermediateCode.Bits8: imm := Assembler.NewImm8 (7); source := opAL;
  2895. | IntermediateCode.Bits16: imm := Assembler.NewImm8 (15); source := opAX;
  2896. | IntermediateCode.Bits32: imm := Assembler.NewImm8 (31); source := opEAX;
  2897. | IntermediateCode.Bits64: imm := Assembler.NewImm8 (63); source := registerOperands[RAX];
  2898. END;
  2899. emitter.Emit2 (InstructionSet.opMOV, source,op2);
  2900. emitter.Emit2 (InstructionSet.opMOV, op1,source);
  2901. emitter.Emit2 (InstructionSet.opSAR, source, imm);
  2902. emitter.Emit2 (InstructionSet.opXOR, op1, source);
  2903. emitter.Emit2 (InstructionSet.opSUB, op1, source);
  2904. UnmapTicket(eax);
  2905. ELSE Halt("Abs does not make sense on unsigned integer")
  2906. END;
  2907. END EmitAbs;
  2908. PROCEDURE EmitAbsXMM(CONST instruction: IntermediateCode.Instruction);
  2909. VAR temp, op: Assembler.Operand; ticket: Ticket;
  2910. BEGIN
  2911. PrepareOp2(instruction, Low, op, ticket);
  2912. GetTemporaryRegister(instruction.op1.type,temp);
  2913. IF instruction.op1.type.sizeInBits = 32 THEN
  2914. emitter.Emit2(InstructionSet.opXORPS, temp, temp);
  2915. emitter.Emit2(InstructionSet.opSUBPS, temp, op);
  2916. emitter.Emit2(InstructionSet.opMAXPS, op, temp);
  2917. ELSE
  2918. emitter.Emit2(InstructionSet.opXORPD, temp, temp);
  2919. emitter.Emit2(InstructionSet.opSUBPD, temp, op);
  2920. emitter.Emit2(InstructionSet.opMAXPD, op, temp);
  2921. END;
  2922. FinishOp(instruction.op1, Low, op, ticket);
  2923. END EmitAbsXMM;
  2924. PROCEDURE EmitTrap(CONST instruction: IntermediateCode.Instruction);
  2925. VAR operand: Assembler.Operand;
  2926. BEGIN
  2927. IF instruction.op1.intValue < 80H THEN
  2928. operand := Assembler.NewImm8(instruction.op1.intValue);
  2929. ELSE
  2930. operand := Assembler.NewImm32(instruction.op1.intValue);
  2931. END;
  2932. emitter.Emit1(InstructionSet.opPUSH, operand);
  2933. emitter.Emit0(InstructionSet.opINT3);
  2934. END EmitTrap;
  2935. PROCEDURE EmitAsm(CONST instruction: IntermediateCode.Instruction);
  2936. VAR reader: Streams.StringReader; procedure: SyntaxTree.Procedure; scope: SyntaxTree.Scope;
  2937. len: LONGINT; symbol: SyntaxTree.Symbol; assembler: Assembler.Assembly;
  2938. inr, outr: IntermediateCode.Rules;
  2939. string: SyntaxTree.SourceCode;
  2940. i: LONGINT;
  2941. reg, dest: Assembler.Operand;
  2942. map: Assembler.RegisterMap;
  2943. register: LONGINT;
  2944. ticket: Ticket;
  2945. BEGIN
  2946. IF instruction.op2.mode = IntermediateCode.ModeRule THEN inr := instruction.op2.rule ELSE inr := NIL END;
  2947. IF instruction.op3.mode = IntermediateCode.ModeRule THEN outr := instruction.op3.rule ELSE outr := NIL END;
  2948. string := instruction.op1.string;
  2949. NEW(map);
  2950. IF inr # NIL THEN
  2951. FOR i := 0 TO LEN(inr)-1 DO
  2952. MakeRegister(inr[i], 0, reg);
  2953. ASSERT(map.Find(inr[i].string^) < 0);
  2954. map.Add(inr[i].string, reg.register)
  2955. END;
  2956. END;
  2957. IF outr # NIL THEN
  2958. FOR i := 0 TO LEN(outr)-1 DO
  2959. IF (map.Find(outr[i].string^) < 0) THEN
  2960. GetTemporaryRegister(outr[i].type,reg);
  2961. map.Add(outr[i].string, reg.register)
  2962. END;
  2963. END;
  2964. END;
  2965. len := Strings.Length(string^);
  2966. NEW(reader,len);
  2967. reader.Set(string^);
  2968. symbol := in.symbol;
  2969. procedure := symbol(SyntaxTree.Procedure);
  2970. scope := procedure.procedureScope;
  2971. NEW(assembler,diagnostics,emitter);
  2972. assembler.useLineNumbers := Compiler.UseLineNumbers IN backend.flags;
  2973. assembler.Assemble(reader,instruction.textPosition,scope,in,in,module,procedure.access * SyntaxTree.Public # {}, procedure.isInline, map) ;
  2974. error := error OR assembler.error;
  2975. IF outr # NIL THEN
  2976. FOR i := 0 TO LEN(outr)-1 DO
  2977. IF outr[i].mode # IntermediateCode.Undefined THEN
  2978. register := map.Find(outr[i].string^);
  2979. ticket := physicalRegisters.Mapped(register);
  2980. IF ticket.lastuse = inPC THEN UnmapTicket(ticket); physicalRegisters.AllocationHint(register) END; (* try to reuse register here *)
  2981. Assembler.InitRegister(reg, register);
  2982. MakeOperand(outr[i], Low, dest, NIL);
  2983. Move( dest, reg,outr[i].type)
  2984. END;
  2985. END;
  2986. END;
  2987. (*
  2988. IntermediateCode.SetString(instruction.op1, string);
  2989. *)
  2990. END EmitAsm;
  2991. END CodeGeneratorAMD64;
  2992. BackendAMD64= OBJECT (IntermediateBackend.IntermediateBackend)
  2993. VAR
  2994. cg: CodeGeneratorAMD64;
  2995. bits: LONGINT;
  2996. traceable: BOOLEAN;
  2997. forceFPU: BOOLEAN;
  2998. winAPIRegisters: ARRAY 4 OF LONGINT;
  2999. cRegisters: ARRAY 6 OF LONGINT;
  3000. PROCEDURE &InitBackendAMD64;
  3001. BEGIN
  3002. InitIntermediateBackend;
  3003. bits := 32;
  3004. forceFPU := FALSE;
  3005. winAPIRegisters[0] := RCX - RAX;
  3006. winAPIRegisters[1] := RDX - RAX;
  3007. winAPIRegisters[2] := R8 - RAX;
  3008. winAPIRegisters[3] := R9 - RAX;
  3009. cRegisters[0] := RDI - RAX;
  3010. cRegisters[1] := RSI - RAX;
  3011. cRegisters[2] := RDX - RAX;
  3012. cRegisters[3] := RCX - RAX;
  3013. cRegisters[4] := R8 - RAX;
  3014. cRegisters[5] := R9 - RAX;
  3015. SetName("AMD");
  3016. END InitBackendAMD64;
  3017. PROCEDURE Initialize*(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System);
  3018. BEGIN
  3019. Initialize^(diagnostics,log, flags,checker,system); NEW(cg, builtinsModuleName, diagnostics, SELF);
  3020. END Initialize;
  3021. PROCEDURE GetSystem*(): Global.System;
  3022. VAR system: Global.System;
  3023. PROCEDURE AddRegister(CONST name: Scanner.IdentifierString; val: LONGINT);
  3024. BEGIN
  3025. Global.NewConstant(name,val,system.shortintType,system.systemScope)
  3026. END AddRegister;
  3027. PROCEDURE AddRegisters;
  3028. BEGIN
  3029. (* system constants *)
  3030. AddRegister("EAX",InstructionSet.regEAX); AddRegister("ECX", InstructionSet.regECX);
  3031. AddRegister( "EDX", InstructionSet.regEDX); AddRegister( "EBX", InstructionSet.regEBX);
  3032. AddRegister( "ESP", InstructionSet.regESP); AddRegister( "EBP", InstructionSet.regEBP);
  3033. AddRegister( "ESI", InstructionSet.regESI); AddRegister( "EDI", InstructionSet.regEDI);
  3034. AddRegister( "AX", InstructionSet.regAX); AddRegister( "CX", InstructionSet.regCX);
  3035. AddRegister( "DX", InstructionSet.regDX); AddRegister( "BX", InstructionSet.regBX);
  3036. AddRegister( "AL", InstructionSet.regAL); AddRegister( "CL", InstructionSet.regCL);
  3037. AddRegister( "DL", InstructionSet.regDL); AddRegister( "BL", InstructionSet.regBL);
  3038. AddRegister( "AH", InstructionSet.regAH); AddRegister( "CH", InstructionSet.regCH);
  3039. AddRegister( "DH", InstructionSet.regDH); AddRegister( "BH", InstructionSet.regBH);
  3040. AddRegister( "RAX", InstructionSet.regRAX); AddRegister( "RCX", InstructionSet.regRCX);
  3041. AddRegister( "RDX", InstructionSet.regRDX); AddRegister( "RBX", InstructionSet.regRBX);
  3042. AddRegister( "RSP", InstructionSet.regRSP); AddRegister( "RBP", InstructionSet.regRBP);
  3043. AddRegister( "RSI", InstructionSet.regRSI); AddRegister( "RDI", InstructionSet.regRDI);
  3044. AddRegister( "R8", InstructionSet.regR8); AddRegister( "R9", InstructionSet.regR9);
  3045. AddRegister( "R10", InstructionSet.regR10); AddRegister( "R11", InstructionSet.regR11);
  3046. AddRegister( "R12", InstructionSet.regR12); AddRegister( "R13", InstructionSet.regR13);
  3047. AddRegister( "R14", InstructionSet.regR14); AddRegister( "R15", InstructionSet.regR15);
  3048. AddRegister( "R8D", InstructionSet.regR8D); AddRegister( "R9D", InstructionSet.regR9D);
  3049. AddRegister( "R10D", InstructionSet.regR10D); AddRegister( "R11D", InstructionSet.regR11D);
  3050. AddRegister( "R12D", InstructionSet.regR12D); AddRegister( "R13D", InstructionSet.regR13D);
  3051. AddRegister( "R14D", InstructionSet.regR14D); AddRegister( "R15D", InstructionSet.regR15D);
  3052. AddRegister( "R8W", InstructionSet.regR8W); AddRegister( "R9W", InstructionSet.regR9W);
  3053. AddRegister( "R10W", InstructionSet.regR10W); AddRegister( "R11W", InstructionSet.regR11W);
  3054. AddRegister( "R12W", InstructionSet.regR12W); AddRegister( "R13W", InstructionSet.regR13W);
  3055. AddRegister( "R14W", InstructionSet.regR14W); AddRegister( "R15W", InstructionSet.regR15W);
  3056. AddRegister( "R8B", InstructionSet.regR8B); AddRegister( "R9B", InstructionSet.regR9B);
  3057. AddRegister( "R10B", InstructionSet.regR10B); AddRegister( "R11B", InstructionSet.regR11B);
  3058. AddRegister( "R12B", InstructionSet.regR12B); AddRegister( "R13B", InstructionSet.regR13B);
  3059. AddRegister( "R14B", InstructionSet.regR14B); AddRegister( "R15B", InstructionSet.regR15B);
  3060. END AddRegisters;
  3061. BEGIN
  3062. IF system = NIL THEN
  3063. IF bits=32 THEN
  3064. NEW(system,8,8,32, 8,32,32,32,64,cooperative);
  3065. Global.SetDefaultDeclarations(system,8);
  3066. Global.SetDefaultOperators(system);
  3067. ELSE
  3068. NEW(system,8,8,64,8,64,64,64,128,cooperative);
  3069. Global.SetDefaultDeclarations(system,8);
  3070. Global.SetDefaultOperators(system);
  3071. END;
  3072. system.SetRegisterPassCallback(CanPassInRegister);
  3073. AddRegisters
  3074. END;
  3075. RETURN system
  3076. END GetSystem;
  3077. (* return number of general purpose registery used as parameter register in calling convention *)
  3078. PROCEDURE NumberParameterRegisters*(callingConvention: SyntaxTree.CallingConvention): SIZE;
  3079. BEGIN
  3080. IF bits = 32 THEN
  3081. RETURN 0;
  3082. ELSE
  3083. CASE callingConvention OF
  3084. |SyntaxTree.WinAPICallingConvention: RETURN 4;
  3085. |SyntaxTree.CCallingConvention, SyntaxTree.DarwinCCallingConvention: RETURN 6;
  3086. ELSE
  3087. RETURN 0;
  3088. END;
  3089. END
  3090. END NumberParameterRegisters;
  3091. (* returns the following register (or part thereof)
  3092. 0: regRAX;
  3093. 1: regRCX;
  3094. 2: regRDX;
  3095. 3: regRBX;
  3096. 4: regRSP;
  3097. 5: regRBP;
  3098. 6: regRSI;
  3099. 7: regRDI;
  3100. 8 .. 15: regRx;
  3101. *)
  3102. PROCEDURE HardwareIntegerRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
  3103. BEGIN
  3104. index := index MOD 32;
  3105. sizeInBits := sizeInBits DIV 8;
  3106. WHILE sizeInBits > 1 DO (* jump to register section that corresponds to the number of bits *)
  3107. INC(index,32);
  3108. sizeInBits := sizeInBits DIV 2;
  3109. END;
  3110. RETURN index
  3111. END HardwareIntegerRegister;
  3112. PROCEDURE HardwareFloatRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
  3113. BEGIN
  3114. ASSERT((sizeInBits = 32) OR (sizeInBits = 64));
  3115. RETURN XMM0 + index;
  3116. END HardwareFloatRegister;
  3117. PROCEDURE ParameterRegister*(callingConvention: SyntaxTree.CallingConvention; type: IntermediateCode.Type; index: LONGINT): LONGINT;
  3118. VAR size: LONGINT;
  3119. BEGIN
  3120. IF type.form IN IntermediateCode.Integer THEN
  3121. CASE callingConvention OF
  3122. |SyntaxTree.WinAPICallingConvention: index := winAPIRegisters[index];
  3123. |SyntaxTree.CCallingConvention, SyntaxTree.DarwinCCallingConvention: index := cRegisters[index]
  3124. END;
  3125. RETURN HardwareIntegerRegister(RAX + index, type.sizeInBits)
  3126. ELSIF type.form = IntermediateCode.Float THEN
  3127. RETURN HardwareFloatRegister(index, type.sizeInBits)
  3128. ELSE
  3129. HALT(100);
  3130. END;
  3131. END ParameterRegister;
  3132. PROCEDURE SupportedInstruction*(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  3133. BEGIN
  3134. RETURN cg.Supported(instruction,moduleName,procedureName);
  3135. END SupportedInstruction;
  3136. PROCEDURE GenerateBinary(module: Sections.Module; dump: Streams.Writer);
  3137. VAR
  3138. in: Sections.Section;
  3139. out: BinaryCode.Section;
  3140. name: Basic.SegmentedName;
  3141. procedure: SyntaxTree.Procedure;
  3142. i, j, initialSectionCount: LONGINT;
  3143. (* recompute fixup positions and assign binary sections *)
  3144. PROCEDURE PatchFixups(section: BinaryCode.Section);
  3145. VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; displacement,symbolOffset: LONGINT; in: IntermediateCode.Section;
  3146. symbol: Sections.Section;
  3147. BEGIN
  3148. fixup := section.fixupList.firstFixup;
  3149. WHILE fixup # NIL DO
  3150. symbol := module.allSections.FindByName(fixup.symbol.name);
  3151. IF (symbol # NIL) & (symbol(IntermediateCode.Section).resolved # NIL) THEN
  3152. resolved := symbol(IntermediateCode.Section).resolved(BinaryCode.Section);
  3153. in := symbol(IntermediateCode.Section);
  3154. symbolOffset := fixup.symbolOffset;
  3155. IF symbolOffset = in.pc THEN
  3156. displacement := resolved.pc
  3157. ELSIF (symbolOffset # 0) THEN
  3158. ASSERT(in.pc > symbolOffset);
  3159. displacement := in.instructions[symbolOffset].pc;
  3160. ELSE
  3161. displacement := 0;
  3162. END;
  3163. fixup.SetSymbol(fixup.symbol.name,fixup.symbol.fingerprint,0,fixup.displacement+displacement);
  3164. END;
  3165. fixup := fixup.nextFixup;
  3166. END;
  3167. END PatchFixups;
  3168. BEGIN
  3169. cg.SetModule(module);
  3170. FOR i := 0 TO module.allSections.Length() - 1 DO
  3171. in := module.allSections.GetSection(i);
  3172. IF in.type = Sections.InlineCodeSection THEN
  3173. name := in.name;
  3174. out := ResolvedSection(in(IntermediateCode.Section));
  3175. cg.Section(in(IntermediateCode.Section),out);
  3176. procedure := in.symbol(SyntaxTree.Procedure);
  3177. IF procedure.procedureScope.body.code # NIL THEN
  3178. procedure.procedureScope.body.code.SetBinaryCode(out.os.bits);
  3179. END;
  3180. END
  3181. END;
  3182. initialSectionCount := 0;
  3183. REPEAT
  3184. j := initialSectionCount;
  3185. initialSectionCount := module.allSections.Length() ;
  3186. FOR i := j TO initialSectionCount - 1 DO
  3187. in := module.allSections.GetSection(i);
  3188. IF (in.type # Sections.InlineCodeSection) & (in(IntermediateCode.Section).resolved = NIL) THEN
  3189. name := in.name;
  3190. out := ResolvedSection(in(IntermediateCode.Section));
  3191. cg.Section(in(IntermediateCode.Section),out);
  3192. IF out.os.type = Sections.VarSection THEN
  3193. IF out.pc = 1 THEN out.SetAlignment(FALSE,1)
  3194. ELSIF out.pc = 2 THEN out.SetAlignment(FALSE,2)
  3195. ELSIF (out.pc > 4) & (bits > 32) THEN out.SetAlignment(FALSE,8)
  3196. ELSIF (out.pc > 2) THEN out.SetAlignment(FALSE,4)
  3197. END;
  3198. ELSIF out.os.type = Sections.ConstSection THEN
  3199. out.SetAlignment(FALSE,bits DIV 8);
  3200. END;
  3201. END
  3202. END
  3203. UNTIL initialSectionCount = module.allSections.Length(); (* process remaining sections that have been added during traversal of sections *)
  3204. (*
  3205. FOR i := 0 TO module.allSections.Length() - 1 DO
  3206. in := module.allSections.GetSection(i);
  3207. IF in.kind = Sections.CaseTableKind THEN
  3208. IF in(IntermediateCode.Section).resolved = NIL THEN
  3209. out := ResolvedSection(in(IntermediateCode.Section));
  3210. cg.Section(in(IntermediateCode.Section),out);
  3211. END
  3212. END
  3213. END;
  3214. *)
  3215. FOR i := 0 TO module.allSections.Length() - 1 DO
  3216. in := module.allSections.GetSection(i);
  3217. PatchFixups(in(IntermediateCode.Section).resolved)
  3218. END;
  3219. (*
  3220. FOR i := 0 TO module.allSections.Length() - 1 DO
  3221. in := module.allSections.GetSection(i);
  3222. IF in.kind = Sections.CaseTableKind THEN
  3223. PatchFixups(in(IntermediateCode.Section).resolved)
  3224. END
  3225. END;
  3226. *)
  3227. IF cg.error THEN Error("",Basic.invalidPosition, Streams.Invalid,"") END;
  3228. END GenerateBinary;
  3229. (* genasm *)
  3230. PROCEDURE ProcessIntermediateCodeModule*(intermediateCodeModule: Formats.GeneratedModule): Formats.GeneratedModule;
  3231. VAR
  3232. result: Formats.GeneratedModule;
  3233. BEGIN
  3234. ASSERT(intermediateCodeModule IS Sections.Module);
  3235. result := ProcessIntermediateCodeModule^(intermediateCodeModule);
  3236. IF ~error THEN
  3237. GenerateBinary(result(Sections.Module),dump);
  3238. IF dump # NIL THEN
  3239. dump.Ln; dump.Ln;
  3240. dump.String(";------------------ binary code -------------------"); dump.Ln;
  3241. IF (traceString="") OR (traceString="*") THEN
  3242. result.Dump(dump);
  3243. dump.Update
  3244. ELSE
  3245. Sections.DumpFiltered(dump, result(Sections.Module), traceString);
  3246. dump.Update;
  3247. END
  3248. END;
  3249. END;
  3250. RETURN result
  3251. FINALLY
  3252. IF dump # NIL THEN
  3253. dump.Ln; dump.Ln;
  3254. dump.String("; ------------------ rescued code (code generation trapped) -------------------"); dump.Ln;
  3255. IF (traceString="") OR (traceString="*") THEN
  3256. result.Dump(dump);
  3257. dump.Update
  3258. ELSE
  3259. Sections.DumpFiltered(dump, result(Sections.Module), traceString);
  3260. dump.Update;
  3261. END
  3262. END;
  3263. HALT(100); (* do not continue compiling after trap *)
  3264. RETURN result
  3265. END ProcessIntermediateCodeModule;
  3266. PROCEDURE FindPC*(x: SyntaxTree.Module; CONST sectionName: ARRAY OF CHAR; sectionOffset: LONGINT);
  3267. VAR
  3268. section: Sections.Section; binarySection: BinaryCode.Section; label: BinaryCode.LabelList; module: Formats.GeneratedModule;
  3269. i: LONGINT; pooledName: Basic.SegmentedName;
  3270. BEGIN
  3271. module := ProcessSyntaxTreeModule(x);
  3272. Basic.ToSegmentedName(sectionName, pooledName);
  3273. i := 0;
  3274. REPEAT
  3275. section := module(Sections.Module).allSections.GetSection(i);
  3276. INC(i);
  3277. UNTIL (i = module(Sections.Module).allSections.Length()) OR (section.name = pooledName);
  3278. IF section.name # pooledName THEN
  3279. Basic.Error(diagnostics, module.module.sourceName,Basic.invalidPosition, " could not locate pc");
  3280. ELSE
  3281. binarySection := section(IntermediateCode.Section).resolved;
  3282. IF binarySection # NIL THEN
  3283. label := binarySection.labels;
  3284. WHILE (label # NIL) & (label.offset >= sectionOffset) DO
  3285. label := label.prev;
  3286. END;
  3287. END;
  3288. IF label # NIL THEN
  3289. Basic.Information(diagnostics, module.module.sourceName,label.position, " pc position");
  3290. ELSE
  3291. Basic.Error(diagnostics, module.module.sourceName,Basic.invalidPosition, " could not locate pc");
  3292. END;
  3293. END;
  3294. END FindPC;
  3295. PROCEDURE CanPassInRegister*(type: SyntaxTree.Type): BOOLEAN;
  3296. VAR length: LONGINT; baseType: SyntaxTree.Type; b: BOOLEAN;
  3297. BEGIN
  3298. b := SemanticChecker.IsStaticMathArray(type, length, baseType) & (baseType IS SyntaxTree.FloatType) &
  3299. (baseType.sizeInBits <= 32) & (length = 4);
  3300. b := b OR SemanticChecker.IsStaticMathArray(type, length, baseType) & (baseType IS SyntaxTree.CharacterType) &
  3301. (baseType.sizeInBits = 8) & (length = 4);
  3302. b := b OR SemanticChecker.IsStaticArray(type, baseType, length) & (baseType.resolved IS SyntaxTree.CharacterType) &
  3303. (baseType.resolved.sizeInBits = 8) & (length = 4);
  3304. RETURN b
  3305. END CanPassInRegister;
  3306. PROCEDURE GetDescription*(VAR instructionSet: ARRAY OF CHAR);
  3307. BEGIN instructionSet := "AMD";
  3308. END GetDescription;
  3309. PROCEDURE DefineOptions*(options: Options.Options);
  3310. BEGIN
  3311. options.Add(0X,"bits",Options.Integer);
  3312. options.Add(0X,"traceable", Options.Flag);
  3313. options.Add(0X,"useFPU", Options.Flag);
  3314. DefineOptions^(options);
  3315. END DefineOptions;
  3316. PROCEDURE GetOptions*(options: Options.Options);
  3317. BEGIN
  3318. IF ~options.GetInteger("bits",bits) THEN bits := 32 END;
  3319. traceable := options.GetFlag("traceable");
  3320. forceFPU := options.GetFlag("useFPU");
  3321. GetOptions^(options);
  3322. END GetOptions;
  3323. PROCEDURE DefaultObjectFileFormat*(): Formats.ObjectFileFormat;
  3324. BEGIN RETURN ObjectFileFormat.Get();
  3325. END DefaultObjectFileFormat;
  3326. PROCEDURE DefaultSymbolFileFormat*(): Formats.SymbolFileFormat;
  3327. BEGIN
  3328. RETURN NIL
  3329. END DefaultSymbolFileFormat;
  3330. END BackendAMD64;
  3331. (** the number of regular sections in a section list **)
  3332. PROCEDURE RegularSectionCount(sectionList: Sections.SectionList): LONGINT;
  3333. VAR
  3334. section: Sections.Section;
  3335. i, result: LONGINT;
  3336. BEGIN
  3337. result := 0;
  3338. FOR i := 0 TO sectionList.Length() - 1 DO
  3339. section := sectionList.GetSection(i);
  3340. INC(result)
  3341. END;
  3342. RETURN result
  3343. END RegularSectionCount;
  3344. PROCEDURE Assert(b: BOOLEAN; CONST s: ARRAY OF CHAR);
  3345. BEGIN
  3346. ASSERT(b,100);
  3347. END Assert;
  3348. PROCEDURE Halt(CONST s: ARRAY OF CHAR);
  3349. BEGIN
  3350. HALT(100);
  3351. END Halt;
  3352. PROCEDURE ResolvedSection(in: IntermediateCode.Section): BinaryCode.Section;
  3353. VAR section: BinaryCode.Section;
  3354. BEGIN
  3355. IF in.resolved = NIL THEN
  3356. NEW(section,in.type, 8, in.name,in.comments # NIL,FALSE);
  3357. section.SetAlignment(in.fixed, in.positionOrAlignment);
  3358. in.SetResolved(section);
  3359. ELSE
  3360. section := in.resolved
  3361. END;
  3362. RETURN section
  3363. END ResolvedSection;
  3364. PROCEDURE Init;
  3365. VAR i: LONGINT;
  3366. BEGIN
  3367. FOR i := 0 TO LEN(registerOperands)-1 DO
  3368. Assembler.InitRegister(registerOperands[i],i);
  3369. END;
  3370. opEAX := registerOperands[EAX];
  3371. opEBX := registerOperands[EBX];
  3372. opECX := registerOperands[ECX];
  3373. opEDX := registerOperands[EDX];
  3374. opESI := registerOperands[ESI];
  3375. opEDI := registerOperands[EDI];
  3376. opEBP := registerOperands[EBP];
  3377. opESP := registerOperands[ESP];
  3378. opRSP := registerOperands[RSP];
  3379. opRBP := registerOperands[RBP];
  3380. opAX := registerOperands[AX];
  3381. opBX := registerOperands[BX];
  3382. opCX := registerOperands[CX];
  3383. opDX := registerOperands[DX];
  3384. opSI := registerOperands[SI];
  3385. opDI := registerOperands[DI];
  3386. opAL := registerOperands[AL];
  3387. opBL := registerOperands[BL];
  3388. opCL := registerOperands[CL];
  3389. opDL := registerOperands[DL];
  3390. opAH := registerOperands[AH];
  3391. opBH := registerOperands[BH];
  3392. opCH := registerOperands[CH];
  3393. opDH := registerOperands[DH];
  3394. opST0 := registerOperands[ST0];
  3395. NEW(unusable); NEW(blocked); NEW(split); free := NIL;
  3396. END Init;
  3397. PROCEDURE Get*(): Backend.Backend;
  3398. VAR backend: BackendAMD64;
  3399. BEGIN NEW(backend); RETURN backend
  3400. END Get;
  3401. PROCEDURE Trace*;
  3402. BEGIN
  3403. TRACE(traceStackSize);
  3404. END Trace;
  3405. BEGIN
  3406. traceStackSize := 0;
  3407. Init;
  3408. usePool := Machine.NumberOfProcessors()>1;
  3409. END FoxAMDBackend.
  3410. System.FreeDownTo FoxAMDBackend ~