FoxAMDBackend.Mod 142 KB

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