FoxAMDBackend.Mod 136 KB

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