FoxAMDBackend.Mod 136 KB

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