FoxAMDBackend.Mod 138 KB

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