FoxAMDBackend.Mod 144 KB

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