FoxARMBackend.Mod 145 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556
  1. MODULE FoxARMBackend; (** AUTHOR ""; PURPOSE "backend for ARM (advanced RISC machines)"; *)
  2. IMPORT
  3. Basic := FoxBasic, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Backend := FoxBackend, Sections := FoxSections,
  4. IntermediateCode := FoxIntermediateCode, IntermediateBackend := FoxIntermediateBackend, CodeGenerators := FoxCodeGenerators, BinaryCode := FoxBinaryCode,
  5. SemanticChecker := FoxSemanticChecker, Formats := FoxFormats, Assembler := FoxARMAssembler, InstructionSet := FoxARMInstructionSet,
  6. SYSTEM, Diagnostics, Streams, Options, WMUtilities, Strings, ObjectFile, Scanner := FoxScanner, ObjectFileFormat := FoxGenericObjectFile,
  7. ActiveCells := FoxActiveCells, D := Debugging;
  8. CONST
  9. Trace = FALSE; (* general trace *)
  10. TraceFixups = FALSE;
  11. DefaultRuntimeModuleName = "ARMRuntime";
  12. None = -1;
  13. (* parts of an ARM operand *)
  14. Low = 0; High = 1;
  15. (* mnemonics of the ARM instruction set *)
  16. opADC = InstructionSet.opADC; opADD = InstructionSet.opADD;
  17. opAND = InstructionSet.opAND; opB = InstructionSet.opB;
  18. opBIC = InstructionSet.opBIC; opBKPT = InstructionSet.opBKPT;
  19. opBL = InstructionSet.opBL; opBLX = InstructionSet.opBLX;
  20. opBX = InstructionSet.opBX; opCDP = InstructionSet.opCDP;
  21. opCDP2 = InstructionSet.opCDP2; opCLZ = InstructionSet.opCLZ;
  22. opCMN = InstructionSet.opCMN; opCMP = InstructionSet.opCMP;
  23. opEOR = InstructionSet.opEOR; opFABSD = InstructionSet.opFABSD;
  24. opFABSS = InstructionSet.opFABSS; opFADDD = InstructionSet.opFADDD;
  25. opFADDS = InstructionSet.opFADDS; opFCMPD = InstructionSet.opFCMPD;
  26. opFCMPED = InstructionSet.opFCMPED; opFCMPES = InstructionSet.opFCMPES;
  27. opFCMPEZD = InstructionSet.opFCMPEZD; opFCMPEZS = InstructionSet.opFCMPEZS;
  28. opFCMPS = InstructionSet.opFCMPS; opFCMPZD = InstructionSet.opFCMPZD;
  29. opFCMPZS = InstructionSet.opFCMPZS; opFCPYD = InstructionSet.opFCPYD;
  30. opFCPYS = InstructionSet.opFCPYS; opFCVTDS = InstructionSet.opFCVTDS;
  31. opFCVTSD = InstructionSet.opFCVTSD; opFDIVD = InstructionSet.opFDIVD;
  32. opFDIVS = InstructionSet.opFDIVS; opFLDD = InstructionSet.opFLDD;
  33. opFLDMIAD = InstructionSet.opFLDMIAD; opFLDMIAS = InstructionSet.opFLDMIAS;
  34. opFLDMIAX = InstructionSet.opFLDMIAX; opFLDMDBD = InstructionSet.opFLDMDBD;
  35. opFLDMDBS = InstructionSet.opFLDMDBS; opFLDMDBX = InstructionSet.opFLDMDBX;
  36. opFLDS = InstructionSet.opFLDS; opFMACD = InstructionSet.opFMACD;
  37. opFMACS = InstructionSet.opFMACS; opFMDHR = InstructionSet.opFMDHR;
  38. opFMDLR = InstructionSet.opFMDLR; opFMRDH = InstructionSet.opFMRDH;
  39. opFMRDL = InstructionSet.opFMRDL; opFMRS = InstructionSet.opFMRS;
  40. opFMRX = InstructionSet.opFMRX; opFMSCD = InstructionSet.opFMSCD;
  41. opFMSCS = InstructionSet.opFMSCS; opFMSR = InstructionSet.opFMSR;
  42. opFMSTAT = InstructionSet.opFMSTAT; opFMULD = InstructionSet.opFMULD;
  43. opFMULS = InstructionSet.opFMULS; opFMXR = InstructionSet.opFMXR;
  44. opFNEGD = InstructionSet.opFNEGD; opFNEGS = InstructionSet.opFNEGS;
  45. opFNMACD = InstructionSet.opFNMACD; opFNMACS = InstructionSet.opFNMACS;
  46. opFNMSCD = InstructionSet.opFNMSCD; opFNMSCS = InstructionSet.opFNMSCS;
  47. opFNMULD = InstructionSet.opFNMULD ; opFNMULS = InstructionSet.opFNMULS;
  48. opFSITOD = InstructionSet.opFSITOD; opFSITOS = InstructionSet.opFSITOS;
  49. opFSQRTD = InstructionSet.opFSQRTD; opFSQRTS = InstructionSet.opFSQRTS;
  50. opFSTD = InstructionSet.opFSTD; opFSTMIAD = InstructionSet.opFSTMIAD;
  51. opFSTMIAS = InstructionSet.opFSTMIAS; opFSTMIAX = InstructionSet.opFSTMIAX;
  52. opFSTMDBD = InstructionSet.opFSTMDBD; opFSTMDBS = InstructionSet.opFSTMDBS;
  53. opFSTMDBX = InstructionSet.opFSTMDBX; opFSTS = InstructionSet.opFSTS;
  54. opFSUBD = InstructionSet.opFSUBD; opFSUBS = InstructionSet.opFSUBS;
  55. opFTOSID = InstructionSet.opFTOSID; opFTOSIZD = InstructionSet.opFTOSIZD;
  56. opFTOSIS = InstructionSet.opFTOSIS; opFTOSIZS = InstructionSet.opFTOSIZS;
  57. opFTOUID = InstructionSet.opFTOUID; opFTOUIZD = InstructionSet.opFTOUIZD;
  58. opFTOUIS = InstructionSet.opFTOUIS; opFTOUIZS = InstructionSet.opFTOUIZS;
  59. opFUITOD = InstructionSet.opFUITOD; opFUITOS = InstructionSet.opFUITOS;
  60. opLDC = InstructionSet.opLDC; opLDC2 = InstructionSet.opLDC2;
  61. opLDM = InstructionSet.opLDM; opLDR = InstructionSet.opLDR;
  62. opMCR = InstructionSet.opMCR; opMCR2 = InstructionSet.opMCR2;
  63. opMCRR = InstructionSet.opMCRR; opMLA = InstructionSet.opMLA;
  64. opMOV = InstructionSet.opMOV; opMRC = InstructionSet.opMRC;
  65. opMRC2 = InstructionSet.opMRC2; opMRRC = InstructionSet.opMRRC;
  66. opMRS = InstructionSet.opMRS; opMSR = InstructionSet.opMSR;
  67. opMUL = InstructionSet.opMUL; opMVN = InstructionSet.opMVN;
  68. opORR = InstructionSet.opORR; opPLD = InstructionSet.opPLD;
  69. opQADD = InstructionSet.opQADD; opQDADD = InstructionSet.opQDADD;
  70. opQDSUB = InstructionSet.opQDSUB; opQSUB = InstructionSet.opQSUB;
  71. opRSB = InstructionSet.opRSB; opRSC = InstructionSet.opRSC;
  72. opSBC = InstructionSet.opSBC; opSMLABB = InstructionSet.opSMLABB;
  73. opSMLABT = InstructionSet.opSMLABT; opSMLAL = InstructionSet.opSMLAL;
  74. opSMLATB = InstructionSet.opSMLATB; opSMLATT = InstructionSet.opSMLATT;
  75. opSMLALBB = InstructionSet.opSMLALBB; opSMLALBT = InstructionSet.opSMLALBT;
  76. opSMLALTB = InstructionSet.opSMLALTB; opSMLALTT = InstructionSet.opSMLALTT;
  77. opSMLAWB = InstructionSet.opSMLAWB; opSMLAWT = InstructionSet.opSMLAWT;
  78. opSMULBB = InstructionSet.opSMULBB; opSMULBT = InstructionSet.opSMULBT;
  79. opSMULTB = InstructionSet.opSMULTB; opSMULTT = InstructionSet.opSMULTT;
  80. opSMULWB = InstructionSet.opSMULWB; opSMULWT = InstructionSet.opSMULWT;
  81. opSMULL = InstructionSet.opSMULL; opSTC = InstructionSet.opSTC;
  82. opSTC2 = InstructionSet.opSTC2; opSTM = InstructionSet.opSTM;
  83. opSTR = InstructionSet.opSTR; opSUB = InstructionSet.opSUB;
  84. opSWI = InstructionSet.opSWI; opSWP = InstructionSet.opSWP;
  85. opTEQ = InstructionSet.opTEQ; opTST = InstructionSet.opTST;
  86. opUMLAL = InstructionSet.opUMLAL; opUMULL = InstructionSet.opUMULL;
  87. MaximumFixupDistance = (*4103*) 1024; (* = 2^12-1+8 (maximum distance [in bytes] between a symbol fixup location and an instruction that uses the symbol) *)
  88. (* builtin backend specific system instructions *)
  89. GetSP = 0; SetSP = 1;
  90. GetFP = 2; SetFP = 3;
  91. GetLNK = 4; SetLNK = 5;
  92. GetPC = 6; SetPC = 7;
  93. LDPSR = 8; STPSR = 9;
  94. LDCPR = 10; STCPR = 11;
  95. FLUSH = 12;
  96. NULL = 13; XOR = 14; MULD = 15; ADDC = 16;
  97. PACK = 17; UNPK = 18;
  98. UseFPUFlag = "useFPU";
  99. TYPE
  100. Operand = InstructionSet.Operand;
  101. Ticket = CodeGenerators.Ticket;
  102. (* a citation of a symbol, i.e., an ARM instruction that requires a symbol's address *)
  103. Citation = OBJECT
  104. VAR
  105. pc: LONGINT; (* program counter of the ARM instruction *)
  106. next: Citation;
  107. END Citation;
  108. (* a reference to a symbol and offset in IR units that is used by at least one instruction *)
  109. Reference = OBJECT
  110. VAR
  111. firstCitation, lastCitation: Citation; (* linked list of citations *)
  112. next: Reference;
  113. PROCEDURE & Init;
  114. BEGIN
  115. firstCitation := NIL; lastCitation := NIL; next := NIL;
  116. END Init;
  117. PROCEDURE AddCitation(pc: LONGINT);
  118. VAR
  119. citation: Citation;
  120. BEGIN
  121. NEW(citation); citation.pc := pc; citation.next := NIL;
  122. IF firstCitation = NIL THEN firstCitation := citation ELSE lastCitation.next := citation END;
  123. lastCitation := citation
  124. END AddCitation;
  125. END Reference;
  126. ImmediateReference = OBJECT (Reference)
  127. VAR value: LONGINT;
  128. PROCEDURE & InitImm(v: LONGINT);
  129. BEGIN
  130. Init;
  131. SELF.value := v;
  132. END InitImm;
  133. END ImmediateReference;
  134. (* a reference to a symbol and offset in IR units that is used by at least one instruction *)
  135. SymbolReference = OBJECT (Reference)
  136. VAR
  137. symbol: Sections.SectionName;
  138. fingerprint: LONGINT;
  139. symbolOffset: LONGINT; (* offset to the symbol in IR units *)
  140. PROCEDURE & InitSym(s: Sections.SectionName; fp: LONGINT; offs: LONGINT);
  141. BEGIN
  142. Init;
  143. SELF.symbol := s; SELF.symbolOffset := offs; fingerprint := fp;
  144. END InitSym;
  145. END SymbolReference;
  146. ListOfReferences = OBJECT
  147. VAR
  148. firstReference, lastReference: Reference; (* linked list of all symbol references *)
  149. referenceCount: LONGINT; (* the number of reference = length of the required fixup block *)
  150. pcOfFirstCitation: LONGINT; (* the PC of the first instruction that cites a symbol or immediate *)
  151. PROCEDURE & Init;
  152. BEGIN
  153. firstReference := NIL; lastReference := NIL;
  154. referenceCount := 0;
  155. pcOfFirstCitation := None;
  156. END Init;
  157. PROCEDURE AddSymbol(symbol: Sections.SectionName; fingerprint: LONGINT; symbolOffset: LONGINT; pc: LONGINT);
  158. VAR
  159. reference, foundReference: Reference; symbolReference: SymbolReference;
  160. BEGIN
  161. (* go through the list of symbol/offset-combinations and check if there already is an entry for the symbol and offset in question *)
  162. reference := firstReference;
  163. WHILE reference # NIL DO
  164. IF reference IS SymbolReference THEN
  165. WITH reference: SymbolReference DO
  166. IF (reference.symbol = symbol) & (reference.symbolOffset = symbolOffset) THEN
  167. foundReference := reference (* an entry already exists *)
  168. END;
  169. END;
  170. END;
  171. reference := reference.next
  172. END;
  173. IF foundReference # NIL THEN
  174. reference := foundReference
  175. ELSE
  176. (* no entry was found for the symbol/offset combination: create a new one *)
  177. NEW(symbolReference, symbol, fingerprint, symbolOffset);
  178. reference := symbolReference;
  179. IF firstReference = NIL THEN firstReference := reference ELSE lastReference.next := reference END;
  180. lastReference := reference;
  181. INC(referenceCount)
  182. END;
  183. (* add a citation to the reference *)
  184. reference.AddCitation(pc);
  185. IF pcOfFirstCitation = None THEN pcOfFirstCitation := pc END
  186. END AddSymbol;
  187. PROCEDURE AddImmediate(value: LONGINT; pc: LONGINT);
  188. VAR
  189. reference, foundReference: Reference; immediateReference: ImmediateReference;
  190. BEGIN
  191. (* go through the list of symbol/offset-combinations and check if there already is an entry for the symbol and offset in question *)
  192. reference := firstReference;
  193. WHILE reference # NIL DO
  194. IF reference IS ImmediateReference THEN
  195. WITH reference: ImmediateReference DO
  196. IF (reference.value = value) THEN
  197. foundReference := reference (* an entry already exists *)
  198. END;
  199. END;
  200. END;
  201. reference := reference.next
  202. END;
  203. IF foundReference # NIL THEN
  204. reference := foundReference
  205. ELSE
  206. (* no entry was found for the symbol/offset combination: create a new one *)
  207. NEW(immediateReference, value);
  208. reference := immediateReference;
  209. IF firstReference = NIL THEN firstReference := reference ELSE lastReference.next := reference END;
  210. lastReference := reference;
  211. INC(referenceCount)
  212. END;
  213. (* add a citation to the reference *)
  214. reference.AddCitation(pc);
  215. IF pcOfFirstCitation = None THEN pcOfFirstCitation := pc END
  216. END AddImmediate;
  217. END ListOfReferences;
  218. PhysicalRegisters* = OBJECT(CodeGenerators.PhysicalRegisters)
  219. VAR
  220. toVirtual: ARRAY InstructionSet.NumberRegisters OF Ticket; (* registers real register -> none / reserved / split / blocked / virtual register (>0) *)
  221. reserved: ARRAY InstructionSet.NumberRegisters OF BOOLEAN;
  222. unusable: Ticket;
  223. hint: LONGINT;
  224. useFPU: BOOLEAN;
  225. PROCEDURE & InitPhysicalRegisters(supportFramePointer, useFPU: BOOLEAN);
  226. VAR
  227. i: LONGINT;
  228. unusable: Ticket;
  229. BEGIN
  230. SELF.useFPU := useFPU;
  231. FOR i := 0 TO LEN(toVirtual) - 1 DO
  232. toVirtual[i] := NIL;
  233. reserved[i] := FALSE
  234. END;
  235. NEW(unusable);
  236. (* reserve special purpose registers *)
  237. toVirtual[InstructionSet.RES] := unusable; (* low part result register *)
  238. toVirtual[InstructionSet.RESHI] := unusable; (* high part result register *)
  239. toVirtual[InstructionSet.RESFS] := unusable; (* single precision floatin point result register *)
  240. toVirtual[InstructionSet.SP] := unusable; (* stack pointer *)
  241. toVirtual[InstructionSet.FP] := unusable; (* frame pointer *)
  242. toVirtual[InstructionSet.PC] := unusable; (* program counter *)
  243. toVirtual[InstructionSet.LR] := unusable; (* link register *)
  244. toVirtual[InstructionSet.CPSR] := unusable; (* current program state register *)
  245. toVirtual[InstructionSet.SPSR] := unusable; (* saved program state register *)
  246. (* disable coprocessor registers *)
  247. FOR i := InstructionSet.CR0 TO InstructionSet.CR15 DO toVirtual[i] := unusable END;
  248. IF ~useFPU THEN
  249. (* disable single precision VFP registers *)
  250. FOR i := InstructionSet.SR0 TO InstructionSet.SR15 DO toVirtual[i] := unusable END
  251. END;
  252. (* disable double precision VFP registers *)
  253. FOR i := InstructionSet.DR0 TO InstructionSet.DR15 DO toVirtual[i] := unusable END;
  254. END InitPhysicalRegisters;
  255. (** the number of physical registers **)
  256. PROCEDURE NumberRegisters(): LONGINT;
  257. BEGIN RETURN InstructionSet.NumberRegisters
  258. END NumberRegisters;
  259. (** allocate, i.e., map, a physical register to a ticket **)
  260. PROCEDURE Allocate(physicalRegisterNumber: LONGINT; ticket: Ticket);
  261. BEGIN
  262. ASSERT(~ticket.spilled);
  263. Assert(toVirtual[physicalRegisterNumber] = NIL,"register already allocated");
  264. toVirtual[physicalRegisterNumber] := ticket
  265. END Allocate;
  266. (** set whether a certain physical register is reserved or not **)
  267. PROCEDURE SetReserved(physicalRegisterNumber: LONGINT; isReserved: BOOLEAN);
  268. BEGIN reserved[physicalRegisterNumber] := isReserved
  269. END SetReserved;
  270. (** whether a certain physical register is reserved **)
  271. PROCEDURE Reserved(physicalRegisterNumber: LONGINT): BOOLEAN;
  272. BEGIN RETURN (physicalRegisterNumber > 0) & reserved[physicalRegisterNumber]
  273. END Reserved;
  274. (** free a certain physical register **)
  275. PROCEDURE Free(physicalRegisterNumber: LONGINT);
  276. BEGIN
  277. Assert((toVirtual[physicalRegisterNumber] # NIL), "register not reserved");
  278. toVirtual[physicalRegisterNumber] := NIL
  279. END Free;
  280. (** get the number of the next free physical register for a certain data type
  281. - if a register hint has been set, it is respected if possible
  282. **)
  283. PROCEDURE NextFree(CONST type: IntermediateCode.Type): LONGINT;
  284. VAR
  285. result, i: LONGINT;
  286. BEGIN
  287. result := None;
  288. IF (type.form IN IntermediateCode.Integer) OR ~useFPU THEN
  289. ASSERT(type.sizeInBits <= 32); (* integers of larger size have already been split *)
  290. (* allocate a regular general purpose ARM register *)
  291. FOR i := InstructionSet.R0 TO InstructionSet.R15 DO
  292. IF (toVirtual[i] = NIL) & ((result = None) OR (i = hint)) THEN result := i END
  293. END
  294. ELSIF type.form = IntermediateCode.Float THEN
  295. IF type.sizeInBits = 32 THEN
  296. (* allocate a single precision VFP register *)
  297. FOR i := InstructionSet.SR0 TO InstructionSet.SR31 DO
  298. IF (toVirtual[i] = NIL) & ((result = None) OR (i = hint)) THEN result := i END
  299. END
  300. ELSIF type.sizeInBits = 64 THEN
  301. (* allocate a double precision VFP register *)
  302. HALT(200); (* not supported yet *)
  303. ELSE
  304. HALT(100)
  305. END
  306. ELSE
  307. HALT(100)
  308. END;
  309. IF result # None THEN ASSERT(toVirtual[result] = NIL) END;
  310. RETURN result
  311. END NextFree;
  312. (** give the register allocator a hint on what physical register to use next **)
  313. PROCEDURE AllocationHint(physicalRegisterNumber: LONGINT);
  314. BEGIN hint := physicalRegisterNumber
  315. END AllocationHint;
  316. (** get the ticket that is currently mapped to a certain physical register **)
  317. PROCEDURE Mapped(physicalRegisterNumber: LONGINT): Ticket;
  318. BEGIN RETURN toVirtual[physicalRegisterNumber]
  319. END Mapped;
  320. (** dump the current register mapping to a stream **)
  321. PROCEDURE Dump(w: Streams.Writer);
  322. VAR i: LONGINT; virtual: Ticket;
  323. BEGIN
  324. w.String("---- registers ----"); w.Ln;
  325. FOR i := 0 TO LEN(toVirtual)-1 DO
  326. virtual := toVirtual[i];
  327. IF virtual # unusable THEN
  328. w.String("reg "); w.Int(i,1); w.String(": ");
  329. IF virtual = NIL THEN w.String("free")
  330. ELSE w.String(" r"); w.Int(virtual.register,1);
  331. END;
  332. IF reserved[i] THEN w.String("reserved") END;
  333. w.Ln
  334. END
  335. END
  336. END Dump;
  337. END PhysicalRegisters;
  338. CodeGeneratorARM = OBJECT(CodeGenerators.GeneratorWithTickets)
  339. VAR
  340. runtimeModuleName: SyntaxTree.IdentifierString;
  341. backend: BackendARM;
  342. opSP, opFP, opPC, opLR, opRES, opRESHI, opRESFS: InstructionSet.Operand;
  343. listOfReferences: ListOfReferences;
  344. spillStackStart, pushChainLength: LONGINT;
  345. stackSize: LONGINT; (* the size of the current stack frame *)
  346. stackSizeKnown: BOOLEAN; (* whether the size of the current stack frame is known at compile time *)
  347. inStackAllocation: BOOLEAN;
  348. fixupPattern: ObjectFile.FixupPatterns; (* pattern for an absolute 32-bit fixup *)
  349. PROCEDURE & InitGeneratorARM(CONST runtimeModuleName: SyntaxTree.IdentifierString; diagnostics: Diagnostics.Diagnostics; backend: BackendARM);
  350. VAR
  351. physicalRegisters: PhysicalRegisters;
  352. BEGIN
  353. SELF.runtimeModuleName := runtimeModuleName;
  354. SELF.backend := backend;
  355. IF Trace THEN IF backend.useFPU THEN D.String("use FPU"); D.Ln ELSE D.String("don't use FPU"); D.Ln END END;
  356. NEW(physicalRegisters, TRUE, backend.useFPU);
  357. InitTicketGenerator(diagnostics, backend.optimize, 2, physicalRegisters);
  358. error := FALSE;
  359. inStackAllocation := FALSE;
  360. pushChainLength := 0;
  361. opSP := InstructionSet.NewRegister(InstructionSet.SP, None, None, 0);
  362. opFP := InstructionSet.NewRegister(InstructionSet.FP, None, None, 0);
  363. opPC := InstructionSet.NewRegister(InstructionSet.PC, None, None, 0);
  364. opLR := InstructionSet.NewRegister(InstructionSet.LR, None, None, 0);
  365. opRES := InstructionSet.NewRegister(InstructionSet.RES, None, None, 0);
  366. opRESHI := InstructionSet.NewRegister(InstructionSet.RESHI, None, None, 0);
  367. opRESFS := InstructionSet.NewRegister(InstructionSet.RESFS, None, None, 0);
  368. dump := NIL;
  369. NEW(fixupPattern, 1);
  370. fixupPattern[0].offset := 0;
  371. fixupPattern[0].bits := 32;
  372. NEW(listOfReferences);
  373. END InitGeneratorARM;
  374. (*------------------- overwritten methods ----------------------*)
  375. (* TODO: revise this *)
  376. PROCEDURE Section(in: IntermediateCode.Section; out: BinaryCode.Section);
  377. VAR
  378. oldSpillStackSize: LONGINT;
  379. PROCEDURE CheckEmptySpillStack(): BOOLEAN;
  380. BEGIN
  381. IF spillStack.Size() # 0 THEN
  382. Error(inPC,"implementation error, spill stack not cleared");
  383. IF dump # NIL THEN
  384. spillStack.Dump(dump);
  385. tickets.Dump(dump)
  386. END;
  387. RETURN FALSE
  388. ELSE
  389. RETURN TRUE
  390. END
  391. END CheckEmptySpillStack;
  392. BEGIN
  393. stackSizeKnown := TRUE;
  394. stackSize := 0; (* TODO: ok? *)
  395. tickets.Init; spillStack.Init; listOfReferences.Init;
  396. Section^(in, out); (* pass 1 *)
  397. EmitFinalFixupBlock; (* force the emission of fixups for all references *)
  398. IF stackSizeKnown = FALSE THEN
  399. tickets.Init; spillStack.Init; listOfReferences.Init;
  400. out.Reset;
  401. Section^(in, out); (* pass 2 *)
  402. EmitFinalFixupBlock (* force the emission of fixups for all references *)
  403. END;
  404. IF CheckEmptySpillStack() & (spillStack.MaxSize() > 0) THEN
  405. listOfReferences.Init;
  406. oldSpillStackSize := spillStack.MaxSize();
  407. out.Reset;
  408. Section^(in, out); (* pass 3 *)
  409. EmitFinalFixupBlock; (* force the emission of fixups for all references *)
  410. ASSERT(spillStack.MaxSize() = oldSpillStackSize);
  411. END;
  412. IF CheckEmptySpillStack() THEN END
  413. END Section;
  414. (* TODO: complete this *)
  415. (** whether the code generator can generate code for a certain intermediate code intstruction
  416. if not, the location of a runtime is returned **)
  417. PROCEDURE Supported(CONST irInstruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  418. VAR
  419. result: BOOLEAN; value: HUGEINT; exp: LONGINT;
  420. BEGIN
  421. CASE irInstruction.opcode OF
  422. | IntermediateCode.add, IntermediateCode.sub, IntermediateCode.mul, IntermediateCode.abs, IntermediateCode.neg:
  423. IF (irInstruction.opcode = IntermediateCode.mul) & IsInteger(irInstruction.op1) & IsInteger(irInstruction.op2) & (IsComplex(irInstruction.op1) OR IsComplex(irInstruction.op2)) THEN
  424. result := FALSE;
  425. ELSE
  426. result := backend.useFPU & IsSinglePrecisionFloat(irInstruction.op1) OR ~IsFloat(irInstruction.op1)
  427. END;
  428. | IntermediateCode.div:
  429. result := backend.useFPU & IsSinglePrecisionFloat(irInstruction.op1);
  430. (*
  431. result := result OR IntermediateCode.IsConstantInteger(irInstruction.op3,value) & PowerOf2(value,exp)
  432. *)
  433. | IntermediateCode.conv:
  434. result := backend.useFPU & (IsSinglePrecisionFloat(irInstruction.op1) OR IsSinglePrecisionFloat(irInstruction.op2)) OR ~IsFloat(irInstruction.op1) & ~IsFloat(irInstruction.op2) (* if no FPU and either operand is a float *)
  435. | IntermediateCode.mod:
  436. result := FALSE;
  437. (*
  438. result := IntermediateCode.IsConstantInteger(irInstruction.op3,value) & PowerOf2(value,exp)
  439. *)
  440. | IntermediateCode.rol, IntermediateCode.ror:
  441. result := ~IsComplex(irInstruction.op1)
  442. ELSE
  443. result := TRUE
  444. END;
  445. IF ~result THEN
  446. COPY(runtimeModuleName, moduleName);
  447. GetRuntimeProcedureName(irInstruction, procedureName);
  448. END;
  449. RETURN result
  450. END Supported;
  451. (* determines the name of a runtime procedure to handle a certain IR instruction *)
  452. PROCEDURE GetRuntimeProcedureName(CONST irInstruction: IntermediateCode.Instruction; VAR resultingName: ARRAY OF CHAR);
  453. PROCEDURE AppendType(VAR string: ARRAY OF CHAR; type: IntermediateCode.Type);
  454. VAR
  455. sizeString: ARRAY 3 OF CHAR;
  456. BEGIN
  457. CASE type.form OF
  458. | IntermediateCode.SignedInteger: Strings.AppendChar(string, 'S')
  459. | IntermediateCode.UnsignedInteger: Strings.AppendChar(string, 'U')
  460. | IntermediateCode.Float:Strings.AppendChar(string, 'F')
  461. ELSE HALT(200)
  462. END;
  463. Strings.IntToStr(type.sizeInBits, sizeString); Strings.Append(string, sizeString)
  464. END AppendType;
  465. BEGIN
  466. COPY(IntermediateCode.instructionFormat[irInstruction.opcode].name, resultingName);
  467. Strings.UpperCaseChar(resultingName[0]);
  468. AppendType(resultingName, irInstruction.op1.type);
  469. IF irInstruction.op1.mode # IntermediateCode.Undefined THEN
  470. IF (irInstruction.op1.type.form # irInstruction.op2.type.form) OR (irInstruction.op1.type.sizeInBits # irInstruction.op2.type.sizeInBits) THEN
  471. AppendType(resultingName, irInstruction.op2.type);
  472. END
  473. END;
  474. IF Trace THEN D.Ln; D.String(" runtime procedure name: "); D.String(resultingName); D.Ln; D.Update END
  475. END GetRuntimeProcedureName;
  476. (* check whether the instruction modifies the stack pointer (outside of a stack allocation )*)
  477. PROCEDURE CheckStackPointer(CONST destination: Operand);
  478. BEGIN
  479. IF stackSizeKnown & ~inStackAllocation THEN
  480. IF (destination.mode = InstructionSet.modeRegister) & (destination.register = InstructionSet.SP) THEN
  481. IF dump # NIL THEN dump.String("stackSize unkown"); dump.Ln END;
  482. stackSizeKnown := FALSE
  483. END
  484. END
  485. END CheckStackPointer;
  486. (** emit an ARM instruction with an arbitrary amount of operands **)
  487. PROCEDURE Emit(opCode, condition: LONGINT; flags: SET; CONST operands: ARRAY InstructionSet.MaxOperands OF Operand);
  488. VAR
  489. i: LONGINT;
  490. BEGIN
  491. (* check whether the instruction modifies the stack pointer *)
  492. CheckStackPointer(operands[0]);
  493. (*
  494. (* dump the instruction *)
  495. IF Trace THEN
  496. D.String("opCode="); D.Int(opCode, 0); D.Ln;
  497. D.String("condition="); D.Int(condition, 0); D.Ln;
  498. D.String("flags="); D.Set(flags); D.Ln;
  499. FOR i := 0 TO InstructionSet.MaxOperands - 1 DO
  500. D.String("operand #"); D.Int(i, 0); D.String(": ");
  501. InstructionSet.DumpOperand(D.Log, operands[i]);
  502. D.Ln
  503. END;
  504. D.Ln;
  505. D.Ln
  506. END;
  507. *)
  508. (* emit the instruction *)
  509. InstructionSet.Emit(opCode, condition, flags, operands, out)
  510. END Emit;
  511. (** emit an ARM instruction with no operand **)
  512. PROCEDURE Emit0(opCode: LONGINT);
  513. VAR
  514. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  515. BEGIN
  516. ASSERT(InstructionSet.MaxOperands = 6);
  517. operands[0] := emptyOperand;
  518. operands[1] := emptyOperand;
  519. operands[2] := emptyOperand;
  520. operands[3] := emptyOperand;
  521. operands[4] := emptyOperand;
  522. operands[5] := emptyOperand;
  523. Emit(opCode, InstructionSet.unconditional, {}, operands)
  524. END Emit0;
  525. (** emit an ARM instruction with 1 operand **)
  526. PROCEDURE Emit1(opCode: LONGINT; op: Operand);
  527. VAR
  528. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  529. BEGIN
  530. ASSERT(InstructionSet.MaxOperands = 6);
  531. operands[0] := op;
  532. operands[1] := emptyOperand;
  533. operands[2] := emptyOperand;
  534. operands[3] := emptyOperand;
  535. operands[4] := emptyOperand;
  536. operands[5] := emptyOperand;
  537. Emit(opCode, InstructionSet.unconditional, {}, operands)
  538. END Emit1;
  539. (** emit an ARM instruction with 2 operands **)
  540. PROCEDURE Emit2(opCode: LONGINT; op1, op2: Operand);
  541. VAR
  542. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  543. BEGIN
  544. ASSERT(InstructionSet.MaxOperands = 6);
  545. operands[0] := op1;
  546. operands[1] := op2;
  547. operands[2] := emptyOperand;
  548. operands[3] := emptyOperand;
  549. operands[4] := emptyOperand;
  550. operands[5] := emptyOperand;
  551. Emit(opCode, InstructionSet.unconditional, {}, operands)
  552. END Emit2;
  553. (** emit an ARM instruction with 3 operands **)
  554. PROCEDURE Emit3(opCode: LONGINT; op1, op2, op3: Operand);
  555. VAR
  556. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  557. BEGIN
  558. ASSERT(InstructionSet.MaxOperands = 6);
  559. operands[0] := op1;
  560. operands[1] := op2;
  561. operands[2] := op3;
  562. operands[3] := emptyOperand;
  563. operands[4] := emptyOperand;
  564. operands[5] := emptyOperand;
  565. Emit(opCode, InstructionSet.unconditional, {}, operands)
  566. END Emit3;
  567. (** emit an ARM instruction with 4 operands **)
  568. PROCEDURE Emit4(opCode: LONGINT; op1, op2, op3, op4: Operand);
  569. VAR
  570. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  571. BEGIN
  572. ASSERT(InstructionSet.MaxOperands = 6);
  573. operands[0] := op1;
  574. operands[1] := op2;
  575. operands[2] := op3;
  576. operands[3] := op4;
  577. operands[4] := emptyOperand;
  578. operands[5] := emptyOperand;
  579. Emit(opCode, InstructionSet.unconditional, {}, operands)
  580. END Emit4;
  581. (** emit an ARM instruction with 6 operands **)
  582. PROCEDURE Emit6(opCode: LONGINT; op1, op2, op3, op4, op5, op6: Operand);
  583. VAR
  584. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  585. BEGIN
  586. ASSERT(InstructionSet.MaxOperands = 6);
  587. operands[0] := op1;
  588. operands[1] := op2;
  589. operands[2] := op3;
  590. operands[3] := op4;
  591. operands[4] := op5;
  592. operands[5] := op6;
  593. Emit(opCode, InstructionSet.unconditional, {}, operands)
  594. END Emit6;
  595. (** emit an ARM instruction with 2 operands and certain flags **)
  596. PROCEDURE Emit2WithFlags(opCode: LONGINT; op1, op2: Operand; flags: SET);
  597. VAR
  598. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  599. BEGIN
  600. ASSERT(InstructionSet.MaxOperands = 6);
  601. operands[0] := op1;
  602. operands[1] := op2;
  603. operands[2] := emptyOperand;
  604. operands[3] := emptyOperand;
  605. operands[4] := emptyOperand;
  606. operands[5] := emptyOperand;
  607. Emit(opCode, InstructionSet.unconditional, flags, operands)
  608. END Emit2WithFlags;
  609. (** emit an ARM instruction with 3 operands and certain flags **)
  610. PROCEDURE Emit3WithFlags(opCode: LONGINT; op1, op2, op3: Operand; flags: SET);
  611. VAR
  612. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  613. BEGIN
  614. ASSERT(InstructionSet.MaxOperands = 6);
  615. operands[0] := op1;
  616. operands[1] := op2;
  617. operands[2] := op3;
  618. operands[3] := emptyOperand;
  619. operands[4] := emptyOperand;
  620. operands[5] := emptyOperand;
  621. Emit(opCode, InstructionSet.unconditional, flags, operands)
  622. END Emit3WithFlags;
  623. (** emit an ARM instruction with 1 operand and a condition **)
  624. PROCEDURE Emit1WithCondition(opCode: LONGINT; op1: Operand; condition: LONGINT);
  625. VAR
  626. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  627. BEGIN
  628. ASSERT(InstructionSet.MaxOperands = 6);
  629. operands[0] := op1;
  630. operands[1] := emptyOperand;
  631. operands[2] := emptyOperand;
  632. operands[3] := emptyOperand;
  633. operands[4] := emptyOperand;
  634. operands[5] := emptyOperand;
  635. Emit(opCode, condition, {}, operands)
  636. END Emit1WithCondition;
  637. (** emit an ARM instruction with 2 operands and a condition **)
  638. PROCEDURE Emit2WithCondition(opCode: LONGINT; op1, op2: Operand; condition: LONGINT);
  639. VAR
  640. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  641. BEGIN
  642. ASSERT(InstructionSet.MaxOperands = 6);
  643. operands[0] := op1;
  644. operands[1] := op2;
  645. operands[2] := emptyOperand;
  646. operands[3] := emptyOperand;
  647. operands[4] := emptyOperand;
  648. operands[5] := emptyOperand;
  649. Emit(opCode, condition, {}, operands)
  650. END Emit2WithCondition;
  651. (** emit an ARM instruction with 3 operands and a condition **)
  652. PROCEDURE Emit3WithCondition(opCode: LONGINT; op1, op2, op3: Operand; condition: LONGINT);
  653. VAR
  654. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  655. BEGIN
  656. ASSERT(InstructionSet.MaxOperands = 6);
  657. operands[0] := op1;
  658. operands[1] := op2;
  659. operands[2] := op3;
  660. operands[3] := emptyOperand;
  661. operands[4] := emptyOperand;
  662. operands[5] := emptyOperand;
  663. Emit(opCode, condition, {}, operands)
  664. END Emit3WithCondition;
  665. (**
  666. - generate an arbitrary 32 bit value with as few as possible instructions and move the result into a specified target register
  667. - return the number of instructions required
  668. - if 'doEmit' is TRUE, emit the instructions
  669. **)
  670. PROCEDURE ValueComposition(value: LONGINT; doEmit: BOOLEAN; CONST targetRegister: Operand): LONGINT;
  671. VAR
  672. result: LONGINT;
  673. BEGIN
  674. IF doEmit THEN ASSERT(targetRegister.mode = InstructionSet.modeRegister) END;
  675. IF Trace & doEmit THEN D.Ln; D.String("original value: "); DBin(value, -32); D.String(" ("); D.Int(value, 0); D.String(") "); D.Ln; END;
  676. IF ValueComposition2(value, FALSE, emptyOperand) <= ValueComposition2(-value, FALSE, emptyOperand) + 1 THEN
  677. (* more efficient to calculate the value directly *)
  678. result := ValueComposition2(value, doEmit, targetRegister)
  679. ELSE
  680. (* more efficient to calculate the negation of the value and then negate it *)
  681. result := ValueComposition2(-value, doEmit, targetRegister) + 1;
  682. IF doEmit THEN
  683. Emit3(opRSB, targetRegister, targetRegister, InstructionSet.NewImmediate(0))
  684. END
  685. END;
  686. ASSERT((result >= 1) & (result <= 4));
  687. RETURN result
  688. END ValueComposition;
  689. (* note: used by 'ValueComposition'. do not call directly *)
  690. PROCEDURE ValueComposition2(value: LONGINT; doEmit: BOOLEAN; CONST targetRegister: Operand): LONGINT;
  691. VAR
  692. immediateOperand: Operand;
  693. result, position, partialValue, i: LONGINT;
  694. valueAsSet: SET;
  695. isFirst: BOOLEAN;
  696. BEGIN
  697. IF doEmit THEN ASSERT(targetRegister.mode = InstructionSet.modeRegister) END;
  698. IF Trace & doEmit THEN D.String("value to use: "); DBin(value, -32); D.String(" ("); D.Int(value, 0); D.String(") "); D.Ln; END;
  699. IF (value >= 0) & (value <= 255) THEN
  700. (* directly encodable as ARM immediate *)
  701. result := 1;
  702. IF doEmit THEN
  703. Emit2(opMOV, targetRegister, InstructionSet.NewImmediate(value))
  704. END
  705. ELSE
  706. valueAsSet := SYSTEM.VAL(SET, value);
  707. result := 0;
  708. position := 0;
  709. isFirst := TRUE;
  710. WHILE position < 32 DO
  711. IF (position IN valueAsSet) OR (position + 1 IN valueAsSet) THEN
  712. (* determine partial value for the 8 bit block *)
  713. partialValue := 0;
  714. FOR i := 7 TO 0 BY -1 DO
  715. partialValue := partialValue * 2;
  716. IF ((position + i) < 32) & ((position + i) IN valueAsSet) THEN INC(partialValue) END
  717. END;
  718. IF Trace & doEmit THEN
  719. D.String(" block found @ "); D.Int(position, 0); D.Ln;
  720. D.String(" unshifted partialValue: "); DBin(partialValue, -32); D.String(" ("); D.Int(partialValue, 0); D.String(") "); D.Ln;
  721. D.String(" shifted partialValue: "); DBin(ASH(partialValue, position), -32); D.String(" ("); D.Int(ASH(partialValue, position), 0); D.String(") "); D.Ln;
  722. END;
  723. ASSERT(~ODD(position));
  724. INC(result);
  725. IF doEmit THEN
  726. immediateOperand := InstructionSet.NewImmediate(ASH(partialValue, position)); (* TODO: check shift direction *)
  727. IF isFirst THEN
  728. Emit2(opMOV, targetRegister, immediateOperand);
  729. isFirst := FALSE
  730. ELSE
  731. Emit3(opADD, targetRegister, targetRegister, immediateOperand)
  732. END
  733. END;
  734. INC(position, 8)
  735. ELSE
  736. INC(position, 2)
  737. END
  738. END
  739. END;
  740. ASSERT((result >= 1) & (result <= 4));
  741. RETURN result
  742. END ValueComposition2;
  743. (** get the physical register number that corresponds to a virtual register number and part **)
  744. PROCEDURE PhysicalRegisterNumber(virtualRegisterNumber: LONGINT; part: LONGINT): LONGINT;
  745. VAR
  746. ticket: Ticket;
  747. result: LONGINT;
  748. BEGIN
  749. IF virtualRegisterNumber = IntermediateCode.FP THEN
  750. result := InstructionSet.FP
  751. ELSIF virtualRegisterNumber = IntermediateCode.SP THEN
  752. result := InstructionSet.SP
  753. ELSE
  754. ticket := virtualRegisters.Mapped(virtualRegisterNumber, part);
  755. IF ticket = NIL THEN
  756. result := None
  757. ELSE
  758. result := ticket.register
  759. END
  760. END;
  761. RETURN result
  762. END PhysicalRegisterNumber;
  763. (** get an ARM memory operand that represents a spill location (from a ticket) **)
  764. PROCEDURE GetSpillOperand(ticket: Ticket): Operand;
  765. VAR
  766. offset: LONGINT;
  767. result: Operand;
  768. BEGIN
  769. ASSERT(ticket.spilled);
  770. offset := spillStackStart + ticket.offset + 1; (* TODO: check this *)
  771. ASSERT((0 <= offset) & (offset < InstructionSet.Bits12));
  772. result := InstructionSet.NewImmediateOffsetMemory(PhysicalRegisterNumber(IntermediateCode.FP, Low), offset, {InstructionSet.Decrement});
  773. ASSERT(result.mode = InstructionSet.modeMemory);
  774. RETURN result
  775. END GetSpillOperand;
  776. (** get an ARM operand that represents a certain ticket (might be spilled or not) **)
  777. PROCEDURE OperandFromTicket(ticket: Ticket): Operand;
  778. VAR
  779. result: Operand;
  780. BEGIN
  781. ASSERT(ticket # NIL);
  782. IF ticket.spilled THEN
  783. (* the ticket is spilled *)
  784. result := GetSpillOperand(ticket)
  785. ELSE
  786. result := InstructionSet.NewRegister(ticket.register, None, None, 0)
  787. END;
  788. RETURN result
  789. END OperandFromTicket;
  790. (** get a free temporary register that holds data of a certain type **)
  791. PROCEDURE GetFreeRegister(CONST type: IntermediateCode.Type): Operand;
  792. VAR
  793. result: Operand;
  794. BEGIN
  795. result := OperandFromTicket(TemporaryTicket(IntermediateCode.GeneralPurposeRegister, type));
  796. ASSERT(result.mode = InstructionSet.modeRegister);
  797. RETURN result
  798. END GetFreeRegister;
  799. (** get a new free ARM register
  800. - if a register hint is provided that can hold data of the required type, it is returned instead
  801. **)
  802. PROCEDURE GetFreeRegisterOrHint(CONST type: IntermediateCode.Type; CONST registerHint: Operand): Operand;
  803. VAR
  804. result: Operand;
  805. BEGIN
  806. IF (registerHint.mode = InstructionSet.modeRegister) & IsRegisterForType(registerHint.register, type) THEN
  807. result := registerHint
  808. ELSE
  809. result := GetFreeRegister(type)
  810. END;
  811. ASSERT(result.mode = InstructionSet.modeRegister);
  812. RETURN result
  813. END GetFreeRegisterOrHint;
  814. (** whether a register can hold data of a certain IR type **)
  815. PROCEDURE IsRegisterForType(registerNumber: LONGINT; CONST type: IntermediateCode.Type): BOOLEAN;
  816. VAR
  817. result: BOOLEAN;
  818. BEGIN
  819. result := FALSE;
  820. IF type.form IN IntermediateCode.Integer THEN
  821. IF type.sizeInBits <= 32 THEN
  822. result := (registerNumber >= InstructionSet.R0) & (registerNumber <= InstructionSet.R15)
  823. END
  824. ELSIF type.form = IntermediateCode.Float THEN
  825. IF type.sizeInBits = 32 THEN
  826. result := (registerNumber >= InstructionSet.SR0) & (registerNumber <= InstructionSet.SR31)
  827. ELSE
  828. HALT(200)
  829. END
  830. ELSE
  831. HALT(100)
  832. END;
  833. RETURN result
  834. END IsRegisterForType;
  835. (** get an ARM register that that is set off by a certain amount **)
  836. PROCEDURE RegisterAfterAppliedOffset(register: Operand; offset: LONGINT; registerHint: Operand): Operand;
  837. VAR
  838. result, offsetOperand: Operand;
  839. BEGIN
  840. IF offset = 0 THEN
  841. result := register
  842. ELSE
  843. result := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  844. offsetOperand := OperandFromValue(ABS(offset), result); (* might be immediate operand or register (tempRegister is given as a register hint) *)
  845. IF offset > 0 THEN
  846. Emit3(opADD, result, register, offsetOperand)
  847. ELSE
  848. Emit3(opSUB, result, register, offsetOperand)
  849. END
  850. END;
  851. RETURN result
  852. END RegisterAfterAppliedOffset;
  853. (** get an ARM register from an IR register
  854. - use register hint if provided
  855. **)
  856. PROCEDURE RegisterFromIrRegister(CONST irRegisterOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  857. VAR
  858. result, offsetOperand, tempReg: Operand;
  859. BEGIN
  860. ASSERT(irRegisterOperand.mode = IntermediateCode.ModeRegister);
  861. result := InstructionSet.NewRegister(PhysicalRegisterNumber(irRegisterOperand.register, part), None, None, 0);
  862. result := RegisterAfterAppliedOffset(result, irRegisterOperand.offset, registerHint);
  863. ASSERT(result.mode = InstructionSet.modeRegister);
  864. RETURN result
  865. END RegisterFromIrRegister;
  866. PROCEDURE Load(targetRegister, memoryOperand: Operand; irType: IntermediateCode.Type);
  867. BEGIN
  868. IF (irType.form IN IntermediateCode.Integer) OR ~(backend.useFPU) THEN
  869. CASE irType.sizeInBits OF
  870. | 8: Emit2WithFlags(opLDR, targetRegister, memoryOperand, {InstructionSet.flagB}) (* LDRB *)
  871. | 16: Emit2WithFlags(opLDR, targetRegister, memoryOperand, {InstructionSet.flagH}) (* LDRH *)
  872. | 32: (* TM*)
  873. Emit2(opLDR, targetRegister, memoryOperand)
  874. ELSE HALT(100)
  875. END
  876. ELSIF irType.form = IntermediateCode.Float THEN
  877. ASSERT(irType.sizeInBits = 32, 200);
  878. Emit2(opFLDS, targetRegister, memoryOperand)
  879. ELSE
  880. HALT(100)
  881. END
  882. END Load;
  883. PROCEDURE Store(sourceRegister, memoryOperand: Operand; type: IntermediateCode.Type);
  884. BEGIN
  885. IF (type.form IN IntermediateCode.Integer) OR ~backend.useFPU THEN
  886. CASE type.sizeInBits OF
  887. | 8: Emit2WithFlags(opSTR, sourceRegister, memoryOperand, {InstructionSet.flagB}) (* STRB *)
  888. | 16: Emit2WithFlags(opSTR, sourceRegister, memoryOperand, {InstructionSet.flagH}) (* STRH *)
  889. | 32: Emit2(opSTR, sourceRegister, memoryOperand)
  890. ELSE HALT(100)
  891. END
  892. ELSIF type.form = IntermediateCode.Float THEN
  893. ASSERT(type.sizeInBits = 32, 200);
  894. Emit2(opFSTS, sourceRegister, memoryOperand)
  895. ELSE
  896. HALT(100)
  897. END
  898. END Store;
  899. (** get an ARM register that contains the address of a symbol/section
  900. - use register hint if provided **)
  901. PROCEDURE RegisterFromSymbol(symbol: Sections.SectionName; fingerprint: LONGINT; resolved: Sections.Section; symbolOffset: LONGINT; CONST registerHint: Operand): Operand;
  902. VAR
  903. address: LONGINT;
  904. result: Operand;
  905. irSection: IntermediateCode.Section;
  906. BEGIN
  907. IF resolved # NIL THEN
  908. irSection := resolved(IntermediateCode.Section);
  909. END;
  910. IF (irSection # NIL) & (irSection.resolved # NIL) & (irSection.resolved.os.fixed) THEN
  911. (* optimization: if the IR section is already resolved and positioned at a fixed location, no fixup is required *)
  912. address := irSection.resolved.os.alignment + irSection.instructions[symbolOffset].pc;
  913. result := RegisterFromValue(address, registerHint)
  914. ELSE
  915. result := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  916. listOfReferences.AddSymbol(symbol, fingerprint, symbolOffset, out.pc);
  917. Emit2(opLDR, result, InstructionSet.NewImmediateOffsetMemory(opPC.register, 0, {InstructionSet.Increment})); (* LDR ..., [PC, #+???] *)
  918. END;
  919. ASSERT(result.mode = InstructionSet.modeRegister);
  920. RETURN result
  921. END RegisterFromSymbol;
  922. (** get an ARM memory operand from an IR memory operand
  923. - note that the constraints on memory operands depend on the type of data (e.g., the allowed offset range is more restricted for memory operands on floating point values)
  924. **)
  925. PROCEDURE MemoryOperandFromIrMemoryOperand(VAR irMemoryOperand: IntermediateCode.Operand; part: LONGINT; CONST registerHint: Operand): Operand;
  926. VAR
  927. baseAddressRegisterNumber, offset: LONGINT;
  928. indexingMode: SET;
  929. result, baseAddressRegister, offsetRegister, tempRegister: Operand;
  930. BEGIN
  931. ASSERT(irMemoryOperand.mode = IntermediateCode.ModeMemory);
  932. (* determine base address register *)
  933. IF irMemoryOperand.register # IntermediateCode.None THEN
  934. (* case 1: [r1] or [r1 + 7] *)
  935. ASSERT(irMemoryOperand.symbol.name = "");
  936. baseAddressRegisterNumber := PhysicalRegisterNumber(irMemoryOperand.register, Low); (* addresses always are in the lower part *)
  937. ELSIF irMemoryOperand.symbol.name # "" THEN
  938. (* case 2: [symbol], [symbol:3], [symbol + 7] or [symbol:3 + 7] *)
  939. Resolve(irMemoryOperand);
  940. baseAddressRegister := RegisterFromSymbol(irMemoryOperand.symbol.name, irMemoryOperand.symbol.fingerprint, irMemoryOperand.resolved, irMemoryOperand.symbolOffset, registerHint);
  941. baseAddressRegisterNumber := baseAddressRegister.register
  942. ELSE
  943. (* case 3: [123456] *)
  944. ASSERT(irMemoryOperand.offset = 0);
  945. baseAddressRegister := RegisterFromValue(LONGINT(irMemoryOperand.intValue), registerHint);
  946. baseAddressRegisterNumber := baseAddressRegister.register
  947. END;
  948. ASSERT(baseAddressRegisterNumber # None);
  949. (* get offset of part in question *)
  950. offset := irMemoryOperand.offset + part * 4;
  951. (* determine indexing mode *)
  952. IF offset >= 0 THEN indexingMode := {InstructionSet.Increment} ELSE indexingMode := {InstructionSet.Decrement} END;
  953. IF irMemoryOperand.type.form IN IntermediateCode.Integer THEN
  954. (* regular ARM memory operand *)
  955. (*! LDRH supports only 8 bits immediates, while LDR and LDRB support 12 bits immediates *)
  956. IF ((irMemoryOperand.type.sizeInBits = 16) & (ABS(offset) < 256)) OR ((irMemoryOperand.type.sizeInBits # 16) & (ABS(offset) < InstructionSet.Bits12)) THEN
  957. (* offset can be encoded directly *)
  958. result := InstructionSet.NewImmediateOffsetMemory(baseAddressRegisterNumber, ABS(offset), indexingMode)
  959. ELSE
  960. (* offset has to be provided in a register *)
  961. offsetRegister := RegisterFromValue(ABS(offset), emptyOperand);
  962. result := InstructionSet.NewRegisterOffsetMemory(baseAddressRegisterNumber, offsetRegister.register, None, 0, indexingMode)
  963. END
  964. ELSIF irMemoryOperand.type.form = IntermediateCode.Float THEN
  965. (* VFP memory operand *)
  966. ASSERT((ABS(offset) MOD 4) = 0);
  967. IF ABS(offset) >= 1024 THEN
  968. (* offset cannot be encoded directly _> it has to be provided by means of an adapted base register *)
  969. tempRegister := RegisterFromValue(ABS(offset), emptyOperand);
  970. IF offset < 0 THEN
  971. Emit3(opSUB, tempRegister, tempRegister, baseAddressRegister)
  972. ELSE
  973. Emit3(opADD, tempRegister, tempRegister, baseAddressRegister)
  974. END;
  975. ReleaseHint(baseAddressRegister.register);
  976. baseAddressRegister := tempRegister;
  977. baseAddressRegisterNumber := baseAddressRegister.register;
  978. offset := 0;
  979. END;
  980. result := InstructionSet.NewImmediateOffsetMemory(baseAddressRegisterNumber, ABS(offset), indexingMode)
  981. ELSE
  982. HALT(100)
  983. END;
  984. ASSERT(result.mode = InstructionSet.modeMemory);
  985. RETURN result
  986. END MemoryOperandFromIrMemoryOperand;
  987. (** get an ARM immediate operand or register from any IR operand
  988. - if possible, the an immediate is returned
  989. - if needed, use register hint if provided
  990. **)
  991. PROCEDURE RegisterOrImmediateFromIrOperand(VAR irOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  992. VAR
  993. result: Operand;
  994. BEGIN
  995. IF IrOperandIsDirectlyEncodable(irOperand, part) THEN
  996. result := InstructionSet.NewImmediate(ValueOfPart(irOperand.intValue, part))
  997. ELSE
  998. result := RegisterFromIrOperand(irOperand, part, registerHint)
  999. END;
  1000. RETURN result
  1001. END RegisterOrImmediateFromIrOperand;
  1002. (** get an ARM register operand from any IR operand
  1003. - use register hint if provided
  1004. **)
  1005. PROCEDURE RegisterFromIrOperand(VAR irOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  1006. VAR
  1007. value: LONGINT;
  1008. result: Operand;
  1009. BEGIN
  1010. CASE irOperand.mode OF
  1011. | IntermediateCode.ModeRegister:
  1012. ASSERT((irOperand.intValue = 0) & (irOperand.symbol.name = ""));
  1013. result := RegisterFromIrRegister(irOperand, part, registerHint)
  1014. | IntermediateCode.ModeMemory:
  1015. result := GetFreeRegisterOrHint(PartType(irOperand.type, part), registerHint);
  1016. Load(result, MemoryOperandFromIrMemoryOperand(irOperand, part, result), PartType(irOperand.type, part))
  1017. | IntermediateCode.ModeImmediate:
  1018. ASSERT(irOperand.register = IntermediateCode.None);
  1019. IF irOperand.symbol.name # "" THEN
  1020. Resolve(irOperand);
  1021. result := RegisterFromSymbol(irOperand.symbol.name, irOperand.symbol.fingerprint, irOperand.resolved, irOperand.symbolOffset, emptyOperand);
  1022. result := RegisterAfterAppliedOffset(result, irOperand.offset, registerHint);
  1023. ELSE
  1024. ASSERT(irOperand.offset = 0);
  1025. IF IsInteger(irOperand) THEN result := RegisterFromValue(ValueOfPart(irOperand.intValue, part), registerHint)
  1026. ELSIF ~backend.useFPU THEN
  1027. IF IsSinglePrecisionFloat(irOperand) THEN
  1028. result := RegisterFromValue(BinaryCode.ConvertReal(SHORT(irOperand.floatValue)), registerHint)
  1029. ELSE
  1030. result := RegisterFromValue(ValueOfPart(BinaryCode.ConvertLongreal(irOperand.floatValue),part), registerHint);
  1031. END;
  1032. ELSIF IsSinglePrecisionFloat(irOperand) THEN result := SinglePrecisionFloatRegisterFromValue(REAL(irOperand.floatValue), registerHint)
  1033. ELSE HALT(200)
  1034. END
  1035. END
  1036. ELSE
  1037. HALT(100)
  1038. END;
  1039. ASSERT(result.mode = InstructionSet.modeRegister);
  1040. RETURN result
  1041. END RegisterFromIrOperand;
  1042. (** whether an IR operand is complex, i.e., requires more than one ARM operands to be represented **)
  1043. PROCEDURE IsComplex(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1044. VAR
  1045. result: BOOLEAN;
  1046. BEGIN
  1047. IF (irOperand.type.form IN IntermediateCode.Integer) OR ~backend.useFPU THEN
  1048. result := irOperand.type.sizeInBits > 32 (* integers above 32 bits have to be represented in multiple registers *)
  1049. ELSIF irOperand.type.form = IntermediateCode.Float THEN
  1050. result := FALSE (* for all types of floating point numbers there are dedicated VFP registers *)
  1051. ELSE
  1052. HALT(100)
  1053. END;
  1054. RETURN result
  1055. END IsComplex;
  1056. (** whether an IR operand hold a single precision floating point value **)
  1057. PROCEDURE IsSinglePrecisionFloat(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1058. BEGIN RETURN (irOperand.type.sizeInBits = 32) & (irOperand.type.form = IntermediateCode.Float)
  1059. END IsSinglePrecisionFloat;
  1060. (** whether an IR operand hold a single precision floating point value **)
  1061. PROCEDURE IsDoublePrecisionFloat(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1062. BEGIN RETURN (irOperand.type.sizeInBits = 64) & (irOperand.type.form = IntermediateCode.Float)
  1063. END IsDoublePrecisionFloat;
  1064. PROCEDURE IsFloat(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1065. BEGIN
  1066. RETURN irOperand.type.form = IntermediateCode.Float
  1067. END IsFloat;
  1068. (** whether an IR operand hold am integer value **)
  1069. PROCEDURE IsInteger(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1070. BEGIN RETURN irOperand.type.form IN IntermediateCode.Integer
  1071. END IsInteger;
  1072. PROCEDURE PartType(CONST type: IntermediateCode.Type; part: LONGINT): IntermediateCode.Type;
  1073. VAR
  1074. result: IntermediateCode.Type;
  1075. BEGIN
  1076. GetPartType(type, part, result);
  1077. RETURN result
  1078. END PartType;
  1079. (* the intermediate code type of a part
  1080. - a part type is by definition directly representable in a register *)
  1081. PROCEDURE GetPartType(CONST type: IntermediateCode.Type; part: LONGINT; VAR partType: IntermediateCode.Type);
  1082. BEGIN
  1083. ASSERT((part = Low) OR (part = High));
  1084. IF (type.form = IntermediateCode.Float) & backend.useFPU THEN
  1085. IF part = Low THEN
  1086. partType := type
  1087. ELSE
  1088. partType := IntermediateCode.undef
  1089. END
  1090. ELSIF (type.form IN IntermediateCode.Integer) OR ~backend.useFPU THEN
  1091. IF type.sizeInBits <= 32 THEN
  1092. IF part = Low THEN
  1093. partType := type
  1094. ELSE
  1095. partType := IntermediateCode.undef
  1096. END
  1097. ELSIF type.sizeInBits = 64 THEN
  1098. IF part = Low THEN
  1099. partType := IntermediateCode.NewType(IntermediateCode.UnsignedInteger, 32) (* conceptually the low part is always unsigned *)
  1100. ELSE
  1101. partType := IntermediateCode.NewType(type.form, 32)
  1102. END
  1103. ELSE
  1104. HALT(100)
  1105. END
  1106. ELSE
  1107. HALT(100)
  1108. END
  1109. END GetPartType;
  1110. (** the value of a 32 bit part **)
  1111. PROCEDURE ValueOfPart(value: HUGEINT; part: LONGINT): LONGINT;
  1112. VAR
  1113. result: LONGINT;
  1114. BEGIN
  1115. IF part = Low THEN
  1116. result := LONGINT(value) (* get the 32 least significant bits *)
  1117. ELSIF part = High THEN
  1118. result := LONGINT(ASH(value, -32)) (* get the 32 most significant bits *)
  1119. ELSE
  1120. HALT(100)
  1121. END;
  1122. RETURN result
  1123. END ValueOfPart;
  1124. (** whether a 32 bit value can be directly encoded as an ARM immediate (using a 8-bit base value and 4-bit half rotation) **)
  1125. PROCEDURE ValueIsDirectlyEncodable(value: LONGINT): BOOLEAN;
  1126. VAR
  1127. baseValue, halfRotation: LONGINT;
  1128. result: BOOLEAN;
  1129. BEGIN
  1130. result := InstructionSet.EncodeImmediate(value, baseValue, halfRotation);
  1131. RETURN result
  1132. END ValueIsDirectlyEncodable;
  1133. (* whether an IR operand (or part thereof) can be directly encoded as an ARM immediate *)
  1134. PROCEDURE IrOperandIsDirectlyEncodable(irOperand: IntermediateCode.Operand; part: LONGINT): BOOLEAN;
  1135. BEGIN RETURN
  1136. (irOperand.mode = IntermediateCode.ModeImmediate) &
  1137. (irOperand.symbol.name = "") &
  1138. (irOperand.type.form IN IntermediateCode.Integer) &
  1139. ValueIsDirectlyEncodable(ValueOfPart(irOperand.intValue, part))
  1140. END IrOperandIsDirectlyEncodable;
  1141. (* whether the negation of an IR operand (or part thereof) can be directly encoded as an ARM immediate *)
  1142. PROCEDURE NegatedIrOperandIsDirectlyEncodable(irOperand: IntermediateCode.Operand; part: LONGINT): BOOLEAN;
  1143. BEGIN RETURN
  1144. (irOperand.mode = IntermediateCode.ModeImmediate) &
  1145. (irOperand.symbol.name = "") &
  1146. (irOperand.type.form IN IntermediateCode.Integer) &
  1147. ValueIsDirectlyEncodable(ValueOfPart(-irOperand.intValue, part)) (* note the minus sign *)
  1148. END NegatedIrOperandIsDirectlyEncodable;
  1149. (** generate code for a certain IR instruction **)
  1150. PROCEDURE Generate(VAR irInstruction: IntermediateCode.Instruction);
  1151. VAR
  1152. ticket: Ticket;
  1153. (* hwreg, lastUse: LONGINT; *)
  1154. BEGIN
  1155. (* CheckFixups; *)
  1156. EmitFixupBlockIfNeeded;
  1157. (*
  1158. IF ((irInstruction.opcode = IntermediateCode.mov) OR (irInstruction.opcode = IntermediateCode.pop)) & (instruction.op1.register <= IntermediateCode.ParameterRegister) THEN
  1159. hwreg := ParameterRegister(IntermediateCode.ParameterRegister-instruction.op1.register, instruction.op1.type);
  1160. Spill(physicalRegisters.Mapped(hwreg));
  1161. lastUse := inPC+1;
  1162. WHILE (lastUse < in.pc) &
  1163. ((in.instructions[lastUse].opcode # IntermediateCode.push) OR (in.instructions[lastUse].op1.register # instruction.op1.register)) & (in.instructions[lastUse].opcode # IntermediateCode.call) DO
  1164. INC(lastUse)
  1165. END;
  1166. ticket := ReservePhysicalRegister(instruction.op1.type,hwreg,lastUse);
  1167. END;
  1168. *)
  1169. ReserveOperandRegisters(irInstruction.op1, TRUE);
  1170. ReserveOperandRegisters(irInstruction.op2, TRUE);
  1171. ReserveOperandRegisters(irInstruction.op3, TRUE);
  1172. CASE irInstruction.opcode OF
  1173. | IntermediateCode.nop: (* do nothing *)
  1174. | IntermediateCode.mov: EmitMov(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitMov(irInstruction, High) END
  1175. | IntermediateCode.conv: EmitConv(irInstruction)
  1176. | IntermediateCode.call: EmitCall(irInstruction)
  1177. | IntermediateCode.enter: EmitEnter(irInstruction)
  1178. | IntermediateCode.leave: EmitLeave(irInstruction)
  1179. | IntermediateCode.exit: EmitExit(irInstruction)
  1180. | IntermediateCode.return: EmitReturn(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitReturn(irInstruction, High) END;
  1181. | IntermediateCode.result: EmitResult(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitResult(irInstruction, High) END;
  1182. | IntermediateCode.trap: EmitTrap(irInstruction);
  1183. | IntermediateCode.br .. IntermediateCode.brlt: EmitBr(irInstruction)
  1184. | IntermediateCode.pop: EmitPop(irInstruction.op1, Low); IF IsComplex(irInstruction.op1) THEN EmitPop(irInstruction.op1, High) END
  1185. | IntermediateCode.push: IF IsComplex(irInstruction.op1) THEN EmitPush(irInstruction.op1, High) END; EmitPush(irInstruction.op1, Low)
  1186. | IntermediateCode.neg: EmitNeg(irInstruction)
  1187. | IntermediateCode.not: EmitNot(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitNot(irInstruction, High) END
  1188. | IntermediateCode.abs: EmitAbs(irInstruction)
  1189. | IntermediateCode.mul: EmitMul(irInstruction)
  1190. | IntermediateCode.div: EmitDiv(irInstruction)
  1191. | IntermediateCode.mod: EmitMod(irInstruction)
  1192. | IntermediateCode.sub, IntermediateCode.add: EmitAddOrSub(irInstruction)
  1193. | IntermediateCode.and: EmitAnd(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitAnd(irInstruction, High) END
  1194. | IntermediateCode.or: EmitOr(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitOr(irInstruction, High) END
  1195. | IntermediateCode.xor: EmitXor(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitXor(irInstruction, High) END
  1196. | IntermediateCode.shl: EmitShiftOrRotation(irInstruction)
  1197. | IntermediateCode.shr: EmitShiftOrRotation(irInstruction)
  1198. | IntermediateCode.rol: EmitShiftOrRotation(irInstruction)
  1199. | IntermediateCode.ror: EmitShiftOrRotation(irInstruction)
  1200. | IntermediateCode.copy: EmitCopy(irInstruction)
  1201. | IntermediateCode.fill: EmitFill(irInstruction, FALSE)
  1202. | IntermediateCode.asm: EmitAsm(irInstruction)
  1203. | IntermediateCode.special: EmitSpecial(irInstruction)
  1204. END;
  1205. ReserveOperandRegisters(irInstruction.op3, FALSE);
  1206. ReserveOperandRegisters(irInstruction.op2 ,FALSE);
  1207. ReserveOperandRegisters(irInstruction.op1, FALSE);
  1208. END Generate;
  1209. PROCEDURE PostGenerate(CONST instruction: IntermediateCode.Instruction);
  1210. VAR ticket: Ticket;
  1211. BEGIN
  1212. TryUnmap(instruction.op3); TryUnmap(instruction.op2); TryUnmap(instruction.op1);
  1213. ticket := tickets.live;
  1214. WHILE (ticket # NIL) & (ticket.lastuse = inPC) DO
  1215. UnmapTicket(ticket);
  1216. ticket := tickets.live
  1217. END;
  1218. END PostGenerate;
  1219. PROCEDURE EmitFinalFixupBlock;
  1220. BEGIN
  1221. IF listOfReferences.referenceCount > 0 THEN
  1222. ASSERT(in.pc > 0);
  1223. IF in.instructions[in.pc - 1].opcode # IntermediateCode.exit THEN
  1224. (* there is no exit instruction at the end of the IR section -> emit a branch that skips the fixup block (in particular used by @BodyStub procedures)*)
  1225. Emit1(opB, InstructionSet.NewImmediate((listOfReferences.referenceCount + 1) * 4 - 8))
  1226. END
  1227. END;
  1228. EmitFixupBlock; (* emit the fixup block *)
  1229. END EmitFinalFixupBlock;
  1230. (* if needed, emit fixup block for all used symbol references
  1231. - the fixup block is skipped by a branch instruction
  1232. - afterwards, the list of references is cleared
  1233. *)
  1234. PROCEDURE EmitFixupBlockIfNeeded;
  1235. BEGIN
  1236. IF out.pc - listOfReferences.pcOfFirstCitation + listOfReferences.referenceCount + 1 > MaximumFixupDistance THEN
  1237. Emit1(opB, InstructionSet.NewImmediate((listOfReferences.referenceCount + 1) * 4 - 8)); (* emit branch instruction that skips the fixup block *)
  1238. EmitFixupBlock; (* emit the fixup block *)
  1239. listOfReferences.Init (* clear the list *)
  1240. END
  1241. END EmitFixupBlockIfNeeded;
  1242. (* emit fixup block for all used symbol references, and clear the list *)
  1243. PROCEDURE EmitFixupBlock;
  1244. VAR
  1245. reference: Reference;
  1246. citation: Citation;
  1247. fixup: BinaryCode.Fixup;
  1248. patchValue: LONGINT;
  1249. identifier: ObjectFile.Identifier;
  1250. BEGIN
  1251. IF listOfReferences.referenceCount > 0 THEN
  1252. IF out.comments # NIL THEN
  1253. out.comments.String("REFERENCES BLOCK"); out.comments.String(" (");
  1254. out.comments.Int(listOfReferences.referenceCount, 0);
  1255. out.comments.String(" references):"); out.comments.Ln; out.comments.Update
  1256. END;
  1257. reference := listOfReferences.firstReference;
  1258. WHILE reference # NIL DO
  1259. (* 1. patch all of the citations, i.e., the LDR instructions that use the symbol reference *)
  1260. citation := reference.firstCitation;
  1261. WHILE citation # NIL DO
  1262. patchValue := out.pc - 8 - citation.pc;
  1263. ASSERT((0 <= patchValue) & (patchValue < InstructionSet.Bits12));
  1264. out.PutBitsAt(citation.pc, patchValue, 12);
  1265. citation := citation.next
  1266. END;
  1267. IF reference IS SymbolReference THEN
  1268. WITH reference: SymbolReference DO
  1269. (* alternative version that relies on the fixup mechanism:
  1270. NEW(fixupPattern12, 1);
  1271. fixupPattern12[0].offset := 0;
  1272. fixupPattern12[0].bits := 12;
  1273. fixup := BinaryCode.NewFixup(BinaryCode.Relative, entry.pc, in, 0, out.pc - 8, 0, fixupPattern12); (* TODO: determine the correct displacement *)
  1274. out.fixupList.AddFixup(fixup);
  1275. *)
  1276. (* 2. add an absolute fixup for the symbol reference and emit space *)
  1277. IF out.comments # NIL THEN
  1278. out.comments.String("fixup location for ");
  1279. Basic.WriteSegmentedName(out.comments, reference.symbol);
  1280. out.comments.String(":"); out.comments.Int(reference.symbolOffset, 0);
  1281. out.comments.String(" :"); out.comments.Ln; out.comments.Update
  1282. END;
  1283. identifier.name := reference.symbol;
  1284. identifier.fingerprint := reference.fingerprint;
  1285. fixup := BinaryCode.NewFixup(BinaryCode.Absolute, out.pc, identifier, reference.symbolOffset, 0, 0, fixupPattern);
  1286. out.fixupList.AddFixup(fixup);
  1287. out.PutBits(0, 32);
  1288. END;
  1289. ELSIF reference IS ImmediateReference THEN
  1290. WITH reference: ImmediateReference DO
  1291. IF out.comments # NIL THEN
  1292. out.comments.String("immediate value"); out.comments.Ln; out.comments.Update;
  1293. END;
  1294. out.PutBits(reference.value,32);
  1295. END
  1296. END;
  1297. reference := reference.next
  1298. END
  1299. END
  1300. END EmitFixupBlock;
  1301. (** get an ARM operand that hold a certain value
  1302. - if possible the value is returned as an ARM immediate operand
  1303. - otherwise a register is returned instead (if a register hint is present, it is used) **)
  1304. PROCEDURE OperandFromValue(value: LONGINT; registerHint: Operand): Operand;
  1305. VAR
  1306. result: Operand;
  1307. BEGIN
  1308. IF ValueIsDirectlyEncodable(value) THEN
  1309. result := InstructionSet.NewImmediate(value)
  1310. ELSE
  1311. result := RegisterFromValue(value, registerHint)
  1312. END;
  1313. RETURN result
  1314. END OperandFromValue;
  1315. (** get a single precision VFP register that holds a certain floating point value **)
  1316. PROCEDURE SinglePrecisionFloatRegisterFromValue(value: REAL; registerHint: Operand): Operand;
  1317. VAR
  1318. intValue, dummy: LONGINT;
  1319. result, temp: Operand;
  1320. BEGIN
  1321. intValue := SYSTEM.VAL(LONGINT, value);
  1322. (* alternative: integerValue := BinaryCode.ConvertReal(value) *)
  1323. temp := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  1324. dummy := ValueComposition(intValue, TRUE, temp);
  1325. result := GetFreeRegisterOrHint(IntermediateCode.FloatType(32), registerHint);
  1326. Emit2(opFMSR, result, temp);
  1327. ASSERT(result.mode = InstructionSet.modeRegister);
  1328. ASSERT((result.register >= InstructionSet.SR0) & (result.register <= InstructionSet.SR31));
  1329. RETURN result;
  1330. END SinglePrecisionFloatRegisterFromValue;
  1331. (** get an ARM register that holds a certain integer value
  1332. - if a register hint is present, it is used **)
  1333. PROCEDURE RegisterFromValue(value: LONGINT; registerHint: Operand): Operand;
  1334. VAR
  1335. dummy: LONGINT;
  1336. result: Operand;
  1337. BEGIN
  1338. result := GetFreeRegisterOrHint(IntermediateCode.SignedIntegerType(32), registerHint);
  1339. IF ValueComposition(value, FALSE, result) < 3 THEN
  1340. dummy := ValueComposition(value, TRUE, result);
  1341. ELSE
  1342. result := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  1343. listOfReferences.AddImmediate(value, out.pc);
  1344. Emit2(opLDR, result, InstructionSet.NewImmediateOffsetMemory(opPC.register, 0, {InstructionSet.Increment})); (* LDR ..., [PC, #+???] *)
  1345. END;
  1346. ASSERT(result.mode = InstructionSet.modeRegister);
  1347. ASSERT((result.register >= InstructionSet.R0) & (result.register <= InstructionSet.R15));
  1348. RETURN result
  1349. END RegisterFromValue;
  1350. (** allocate or deallocate on the stack
  1351. - note: updateStackSize is important as intermediate RETURNs should not change stack size
  1352. **)
  1353. PROCEDURE AllocateStack(allocationSize: LONGINT; doUpdateStackSize: BOOLEAN; clear: BOOLEAN);
  1354. VAR
  1355. operand, zero: InstructionSet.Operand; i: LONGINT;
  1356. BEGIN
  1357. inStackAllocation := TRUE;
  1358. operand := OperandFromValue(ABS(allocationSize), emptyOperand);
  1359. IF allocationSize > 0 THEN
  1360. IF clear THEN
  1361. Emit2(opMOV, InstructionSet.NewRegister(0, None, None, 0), InstructionSet.NewImmediate(0));
  1362. FOR i := 0 TO allocationSize-1 BY 4 DO
  1363. Emit2(opSTR, InstructionSet.NewRegister(0, None, None, 0), InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Decrement, InstructionSet.PreIndexed}));
  1364. END;
  1365. ELSE
  1366. Emit3(opSUB, opSP, opSP, operand) (* decreasing SP: allocation *)
  1367. END;
  1368. ELSIF allocationSize < 0 THEN
  1369. Emit3(opADD, opSP, opSP, operand) (* increasing SP: deallocation *)
  1370. END;
  1371. IF doUpdateStackSize THEN stackSize := stackSize + allocationSize END;
  1372. inStackAllocation := FALSE
  1373. END AllocateStack;
  1374. (** whether two ARM operands represent the same physical register **)
  1375. PROCEDURE IsSameRegister(CONST a, b: Operand): BOOLEAN;
  1376. BEGIN RETURN (a.mode = InstructionSet.modeRegister) & (b.mode = InstructionSet.modeRegister) & (a.register = b.register)
  1377. END IsSameRegister;
  1378. (** emit a MOV instruction if the two operands do not represent the same register
  1379. - for moves involving floating point registers special VFP instructions opFCPYS, opFMSR and opFMRS are used
  1380. **)
  1381. PROCEDURE MovIfDifferent(CONST a, b: Operand);
  1382. BEGIN
  1383. IF ~IsSameRegister(a, b) THEN
  1384. ASSERT(a.mode = InstructionSet.modeRegister);
  1385. IF IsRegisterForType(a.register, IntermediateCode.FloatType(32)) THEN
  1386. IF IsRegisterForType(b.register, IntermediateCode.FloatType(32)) THEN
  1387. (* mov float, float: *)
  1388. Emit2(opFCPYS, a, b)
  1389. ELSE
  1390. (* mov float, int: *)
  1391. Emit2(opFMSR, a, b)
  1392. END
  1393. ELSE
  1394. IF IsRegisterForType(b.register, IntermediateCode.FloatType(32)) THEN
  1395. (* mov int, float: *)
  1396. Emit2(opFMRS, a, b)
  1397. ELSE
  1398. (* mov int, int: *)
  1399. Emit2(opMOV, a, b)
  1400. END
  1401. END
  1402. END
  1403. END MovIfDifferent;
  1404. (** acquire an ARM register fr oa IR destination operand part
  1405. - if IR operand is a memory location, get a temporary register (if provided the hinted register is used)
  1406. - if IR operand is an IR register, get the ARM register that is mapped to the corresponding part
  1407. **)
  1408. PROCEDURE AcquireDestinationRegister(CONST irDestinationOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  1409. VAR
  1410. result: Operand;
  1411. BEGIN
  1412. IF irDestinationOperand.mode = IntermediateCode.ModeMemory THEN
  1413. result := GetFreeRegisterOrHint(PartType(irDestinationOperand.type, part), registerHint)
  1414. ELSIF irDestinationOperand.mode = IntermediateCode.ModeRegister THEN
  1415. ASSERT(irDestinationOperand.offset = 0);
  1416. IF virtualRegisters.Mapped(irDestinationOperand.register, part) = NIL THEN TryAllocate(irDestinationOperand, part) END; (* create the mapping if not yet done *)
  1417. result := InstructionSet.NewRegister(PhysicalRegisterNumber(irDestinationOperand.register, part), None, None, 0)
  1418. ELSE
  1419. HALT(100)
  1420. END;
  1421. ASSERT(result.mode = InstructionSet.modeRegister);
  1422. RETURN result
  1423. END AcquireDestinationRegister;
  1424. (** write the content of an ARM register to an IR destination operand (memory location or IR register)
  1425. - afterwards, try to release the register
  1426. **)
  1427. PROCEDURE WriteBack(VAR irDestinationOperand: IntermediateCode.Operand; part: LONGINT; register: Operand);
  1428. VAR
  1429. mappedArmRegister: Operand;
  1430. BEGIN
  1431. ASSERT(register.mode = InstructionSet.modeRegister);
  1432. IF irDestinationOperand.mode = IntermediateCode.ModeMemory THEN
  1433. Store(register, MemoryOperandFromIrMemoryOperand(irDestinationOperand, part, emptyOperand), PartType(irDestinationOperand.type, part))
  1434. ELSIF irDestinationOperand.mode = IntermediateCode.ModeRegister THEN
  1435. ASSERT((virtualRegisters.Mapped(irDestinationOperand.register, part) # NIL)
  1436. OR (irDestinationOperand.register = IntermediateCode.SP)
  1437. OR (irDestinationOperand.register = IntermediateCode.FP));
  1438. mappedArmRegister := InstructionSet.NewRegister(PhysicalRegisterNumber(irDestinationOperand.register, part), None, None, 0);
  1439. MovIfDifferent(mappedArmRegister, register)
  1440. ELSE
  1441. HALT(100)
  1442. END;
  1443. ReleaseHint(register.register)
  1444. END WriteBack;
  1445. PROCEDURE ZeroExtendOperand(operand: Operand; sizeInBits: LONGINT);
  1446. BEGIN
  1447. ASSERT(sizeInBits <= 32);
  1448. IF operand.mode = InstructionSet.modeRegister THEN
  1449. IF sizeInBits = 8 THEN
  1450. Emit3(opAND, operand, operand, InstructionSet.NewImmediate(255)); (* AND reg, reg, 11111111b *)
  1451. ELSIF sizeInBits = 16 THEN
  1452. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftLSL, None, 16));
  1453. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftLSR, None, 16))
  1454. ELSIF sizeInBits = 32 THEN
  1455. (* nothing to do *)
  1456. ELSE
  1457. HALT(100)
  1458. END
  1459. END
  1460. END ZeroExtendOperand;
  1461. PROCEDURE SignExtendOperand(operand: Operand; sizeInBits: LONGINT);
  1462. BEGIN
  1463. ASSERT(sizeInBits <= 32);
  1464. IF operand.mode = InstructionSet.modeRegister THEN
  1465. IF sizeInBits < 32 THEN
  1466. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftLSL, None, 32 - sizeInBits));
  1467. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftASR, None, 32 - sizeInBits))
  1468. END
  1469. END
  1470. END SignExtendOperand;
  1471. (** sign or zero-extends the content of an operand to 32 bits, depending on the IR type **)
  1472. PROCEDURE SignOrZeroExtendOperand(operand: Operand; irType: IntermediateCode.Type);
  1473. BEGIN
  1474. ASSERT(irType.sizeInBits <= 32);
  1475. IF irType.form = IntermediateCode.UnsignedInteger THEN
  1476. ZeroExtendOperand(operand, irType.sizeInBits)
  1477. ELSE
  1478. SignExtendOperand(operand, irType.sizeInBits)
  1479. END
  1480. END SignOrZeroExtendOperand;
  1481. (* ACTUAL CODE GENERATION *)
  1482. PROCEDURE EmitPush(VAR irOperand: IntermediateCode.Operand; part: LONGINT);
  1483. VAR
  1484. register: Operand;
  1485. partType: IntermediateCode.Type;
  1486. (*pc: LONGINT;*)
  1487. BEGIN
  1488. register := RegisterFromIrOperand(irOperand, part, emptyOperand);
  1489. IF ~IsRegisterForType(register.register, IntermediateCode.FloatType(32)) THEN
  1490. Emit2(opSTR, register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Decrement, InstructionSet.PreIndexed}));
  1491. ELSE
  1492. partType := PartType(irOperand.type, part);
  1493. AllocateStack(MAX(4, partType.sizeInBits DIV 8), TRUE,FALSE);
  1494. Store(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}), PartType(irOperand.type, part));
  1495. END;
  1496. (*
  1497. (* optimization for push chains (THIS DOES NOT WORK IF inEmulation) *)
  1498. IF pushChainLength = 0 THEN
  1499. pc := inPC;
  1500. (* search for consecutive push instructions *)
  1501. WHILE (pc < in.pc) & (in.instructions[pc].opcode = IntermediateCode.push) DO
  1502. ASSERT(in.instructions[pc].op1.mode # IntermediateCode.Undefined);
  1503. INC(pushChainLength, MAX(4, in.instructions[pc].op1.type.sizeInBits DIV 8));
  1504. INC(pc)
  1505. END;
  1506. AllocateStack(pushChainLength, TRUE)
  1507. END;
  1508. DEC(pushChainLength, 4); (* for 64 bit operands, this procedure is executed twice -> the push chain will be decremented by 8 bytes *)
  1509. register := RegisterFromIrOperand(irOperand, part, emptyOperand);
  1510. ASSERT(pushChainLength < InstructionSet.Bits12, 100);
  1511. ASSERT((pushChainLength MOD 4) = 0);
  1512. Store(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, pushChainLength, {InstructionSet.Increment}), PartType(irOperand.type, part))
  1513. *)
  1514. END EmitPush;
  1515. PROCEDURE EmitPop(VAR irOperand: IntermediateCode.Operand; part: LONGINT);
  1516. VAR
  1517. register: Operand; partType: IntermediateCode.Type;
  1518. BEGIN
  1519. register := AcquireDestinationRegister(irOperand, part, emptyOperand);
  1520. IF ~IsRegisterForType(register.register, IntermediateCode.FloatType(32)) THEN
  1521. (*Emit2(opLDR, register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment, InstructionSet.PostIndexed}));*)
  1522. Load(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment, InstructionSet.PostIndexed}), PartType(irOperand.type, part));
  1523. ELSE
  1524. Load(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}), PartType(irOperand.type, part));
  1525. partType := PartType(irOperand.type, part);
  1526. AllocateStack(-MAX(4, partType.sizeInBits DIV 8), TRUE,FALSE);
  1527. END;
  1528. WriteBack(irOperand, part, register)
  1529. END EmitPop;
  1530. PROCEDURE Resolve(VAR op: IntermediateCode.Operand);
  1531. BEGIN
  1532. IF (op.symbol.name # "") & (op.resolved = NIL) THEN op.resolved := module.allSections.FindByName(op.symbol.name) END
  1533. END Resolve;
  1534. (* call <address>, <parSize> *)
  1535. PROCEDURE EmitCall(VAR irInstruction: IntermediateCode.Instruction);
  1536. VAR
  1537. code: BinaryCode.Section;
  1538. fixup, newFixup: BinaryCode.Fixup;
  1539. BEGIN
  1540. Resolve(irInstruction.op1);
  1541. IF (irInstruction.op1.resolved # NIL) & (irInstruction.op1.resolved.type = Sections.InlineCodeSection) THEN
  1542. (* call of an inline procedure: *)
  1543. code := irInstruction.op1.resolved(IntermediateCode.Section).resolved;
  1544. ASSERT(code # NIL); (* TODO: what if section is not yet resolved, i.e., code has not yet been generated? *)
  1545. IF (out.comments # NIL) THEN
  1546. out.comments.String("inlined code sequence:");
  1547. out.comments.Ln;
  1548. out.comments.Update;
  1549. END;
  1550. (* emit the generated code of the other section *)
  1551. out.CopyBits(code.os.bits, 0, code.os.bits.GetSize());
  1552. (* transfer the fixups *)
  1553. fixup := code.fixupList.firstFixup;
  1554. WHILE fixup # NIL DO
  1555. newFixup := BinaryCode.NewFixup(fixup.mode, fixup.offset + code.pc, fixup.symbol, fixup.symbolOffset, fixup.displacement, fixup.scale, fixup.pattern);
  1556. out.fixupList.AddFixup(newFixup);
  1557. fixup := fixup.nextFixup
  1558. END
  1559. ELSE
  1560. (* store the address of the procedure in a register and branch and link there *)
  1561. Emit1(opBLX, RegisterFromIrOperand(irInstruction.op1, Low, emptyOperand));
  1562. (* remove parameters on stack *)
  1563. AllocateStack(-LONGINT(irInstruction.op2.intValue), TRUE, FALSE)
  1564. END
  1565. END EmitCall;
  1566. (* enter <callingConvention>, <pafSize>, <numRegParams> *)
  1567. PROCEDURE EmitEnter(CONST irInstruction: IntermediateCode.Instruction);
  1568. VAR allocationSize: LONGINT;
  1569. BEGIN
  1570. (* STMFD (Full Descending) aka STMDB (Decrement Before) *)
  1571. IF (irInstruction.op1.intValue = SyntaxTree.InterruptCallingConvention) THEN (* TODO: needed? *)
  1572. (* push R0-R11, FP and LR *)
  1573. Emit2WithFlags(opSTM, opSP, InstructionSet.NewRegisterList(0, {0..11, InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagDB, InstructionSet.flagBaseRegisterUpdate});
  1574. stackSize := 14*4;
  1575. ELSE
  1576. (* push FP and LR *)
  1577. Emit2WithFlags(opSTM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagDB, InstructionSet.flagBaseRegisterUpdate});
  1578. stackSize := 2*4;
  1579. (* altenative:
  1580. AllocateStack(2 * 4, TRUE);
  1581. Emit2(opSTR, opFP, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment}));
  1582. Emit2(opSTR, opLR, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}))
  1583. *)
  1584. END;
  1585. Emit2(opMOV, opFP, opSP);
  1586. allocationSize := LONGINT(irInstruction.op2.intValue);
  1587. Basic.Align(allocationSize, 4); (* 4 byte alignment *)
  1588. (* allocate space on stack for local variables *)
  1589. AllocateStack(allocationSize, TRUE, backend.initLocals);
  1590. (* allocate space on stack for register spills *)
  1591. spillStackStart := stackSize; IF spillStack.MaxSize() > 0 THEN AllocateStack(spillStack.MaxSize(), TRUE, FALSE) END
  1592. END EmitEnter;
  1593. (* leave <callingConvention> *)
  1594. PROCEDURE EmitLeave(CONST irInstruction: IntermediateCode.Instruction);
  1595. BEGIN
  1596. Emit2(opMOV, opSP, opFP);
  1597. (* LDMFD (Full Descending) aka LDMIA (Increment After) *)
  1598. IF (irInstruction.op1.intValue = SyntaxTree.InterruptCallingConvention) THEN
  1599. (* pop R0-R11, FP and LR *)
  1600. Emit2WithFlags(opLDM, opSP, InstructionSet.NewRegisterList(0, {0..11, InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagIA, InstructionSet.flagBaseRegisterUpdate})
  1601. ELSE
  1602. (* pop FP and LR *)
  1603. Emit2WithFlags(opLDM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagIA, InstructionSet.flagBaseRegisterUpdate})
  1604. (* alternative:
  1605. Emit2(opLDR, opFP, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment}));
  1606. Emit2(opLDR, opLR, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}));
  1607. AllocateStack(-2 * 4, TRUE)
  1608. *)
  1609. END
  1610. END EmitLeave;
  1611. (* exit <parSize>, <pcOffset> *)
  1612. PROCEDURE EmitExit(CONST irInstruction: IntermediateCode.Instruction);
  1613. BEGIN
  1614. IF (irInstruction.op1.intValue = 0) & (irInstruction.op2.intValue # SyntaxTree.InterruptCallingConvention) THEN
  1615. (* Emit2(opMOV, opPC, opLR) *)
  1616. Emit1(opBX, opLR) (* recommended for better interoperability between ARM and Thumb *)
  1617. ELSE
  1618. IF (irInstruction.op2.intValue = SyntaxTree.InterruptCallingConvention) THEN
  1619. Emit3WithFlags(opSUB, opPC, opLR, InstructionSet.NewImmediate(LONGINT(irInstruction.op1.intValue)),{InstructionSet.flagS})
  1620. ELSE
  1621. (* exit from an ARM interrupt procedure that has a PC offset *)
  1622. Emit3(opSUB, opPC, opLR, InstructionSet.NewImmediate(LONGINT(irInstruction.op1.intValue)))
  1623. END;
  1624. END
  1625. END EmitExit;
  1626. PROCEDURE EmitMov(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1627. VAR
  1628. destinationRegister, sourceOperand: Operand;
  1629. BEGIN
  1630. IF irInstruction.op1.mode # IntermediateCode.ModeRegister THEN
  1631. (* optimization: mov [?], r? it is more optimal to determine the source operand first *)
  1632. sourceOperand := RegisterOrImmediateFromIrOperand(irInstruction.op2, part, emptyOperand);
  1633. destinationRegister := GetFreeRegisterOrHint(PartType(irInstruction.op2.type, part), sourceOperand) (* note that the source operand (possibly a register) is used as hint *)
  1634. ELSE
  1635. PrepareSingleSourceOpWithImmediate(irInstruction, part, destinationRegister, sourceOperand);
  1636. END;
  1637. MovIfDifferent(destinationRegister, sourceOperand);
  1638. WriteBack(irInstruction.op1, part, destinationRegister)
  1639. END EmitMov;
  1640. (* BITWISE LOGICAL OPERATIONS *)
  1641. PROCEDURE EmitNot(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1642. VAR
  1643. destination, source: Operand;
  1644. BEGIN
  1645. PrepareSingleSourceOpWithImmediate(irInstruction, part, destination, source);
  1646. Emit2(opMVN, destination, source); (* invert bits *)
  1647. WriteBack(irInstruction.op1, part, destination)
  1648. END EmitNot;
  1649. PROCEDURE EmitAnd(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1650. VAR
  1651. dummy: BOOLEAN;
  1652. destination, left, right: Operand;
  1653. BEGIN
  1654. PrepareDoubleSourceOpWithImmediate(irInstruction, part, destination, left, right, dummy);
  1655. Emit3(opAND, destination, left, right);
  1656. WriteBack(irInstruction.op1, part, destination)
  1657. END EmitAnd;
  1658. PROCEDURE EmitOr(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1659. VAR
  1660. dummy: BOOLEAN;
  1661. destination, left, right: Operand;
  1662. BEGIN
  1663. PrepareDoubleSourceOpWithImmediate(irInstruction, part, destination, left, right, dummy);
  1664. Emit3(opORR, destination, left, right);
  1665. WriteBack(irInstruction.op1, part, destination)
  1666. END EmitOr;
  1667. PROCEDURE EmitXor(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1668. VAR
  1669. dummy: BOOLEAN;
  1670. destination, left, right: Operand;
  1671. BEGIN
  1672. PrepareDoubleSourceOpWithImmediate(irInstruction, part, destination, left, right, dummy);
  1673. Emit3(opEOR, destination, left, right);
  1674. WriteBack(irInstruction.op1, part, destination)
  1675. END EmitXor;
  1676. (* ARITHMETIC OPERATIONS *)
  1677. (*
  1678. - TODO: double precision floats
  1679. - note that for operand sizes 8 and 16, the unused bits of the result might be in a unpredictable state (sign/zero-extension is not done on purpose)
  1680. *)
  1681. PROCEDURE EmitAddOrSub(VAR irInstruction: IntermediateCode.Instruction);
  1682. VAR
  1683. destination, left, right: Operand;
  1684. (* registerSR0, registerSR1, registerSR2: Operand; *)
  1685. BEGIN
  1686. IF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1687. ASSERT(backend.useFPU);
  1688. PrepareDoubleSourceOp(irInstruction, Low, destination, left, right);
  1689. IF irInstruction.opcode = IntermediateCode.add THEN
  1690. Emit3(opFADDS, destination, left, right)
  1691. ELSE
  1692. Emit3(opFSUBS, destination, left, right)
  1693. END;
  1694. WriteBack(irInstruction.op1, Low, destination)
  1695. ELSIF IsInteger(irInstruction.op1) THEN
  1696. IF IsComplex(irInstruction.op1) THEN
  1697. EmitPartialAddOrSub(irInstruction, Low, TRUE);
  1698. EmitPartialAddOrSub(irInstruction, High, FALSE)
  1699. ELSE
  1700. EmitPartialAddOrSub(irInstruction, Low, FALSE)
  1701. END
  1702. ELSE
  1703. HALT(200)
  1704. END
  1705. END EmitAddOrSub;
  1706. PROCEDURE EmitPartialAddOrSub(CONST irInstruction: IntermediateCode.Instruction; part: LONGINT; doUpdateFlags: BOOLEAN);
  1707. VAR
  1708. destination, left, right, hint: Operand;
  1709. irDestination, irLeft, irRight: IntermediateCode.Operand;
  1710. operation: LONGINT;
  1711. doSwap, doNegateRight: BOOLEAN;
  1712. BEGIN
  1713. irDestination := irInstruction.op1; irLeft := irInstruction.op2; irRight := irInstruction.op3;
  1714. doSwap := FALSE; doNegateRight := FALSE; (* defaults *)
  1715. IF irInstruction.opcode = IntermediateCode.add THEN
  1716. IF IrOperandIsDirectlyEncodable(irRight, part) THEN
  1717. (* add r0, r1, 16 ~> ADD R0, R1, #16 *)
  1718. operation := opADD
  1719. ELSIF IrOperandIsDirectlyEncodable(irLeft, part) THEN
  1720. (* add r0, 16, r1 ~> ADD R0, R1, #16 *)
  1721. operation := opADD; doSwap := TRUE
  1722. ELSIF NegatedIrOperandIsDirectlyEncodable(irRight, part) THEN
  1723. (* add r0, r1, -16 ~> SUB R0, R1, #16 *)
  1724. operation := opSUB; doNegateRight := TRUE
  1725. ELSIF NegatedIrOperandIsDirectlyEncodable(irLeft, part) THEN
  1726. (* add r0, -16, r1 ~> SUB R0, R1, #16 *)
  1727. operation := opSUB; doSwap := TRUE; doNegateRight := TRUE
  1728. ELSE
  1729. operation := opADD
  1730. END
  1731. ELSIF irInstruction.opcode = IntermediateCode.sub THEN
  1732. IF IrOperandIsDirectlyEncodable(irRight, part) THEN
  1733. (* sub r0, r1, 16 ~> SUB R0, R1, #16 *)
  1734. operation := opSUB
  1735. ELSIF IrOperandIsDirectlyEncodable(irLeft, part) THEN
  1736. (* sub r0, 16, r1 ~> RSB R0, R1, #16 *)
  1737. operation := opRSB; doSwap := TRUE
  1738. ELSIF NegatedIrOperandIsDirectlyEncodable(irRight, part) THEN
  1739. (* sub r0, r1, -16 ~> ADD R0, R1, #16 *)
  1740. operation := opADD; doNegateRight := TRUE
  1741. ELSE
  1742. operation := opSUB
  1743. END
  1744. ELSE
  1745. HALT(100)
  1746. END;
  1747. (* get destination operand *)
  1748. destination := AcquireDestinationRegister(irDestination, part, emptyOperand);
  1749. (* get source operands *)
  1750. IF doSwap THEN SwapIrOperands(irLeft, irRight) END; (* if needed, swap operands *)
  1751. (* TODO: revise this! *)
  1752. IF IsSameRegister(right, destination) THEN hint := destination ELSE hint := emptyOperand END;
  1753. left := RegisterFromIrOperand(irLeft, part, hint);
  1754. IF doNegateRight THEN
  1755. ASSERT(NegatedIrOperandIsDirectlyEncodable(irRight, part));
  1756. right := InstructionSet.NewImmediate(-ValueOfPart(irRight.intValue, part))
  1757. ELSE
  1758. right := RegisterOrImmediateFromIrOperand(irRight, part, emptyOperand)
  1759. END;
  1760. (* if needed, use operation that incorporates carry *)
  1761. IF part # Low THEN
  1762. CASE operation OF
  1763. | opADD: operation := opADC
  1764. | opSUB: operation := opSBC
  1765. | opRSB: operation := opRSC
  1766. ELSE HALT(100)
  1767. END
  1768. END;
  1769. IF doUpdateFlags THEN
  1770. Emit3WithFlags(operation, destination, left, right, {InstructionSet.flagS})
  1771. ELSE
  1772. Emit3(operation, destination, left, right)
  1773. END;
  1774. WriteBack(irDestination, part, destination)
  1775. END EmitPartialAddOrSub;
  1776. PROCEDURE EmitMul(VAR irInstruction: IntermediateCode.Instruction);
  1777. VAR
  1778. destination, left, right: ARRAY 2 OF Operand;
  1779. BEGIN
  1780. IF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1781. ASSERT(backend.useFPU);
  1782. PrepareDoubleSourceOp(irInstruction, Low, destination[Low], left[Low], right[Low]);
  1783. Emit3(opFMULS, destination[Low], left[Low], right[Low]);
  1784. WriteBack(irInstruction.op1, Low, destination[Low])
  1785. ELSIF IsInteger(irInstruction.op1) THEN
  1786. IF IsComplex(irInstruction.op1) THEN
  1787. ASSERT(irInstruction.op1.type.form = IntermediateCode.SignedInteger);
  1788. HALT(200);
  1789. (* TODO: fix signed 64 bit integer multiplication:
  1790. PrepareDoubleSourceOp(irInstruction, Low, destination[Low], left[Low], right[Low]);
  1791. PrepareDoubleSourceOp(irInstruction, High, destination[High], left[High], right[High]);
  1792. Emit4(opSMULL, destination[Low], destination[High], left[Low], right[Low]); (* signed long multiplication *)
  1793. Emit3(opMLA, destination[High], left[Low], right[High]); (* multiply and accumulate *)
  1794. Emit3(opMLA, destination[High], left[High], right[Low]);
  1795. WriteBack(irInstruction.op1, Low, destination[Low]);
  1796. WriteBack(irInstruction.op1, High, destination[High]);
  1797. *)
  1798. ELSE
  1799. (* signed or unsigned integer multiplication: *)
  1800. PrepareDoubleSourceOp(irInstruction, Low, destination[Low], left[Low], right[Low]);
  1801. SignOrZeroExtendOperand(left[Low], irInstruction.op2.type);
  1802. SignOrZeroExtendOperand(right[Low], irInstruction.op3.type);
  1803. Emit3(opMUL, destination[Low], left[Low], right[Low]); (* note that the sign does not matter for the least 32 significant bits *)
  1804. WriteBack(irInstruction.op1, Low, destination[Low])
  1805. END
  1806. ELSE
  1807. HALT(200)
  1808. END
  1809. END EmitMul;
  1810. PROCEDURE EmitDiv(VAR irInstruction: IntermediateCode.Instruction);
  1811. VAR
  1812. destination, left, right: Operand;
  1813. BEGIN
  1814. IF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1815. ASSERT(backend.useFPU);
  1816. PrepareDoubleSourceOp(irInstruction, Low, destination, left, right);
  1817. Emit3(opFDIVS, destination, left, right);
  1818. WriteBack(irInstruction.op1, Low, destination)
  1819. ELSE
  1820. HALT(200)
  1821. END
  1822. END EmitDiv;
  1823. PROCEDURE EmitMod(CONST irInstruction: IntermediateCode.Instruction);
  1824. BEGIN HALT(100) (* handled by a runtime call *)
  1825. END EmitMod;
  1826. PROCEDURE EmitAbs(VAR irInstruction: IntermediateCode.Instruction);
  1827. VAR
  1828. destination, source: ARRAY 2 OF Operand;
  1829. zero: Operand;
  1830. BEGIN
  1831. IF IsInteger(irInstruction.op1) THEN
  1832. zero := InstructionSet.NewImmediate(0);
  1833. IF IsComplex(irInstruction.op1) THEN
  1834. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1835. PrepareSingleSourceOpWithImmediate(irInstruction, High, destination[High], source[High]);
  1836. MovIfDifferent(destination[Low], source[Low]);
  1837. MovIfDifferent(destination[High], source[High]);
  1838. (* negate the value if it is negative *)
  1839. IF irInstruction.op2.type.form = IntermediateCode.SignedInteger THEN
  1840. Emit2(opCMP, destination[High], zero); (* note that only the high part has to be looked at to determine the sign *)
  1841. Emit1WithCondition(opB, InstructionSet.NewImmediate(4), InstructionSet.conditionGE); (* BGE #4 = skip the following two instructions if greater or equal *)
  1842. Emit3WithFlags(opRSB, destination[Low], destination[Low], zero, {InstructionSet.flagS}); (* RSBS *)
  1843. Emit3(opRSC, destination[High], destination[High], zero); (* RSC - reverse subtraction with carry *)
  1844. END;
  1845. WriteBack(irInstruction.op1, Low, destination[Low]);
  1846. WriteBack(irInstruction.op1, High, destination[High])
  1847. ELSE
  1848. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1849. SignOrZeroExtendOperand(source[Low], irInstruction.op2.type);
  1850. MovIfDifferent(destination[Low], source[Low]);
  1851. (* negate the value if it is negative *)
  1852. IF irInstruction.op2.type.form = IntermediateCode.SignedInteger THEN
  1853. SignExtendOperand(destination[Low], irInstruction.op2.type.sizeInBits);
  1854. Emit2(opCMP, destination[Low], zero);
  1855. Emit3WithCondition(opRSB, destination[Low], destination[Low], zero, InstructionSet.conditionLT)
  1856. END;
  1857. WriteBack(irInstruction.op1, Low, destination[Low])
  1858. END
  1859. ELSIF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1860. ASSERT(backend.useFPU);
  1861. PrepareSingleSourceOp(irInstruction, Low, destination[Low], source[Low]);
  1862. Emit2(opFABSS, destination[Low], source[Low]);
  1863. WriteBack(irInstruction.op1, Low, destination[Low])
  1864. ELSE
  1865. HALT(200)
  1866. END
  1867. END EmitAbs;
  1868. (* TODO: floats *)
  1869. PROCEDURE EmitNeg(VAR irInstruction: IntermediateCode.Instruction);
  1870. VAR
  1871. destination, source: ARRAY 2 OF Operand;
  1872. zero: Operand;
  1873. BEGIN
  1874. IF IsInteger(irInstruction.op1) THEN
  1875. zero := InstructionSet.NewImmediate(0);
  1876. IF IsComplex(irInstruction.op1) THEN
  1877. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1878. PrepareSingleSourceOpWithImmediate(irInstruction, High, destination[High], source[High]);
  1879. Emit3WithFlags(opRSB, destination[Low], source[Low], zero, {InstructionSet.flagS}); (* RSBS *)
  1880. Emit3(opRSC, destination[High], source[High], zero); (* RSC - reverse subtraction with carry *)
  1881. WriteBack(irInstruction.op1, Low, destination[Low]);
  1882. WriteBack(irInstruction.op1, High, destination[High])
  1883. ELSE
  1884. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1885. SignOrZeroExtendOperand(source[Low], irInstruction.op2.type);
  1886. Emit3(opRSB, destination[Low], source[Low], zero); (* reverse subtraction with zero *)
  1887. WriteBack(irInstruction.op1, Low, destination[Low])
  1888. END
  1889. ELSIF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1890. ASSERT(backend.useFPU);
  1891. PrepareSingleSourceOp(irInstruction, Low, destination[Low], source[Low]);
  1892. Emit2(opFNEGS, destination[Low], source[Low]);
  1893. WriteBack(irInstruction.op1, Low, destination[Low])
  1894. ELSE
  1895. HALT(200)
  1896. END
  1897. END EmitNeg;
  1898. (*
  1899. - note that the ARM instructions ASR, LSL, LSR, ROR, etc. are actually aliases for a MOV with a shifted register operand
  1900. - note that ARM does not support LSL by 32 bits
  1901. - note that for operand sizes 8 and 16, the unused bits of the result might be in a unpredictable state (sign/zero-extension is not done on purpose)
  1902. *)
  1903. PROCEDURE EmitShiftOrRotation(VAR irInstruction: IntermediateCode.Instruction);
  1904. VAR
  1905. shiftAmountImmediate, shiftMode: LONGINT;
  1906. destination, source: ARRAY 2 OF Operand;
  1907. irShiftOperand: IntermediateCode.Operand;
  1908. temp, shiftAmountRegister: Operand;
  1909. BEGIN
  1910. ASSERT(IsInteger(irInstruction.op1), 100); (* shifts are only allowed on integers *)
  1911. destination[Low] := AcquireDestinationRegister(irInstruction.op1, Low, emptyOperand);
  1912. source[Low] := RegisterFromIrOperand(irInstruction.op2, Low, emptyOperand); (* note that the destination register cannot be used as hint for the source *)
  1913. IF IsComplex(irInstruction.op1) THEN
  1914. destination[High] := AcquireDestinationRegister(irInstruction.op1, High, emptyOperand);
  1915. source[High] := RegisterFromIrOperand(irInstruction.op2, High, emptyOperand); (* note that the destination register cannot be used as hint for the source *)
  1916. END;
  1917. irShiftOperand := irInstruction.op3;
  1918. ASSERT((irShiftOperand.type.form = IntermediateCode.UnsignedInteger) & ~IsComplex(irShiftOperand)); (* the shift operand is assumed to be a single part unsigned integer *)
  1919. (* use ARM register or shift immediate to represent IR shift operand *)
  1920. IF (irShiftOperand.mode = IntermediateCode.ModeImmediate) & (irShiftOperand.symbol.name = "") THEN
  1921. shiftAmountImmediate := LONGINT(irShiftOperand.intValue); (* note that at this point the shift amount could also be >= 32 *)
  1922. shiftAmountRegister := emptyOperand;
  1923. ASSERT(shiftAmountImmediate >= 0);
  1924. ELSE
  1925. shiftAmountImmediate := 0;
  1926. shiftAmountRegister := RegisterFromIrOperand(irShiftOperand, Low, emptyOperand);
  1927. ZeroExtendOperand(shiftAmountRegister, irShiftOperand.type.sizeInBits)
  1928. END;
  1929. CASE irInstruction.opcode OF
  1930. | IntermediateCode.ror, IntermediateCode.rol:
  1931. (* rotation: *)
  1932. IF IsComplex(irInstruction.op1) THEN HALT(100) END; (* complex rotations are handled as runtime calls *)
  1933. IF irInstruction.opcode = IntermediateCode.rol THEN
  1934. (* simple left rotation: rotate right with complementary rotation amount, since ARM does not support left rotations *)
  1935. IF shiftAmountRegister.register = None THEN
  1936. shiftAmountImmediate := 32 - shiftAmountImmediate
  1937. ELSE
  1938. IF IsSameRegister(destination[Low], source[Low]) THEN temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) ELSE temp := destination[Low] END;
  1939. Emit3(opRSB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32));
  1940. shiftAmountRegister := temp
  1941. END
  1942. END;
  1943. shiftAmountImmediate := shiftAmountImmediate MOD 32; (* make sure rotation amount is in range 0..31 *)
  1944. IF (shiftAmountRegister.register = None) & (shiftAmountImmediate = 0) THEN
  1945. (* simple rotation by 0: *)
  1946. Emit2(opMOV, destination[Low], source[Low])
  1947. ELSE
  1948. IF irInstruction.op1.type.sizeInBits = 8 THEN
  1949. (* simple 8 bit rotation: *)
  1950. ZeroExtendOperand(source[Low], 8);
  1951. IF IsSameRegister(destination[Low], source[Low]) THEN temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) ELSE temp := destination[Low] END;
  1952. Emit2(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftROR, shiftAmountRegister.register, shiftAmountImmediate));
  1953. Emit3(opORR, temp, temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 8));
  1954. Emit3(opORR, temp, temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 16));
  1955. Emit3(opORR, destination[Low], temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 24))
  1956. ELSIF irInstruction.op1.type.sizeInBits = 16 THEN
  1957. (* simple 16 bit rotation: *)
  1958. ZeroExtendOperand(source[Low], 16);
  1959. IF IsSameRegister(destination[Low], source[Low]) THEN temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) ELSE temp := destination[Low] END;
  1960. Emit2(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftROR, shiftAmountRegister.register, shiftAmountImmediate));
  1961. Emit3(opORR, destination[Low], temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 16))
  1962. ELSIF irInstruction.op1.type.sizeInBits = 32 THEN
  1963. (* simple 32 bit rotation: *)
  1964. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftROR, shiftAmountRegister.register, shiftAmountImmediate))
  1965. ELSE
  1966. HALT(100)
  1967. END
  1968. END
  1969. | IntermediateCode.shl:
  1970. (* left shift: *)
  1971. IF IsComplex(irInstruction.op1) THEN
  1972. (* complex left shift: *)
  1973. IF shiftAmountRegister.register = None THEN
  1974. (* complex left immediate shift: *)
  1975. IF shiftAmountImmediate = 0 THEN
  1976. Emit2(opMOV, destination[High], source[High]);
  1977. Emit2(opMOV, destination[Low], source[Low])
  1978. ELSIF (shiftAmountImmediate > 0) & (shiftAmountImmediate < 32) THEN
  1979. IF ~IsSameRegister(destination[High], source[High]) THEN temp := destination[High] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  1980. Emit2(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSR, None, 32 - shiftAmountImmediate));
  1981. Emit3(opORR, destination[High], temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, None, shiftAmountImmediate));
  1982. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, None, shiftAmountImmediate))
  1983. ELSIF (shiftAmountImmediate >= 32) & (shiftAmountImmediate < 64) THEN
  1984. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, None, shiftAmountImmediate - 32));
  1985. Emit2(opMOV, destination[Low], InstructionSet.NewImmediate(0))
  1986. ELSIF shiftAmountImmediate >= 64 THEN
  1987. Emit2(opMOV, destination[High], InstructionSet.NewImmediate(0));
  1988. Emit2(opMOV, destination[Low], InstructionSet.NewImmediate(0))
  1989. ELSE
  1990. HALT(100)
  1991. END
  1992. ELSE
  1993. (* complex left register shift: *)
  1994. IF ~IsSameRegister(destination[Low], source[Low]) THEN temp := destination[Low] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  1995. Emit2(opCMP, shiftAmountRegister, InstructionSet.NewImmediate(32));
  1996. (* shiftAmount < 32: *)
  1997. Emit3WithCondition(opRSB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionLT);
  1998. Emit2WithCondition(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSR, temp.register, 0), InstructionSet.conditionLT);
  1999. Emit3WithCondition(opORR, destination[High], temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2000. Emit2WithCondition(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2001. (* shift amount >= 32: *)
  2002. Emit3WithCondition(opSUB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionGE);
  2003. Emit2WithCondition(opMOV, destination[High], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, temp.register, 0), InstructionSet.conditionGE);
  2004. Emit2WithCondition(opMOV, destination[Low], InstructionSet.NewImmediate(0), InstructionSet.conditionGE)
  2005. END
  2006. ELSE
  2007. (* simple left shift: *)
  2008. IF shiftAmountRegister.register = None THEN
  2009. (* simple left immediate shift *)
  2010. IF (shiftAmountImmediate >= 0) & (shiftAmountImmediate < 32) THEN
  2011. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, None, shiftAmountImmediate)) (* note: LSL has to be in the range 0..31 *)
  2012. ELSIF shiftAmountImmediate >= 32 THEN
  2013. Emit2(opMOV, destination[Low], InstructionSet.NewImmediate(0))
  2014. ELSE
  2015. HALT(100)
  2016. END
  2017. ELSE
  2018. (* simple left register shift: *)
  2019. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, shiftAmountRegister.register, 0))
  2020. END
  2021. END
  2022. | IntermediateCode.shr:
  2023. (* right shift: *)
  2024. (* determine shift mode (depends on if source operand is signed) *)
  2025. IF irInstruction.op1.type.form = IntermediateCode.UnsignedInteger THEN
  2026. (* logical right shift: *)
  2027. shiftMode := InstructionSet.shiftLSR
  2028. ELSE
  2029. (* arithmetic right shift: *)
  2030. shiftMode := InstructionSet.shiftASR
  2031. END;
  2032. IF IsComplex(irInstruction.op1) THEN
  2033. (* complex right shift: *)
  2034. IF shiftAmountRegister.register = None THEN
  2035. (* complex right immediate shift: *)
  2036. IF shiftAmountImmediate = 0 THEN
  2037. Emit2(opMOV, destination[High], source[High]);
  2038. Emit2(opMOV, destination[Low], source[Low])
  2039. ELSIF (shiftAmountImmediate > 0) & (shiftAmountImmediate < 32) THEN
  2040. IF ~IsSameRegister(destination[High], source[High]) THEN temp := destination[High] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  2041. Emit2(opMOV, temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, None, 32 - shiftAmountImmediate));
  2042. Emit3(opORR, destination[Low], temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSR, None, shiftAmountImmediate));
  2043. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, None, shiftAmountImmediate))
  2044. ELSIF shiftAmountImmediate >= 32 THEN
  2045. IF shiftAmountImmediate > 64 THEN shiftAmountImmediate := 64 END;
  2046. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[High].register, shiftMode, None, shiftAmountImmediate - 32));
  2047. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, None, 32))
  2048. ELSE
  2049. HALT(100)
  2050. END
  2051. ELSE
  2052. (* complex right register shift: *)
  2053. IF ~IsSameRegister(destination[High], source[High]) THEN temp := destination[High] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  2054. Emit2(opCMP, shiftAmountRegister, InstructionSet.NewImmediate(32));
  2055. (* shiftAmount < 32: *)
  2056. Emit3WithCondition(opRSB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionLT);
  2057. Emit2WithCondition(opMOV, temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, temp.register, 0), InstructionSet.conditionLT);
  2058. Emit3WithCondition(opORR, destination[Low], temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSR, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2059. Emit2WithCondition(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2060. (* shift amount >= 32: *)
  2061. Emit3WithCondition(opSUB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionGE);
  2062. Emit2WithCondition(opMOV, destination[Low], InstructionSet.NewRegister(source[High].register, shiftMode, temp.register, 0), InstructionSet.conditionGE);
  2063. Emit2WithCondition(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, shiftAmountRegister.register, 0), InstructionSet.conditionGE)
  2064. END
  2065. ELSE
  2066. (* simple right shift: *)
  2067. SignOrZeroExtendOperand(source[Low], irInstruction.op1.type);
  2068. IF shiftAmountRegister.register = None THEN
  2069. (* simple right immediate shift: *)
  2070. IF shiftAmountImmediate > 32 THEN shiftAmountImmediate := 32 END;
  2071. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, shiftMode, None, shiftAmountImmediate))
  2072. ELSE
  2073. (* simple right register shift: *)
  2074. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, shiftMode, shiftAmountRegister.register, 0))
  2075. END
  2076. END
  2077. ELSE
  2078. HALT(100)
  2079. END;
  2080. WriteBack(irInstruction.op1, Low, destination[Low]);
  2081. IF IsComplex(irInstruction.op1) THEN WriteBack(irInstruction.op1, High, destination[High]) END
  2082. END EmitShiftOrRotation;
  2083. PROCEDURE EmitAsm(CONST irInstruction: IntermediateCode.Instruction);
  2084. VAR
  2085. reader: Streams.StringReader;
  2086. procedure: SyntaxTree.Procedure;
  2087. scope: SyntaxTree.Scope;
  2088. symbol: SyntaxTree.Symbol;
  2089. assembler: Assembler.Assembler;
  2090. scanner: Scanner.AssemblerScanner;
  2091. len: LONGINT;
  2092. BEGIN
  2093. len := Strings.Length(irInstruction.op1.string^);
  2094. NEW(reader, len);
  2095. reader.Set(irInstruction.op1.string^);
  2096. (* determine scope of the section *)
  2097. symbol := in.symbol;
  2098. IF symbol = NIL THEN
  2099. scope := NIL
  2100. ELSE
  2101. procedure := symbol(SyntaxTree.Procedure);
  2102. scope := procedure.procedureScope
  2103. END;
  2104. NEW(assembler, diagnostics);
  2105. scanner := Scanner.NewAssemblerScanner(module.moduleName(*module.module.sourceName*), reader, LONGINT(irInstruction.op1.intValue) (* ? *), diagnostics);
  2106. assembler.InlineAssemble(scanner, in, scope, module);
  2107. error := error OR assembler.error
  2108. END EmitAsm;
  2109. PROCEDURE EmitSpecial(VAR instruction: IntermediateCode.Instruction);
  2110. VAR
  2111. psrNumber, code, a, b, c, d: LONGINT;
  2112. register, register2, register3, register4, temp, cpOperand, cpRegister1, cpRegister2, opCode1Operand, opCode2Operand: Operand;
  2113. BEGIN
  2114. CASE instruction.subtype OF
  2115. | GetSP: Emit2(opMOV, opRES, opSP)
  2116. | SetSP: Emit2(opMOV, opSP, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2117. | GetFP: Emit2(opMOV, opRES, opFP)
  2118. | SetFP: Emit2(opMOV, opFP, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2119. | GetLNK: Emit2(opMOV, opRES, opLR)
  2120. | SetLNK: Emit2(opMOV, opLR, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2121. | GetPC: Emit2(opMOV, opRES, opPC)
  2122. | SetPC: Emit2(opMOV, opPC, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2123. | LDPSR, STPSR:
  2124. ASSERT(instruction.op1.type.form IN IntermediateCode.Integer);
  2125. IF instruction.op1.mode # IntermediateCode.ModeImmediate THEN
  2126. Error(instruction.textPosition,"first operand must be immediate")
  2127. ELSIF (instruction.op1.intValue < 0) OR (instruction.op1.intValue > 1) THEN
  2128. Error(instruction.textPosition,"first operand must be 0 or 1")
  2129. ELSE
  2130. IF instruction.op1.intValue = 0 THEN
  2131. psrNumber := InstructionSet.CPSR
  2132. ELSE
  2133. psrNumber := InstructionSet.SPSR
  2134. END;
  2135. register := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2136. IF instruction.subtype = LDPSR THEN
  2137. Emit2(opMSR, InstructionSet.NewRegisterWithFields(psrNumber, {InstructionSet.fieldF, InstructionSet.fieldC}), register)
  2138. ELSE
  2139. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2140. Emit2(opMRS, temp, InstructionSet.NewRegister(psrNumber, None, None, 0));
  2141. Emit2(opSTR, temp, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment}))
  2142. END
  2143. END
  2144. | LDCPR, STCPR:
  2145. IF instruction.op1.mode # IntermediateCode.ModeImmediate THEN
  2146. Error(instruction.textPosition,"first operand must be immediate")
  2147. ELSIF (instruction.op2.mode # IntermediateCode.ModeImmediate) THEN
  2148. Error(instruction.textPosition,"second operand must be immediate")
  2149. ELSIF (instruction.op2.intValue < 0) OR (instruction.op2.intValue > 15) THEN
  2150. Error(instruction.textPosition,"second operand must be between 0 or 15")
  2151. ELSE
  2152. code := LONGINT(instruction.op1.intValue); (* code = a00bcdH *)
  2153. a := (code DIV 100000H) MOD 10H; (* opcode1 * 2 *)
  2154. b := (code DIV 100H) MOD 10H; (* coprocessor number *)
  2155. c := (code DIV 10H) MOD 10H; (* opcode2 * 2 *)
  2156. d := code MOD 10H; (* coprocessor register2 number *)
  2157. InstructionSet.InitCoprocessor(cpOperand, InstructionSet.CP0 + b);
  2158. InstructionSet.InitOpcode(opCode1Operand, a DIV 2);
  2159. register := RegisterFromIrOperand(instruction.op3, Low, emptyOperand);
  2160. InstructionSet.InitRegister(cpRegister1, InstructionSet.CR0 + LONGINT(instruction.op2.intValue), None, None, 0);
  2161. InstructionSet.InitRegister(cpRegister2, InstructionSet.CR0 + d, None, None, 0);
  2162. InstructionSet.InitOpcode(opCode2Operand, c DIV 2);
  2163. IF instruction.subtype = LDCPR THEN
  2164. Emit6(opMCR, cpOperand, opCode1Operand, register, cpRegister1, cpRegister2, opCode2Operand)
  2165. ELSE
  2166. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2167. Emit6(opMRC, cpOperand, opCode1Operand, temp, cpRegister1, cpRegister2, opCode2Operand);
  2168. Emit2(opSTR, temp, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment}))
  2169. END
  2170. END
  2171. | FLUSH:
  2172. IF instruction.op1.mode # IntermediateCode.ModeImmediate THEN
  2173. Error(instruction.textPosition,"first operand must be immediate")
  2174. ELSIF (instruction.op1.intValue < 0) OR (instruction.op2.intValue > 0FFH) THEN
  2175. Error(instruction.textPosition,"first operand must be between 0 and 255")
  2176. ELSE
  2177. code := LONGINT(instruction.op1.intValue); (* code = aaa1bbbbB *)
  2178. a := (code DIV 20H) MOD 8; (* coprocessor opcode 2 *)
  2179. b := (code MOD 10H); (* coprocessor register2 number *)
  2180. (* examples:
  2181. 9AH = 10011000B -> MCR p15, 0, R0, c7, c10, 4
  2182. 17H = 00010111B -> MCR p15, 0, R0, c7, c7, 0
  2183. *)
  2184. InstructionSet.InitCoprocessor(cpOperand, InstructionSet.CP15);
  2185. InstructionSet.InitOpcode(opCode1Operand, 0);
  2186. InstructionSet.InitRegister(register, InstructionSet.R0, None, None, 0);
  2187. InstructionSet.InitRegister(cpRegister1, InstructionSet.CR7, None, None, 0);
  2188. InstructionSet.InitRegister(cpRegister2, InstructionSet.CR0 + b, None, None, 0);
  2189. InstructionSet.InitOpcode(opCode2Operand, a);
  2190. Emit6(opMCR, cpOperand, opCode1Operand, register, cpRegister1, cpRegister2, opCode2Operand);
  2191. Emit2(opMOV, register, register); (* NOP (register = R0) *)
  2192. Emit2(opMOV, register, register); (* NOP *)
  2193. Emit2(opMOV, register, register); (* NOP *)
  2194. Emit2(opMOV, register, register) (* NOP *)
  2195. END
  2196. | NULL:
  2197. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand);
  2198. Emit3(opBIC, register, register, InstructionSet.NewImmediate(LONGINT(80000000H)));
  2199. Emit2(opCMP, register, InstructionSet.NewImmediate(0));
  2200. Emit2WithCondition(opMOV, opRES, InstructionSet.NewImmediate(1), InstructionSet.conditionEQ);
  2201. Emit2WithCondition(opMOV, opRES, InstructionSet.NewImmediate(0), InstructionSet.conditionNE);
  2202. | XOR:
  2203. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand);
  2204. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2205. (*
  2206. register3 := RegisterFromIrOperand(instruction.op3, Low, emptyOperand);
  2207. *)
  2208. Emit3(opEOR, opRES, register, register2);
  2209. | MULD:
  2210. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand); (* note that 'register' contains an address *)
  2211. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2212. register3 := RegisterFromIrOperand(instruction.op3, Low, emptyOperand);
  2213. Emit4(opUMULL, opRES, opRESHI, register2, register3);
  2214. Emit2(opSTR, opRES, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})); (* JCH: 15.05.2012 *)
  2215. Emit2(opSTR, opRESHI, InstructionSet.NewImmediateOffsetMemory(register.register, 4, {InstructionSet.Increment}))
  2216. | ADDC:
  2217. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand);
  2218. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2219. Emit3(opADC, opRES, register, register2)
  2220. | PACK:
  2221. (* PACK(x, y):
  2222. add y to the binary exponent of y. PACK(x, y) is equivalent to x := x * 2^y. *)
  2223. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand); (* register = address of x *)
  2224. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand); (* register2 = value of y *)
  2225. register3 := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)); (* a temporary INTEGER (!) register that is used to store a float *)
  2226. Emit2(opLDR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})); (* register3 = value of x *)
  2227. Emit3(opADD, register3, register3, InstructionSet.NewRegister(register2.register, InstructionSet.shiftLSL, None, 23)); (* increase the (biased) exponent of x by y*)
  2228. Emit2(opSTR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})) (* store new value of x *)
  2229. | UNPK:
  2230. (* UNPK(x, y):
  2231. remove the binary exponent on x and put it into y. UNPK is the reverse operation of PACK. The resulting x is normalized, i.e. 1.0 <= x < 2.0.
  2232. *)
  2233. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand); (* register = address of x *)
  2234. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand); (* register2 = address of y *)
  2235. register3 := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)); (* a temporary INTEGER (!) register that is used to store a float *)
  2236. Emit2(opLDR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})); (* register3 = value of x *)
  2237. register4 := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2238. Emit2(opMOV, register4, InstructionSet.NewRegister(register3.register, InstructionSet.shiftLSR, None, 23)); (* register4 = biased exponent (and sign) of x *)
  2239. Emit3(opSUB, register4, register4, InstructionSet.NewImmediate(127)); (* register4 = exponent of x (biased exponent - 127) *)
  2240. Emit2(opSTR, register4, InstructionSet.NewImmediateOffsetMemory(register2.register, 0, {InstructionSet.Increment})); (* store exponent of x as value for y *)
  2241. Emit3(opSUB, register3, register3, InstructionSet.NewRegister(register4.register, InstructionSet.shiftLSL, None, 23)); (* reduce the biased exponent of x by the value of y *)
  2242. Emit2(opSTR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})) (* store new value of x *)
  2243. ELSE
  2244. HALT(100)
  2245. END
  2246. END EmitSpecial;
  2247. PROCEDURE EmitBr(VAR irInstruction: IntermediateCode.Instruction);
  2248. VAR
  2249. branchDistance: LONGINT;
  2250. isSwapped: BOOLEAN;
  2251. left, right: ARRAY 2 OF Operand;
  2252. temp: Operand;
  2253. irLeft, irRight: IntermediateCode.Operand;
  2254. fixup,failFixup: BinaryCode.Fixup;
  2255. fixupPatternList: ObjectFile.FixupPatterns;
  2256. identifier: ObjectFile.Identifier;
  2257. hiHit, hiFail, lowHit, lowFail: LONGINT;
  2258. PROCEDURE JmpDest(branchConditionCode: LONGINT);
  2259. BEGIN
  2260. IF (irInstruction.op1.mode = IntermediateCode.ModeImmediate) & (irInstruction.op1.symbol.name = in.name) & (irInstruction.op1.offset = 0) THEN
  2261. (* branch within same section at a certain IR offset *)
  2262. (* optimization: abort if branch is to the next instruction *)
  2263. IF irInstruction.op1.symbolOffset = inPC + 1 THEN
  2264. IF dump # NIL THEN dump.String("branch to next instruction ignored"); dump.Ln END;
  2265. RETURN
  2266. END;
  2267. IF irInstruction.op1.symbolOffset <= inPC THEN
  2268. (* backward branch: calculate the branch distance *)
  2269. branchDistance := in.instructions[irInstruction.op1.symbolOffset].pc - out.pc - 8;
  2270. ASSERT((-33554432 <= branchDistance) & (branchDistance <= 0) & ((ABS(branchDistance) MOD 4) = 0), 200);
  2271. ELSE
  2272. (* forward branch: the distance is not yet known, use some placeholder and add a relative fixup *)
  2273. branchDistance := -4;
  2274. (* TODO: what about a branch to the next instruction? this would require the fixup meachnism to patch a negative value! (-> -4) *)
  2275. NEW(fixupPatternList, 1);
  2276. fixupPatternList[0].offset := 0;
  2277. fixupPatternList[0].bits := 24;
  2278. identifier.name := in.name;
  2279. identifier.fingerprint := in.fingerprint;
  2280. fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, irInstruction.op1.symbolOffset, -8, -2, fixupPatternList);
  2281. out.fixupList.AddFixup(fixup)
  2282. END;
  2283. Emit1WithCondition(opB, InstructionSet.NewImmediate(branchDistance), branchConditionCode)
  2284. ELSE
  2285. (* any other type of branch -> do register branch *)
  2286. Emit1WithCondition(opBX, RegisterFromIrOperand(irInstruction.op1, Low, emptyOperand), branchConditionCode)
  2287. END;
  2288. END JmpDest;
  2289. PROCEDURE Cmp(CONST left, right: InstructionSet.Operand; float: BOOLEAN);
  2290. BEGIN
  2291. IF float THEN
  2292. IF ~backend.useFPU OR IsComplex(irLeft) (* 64 bit *) THEN
  2293. (* floating point comparisons without VFP unit *)
  2294. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2295. Emit3WithFlags(opAND, temp, left, right, {InstructionSet.flagS});
  2296. Emit2(opCMP, temp, InstructionSet.NewImmediate(0));
  2297. Emit1WithCondition(opB, InstructionSet.NewImmediate(4), InstructionSet.conditionLT); (* skip two instructions *)
  2298. Emit2(opCMP, left, right);
  2299. Emit1(opB, InstructionSet.NewImmediate(0)); (* skip one instructions *)
  2300. Emit2(opCMP, right, left);
  2301. ELSE
  2302. Emit2(opFCMPS, left, right);
  2303. Emit0(opFMSTAT); (* transfer the VFP flags to the standard ARM flags *)
  2304. END
  2305. ELSE
  2306. Emit2(opCMP, left, right);
  2307. END;
  2308. END Cmp;
  2309. BEGIN
  2310. hiFail := None;
  2311. hiHit := None;
  2312. IF irInstruction.opcode = IntermediateCode.br THEN
  2313. (* unconditional branch: *)
  2314. lowHit := InstructionSet.conditionAL
  2315. ELSE
  2316. (* conditional branch: *)
  2317. irLeft := irInstruction.op2; irRight := irInstruction.op3;
  2318. ASSERT((irLeft.type.form = irRight.type.form) & (irLeft.type.sizeInBits = irRight.type.sizeInBits));
  2319. IF IsInteger(irLeft) THEN
  2320. IF IsComplex(irLeft) THEN
  2321. CASE irInstruction.opcode OF
  2322. | IntermediateCode.breq, IntermediateCode.brne: (* left = right, left # right *)
  2323. lowHit := InstructionSet.conditionEQ;
  2324. left[High] := RegisterFromIrOperand(irLeft, High, emptyOperand);
  2325. right[High] := RegisterOrImmediateFromIrOperand(irRight, High, emptyOperand);
  2326. Emit2(opCMP, left[High], right[High]);
  2327. left[Low] := RegisterFromIrOperand(irLeft, Low, left[High]);
  2328. right[Low] := RegisterOrImmediateFromIrOperand(irRight, Low, right[High]);
  2329. Emit2WithCondition(opCMP, left[Low], right[Low], lowHit);
  2330. IF irInstruction.opcode = IntermediateCode.brne THEN lowHit := InstructionSet.conditionNE END;
  2331. | IntermediateCode.brlt, IntermediateCode.brge: (* left < right, left >= right *)
  2332. IF irInstruction.opcode = IntermediateCode.brlt THEN lowHit := InstructionSet.conditionLT ELSE lowHit := InstructionSet.conditionGE END;
  2333. ASSERT(irLeft.type.form = IntermediateCode.SignedInteger);
  2334. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2335. right[Low] := RegisterOrImmediateFromIrOperand(irRight, Low, emptyOperand);
  2336. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2337. Emit3WithFlags(opSUB, temp, left[Low], right[Low], {InstructionSet.flagS});
  2338. left[High] := RegisterFromIrOperand(irLeft, High, left[Low]);
  2339. right[High] := RegisterOrImmediateFromIrOperand(irRight, High, right[Low]);
  2340. Emit3WithFlags(opSBC, temp, left[High], right[High], {InstructionSet.flagS}) (* the high part of the subtraction determines the sign *)
  2341. ELSE
  2342. HALT(100)
  2343. END
  2344. ELSE
  2345. ASSERT((irLeft.type.form IN IntermediateCode.Integer) & (irLeft.type.sizeInBits <= 32));
  2346. (* swap operands if beneficial *)
  2347. IF ~IrOperandIsDirectlyEncodable(irRight, Low) & IrOperandIsDirectlyEncodable(irLeft, Low) THEN
  2348. isSwapped := TRUE;
  2349. SwapIrOperands(irLeft, irRight)
  2350. END;
  2351. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2352. right[Low] := RegisterOrImmediateFromIrOperand(irRight, Low, emptyOperand);
  2353. SignOrZeroExtendOperand(left[Low], irLeft.type);
  2354. SignOrZeroExtendOperand(right[Low], irRight.type);
  2355. Cmp(left[Low], right[Low], FALSE);
  2356. (* determine condition code for the branch (take into consideration that operands could have been swapped) *)
  2357. CASE irInstruction.opcode OF
  2358. | IntermediateCode.breq: (* left = right *) lowHit := InstructionSet.conditionEQ
  2359. | IntermediateCode.brne: (* left # right *) lowHit := InstructionSet.conditionNE
  2360. | IntermediateCode.brlt: (* left < right *)
  2361. IF irInstruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2362. IF isSwapped THEN lowHit := InstructionSet.conditionHI ELSE lowHit := InstructionSet.conditionLO END
  2363. ELSE
  2364. IF isSwapped THEN lowHit := InstructionSet.conditionGT ELSE lowHit := InstructionSet.conditionLT END
  2365. END
  2366. | IntermediateCode.brge: (* left >= right *)
  2367. IF irInstruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2368. IF isSwapped THEN lowHit := InstructionSet.conditionLS ELSE lowHit := InstructionSet.conditionHS END
  2369. ELSE
  2370. IF isSwapped THEN lowHit := InstructionSet.conditionLE ELSE lowHit := InstructionSet.conditionGE END
  2371. END
  2372. ELSE HALT(100)
  2373. END
  2374. END
  2375. ELSIF IsSinglePrecisionFloat(irLeft) THEN
  2376. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2377. right[Low] := RegisterFromIrOperand(irRight, Low, emptyOperand);
  2378. Cmp(left[Low], right[Low], TRUE);
  2379. CASE irInstruction.opcode OF
  2380. | IntermediateCode.breq: (* left = right *) lowHit := InstructionSet.conditionEQ
  2381. | IntermediateCode.brne: (* left # right *) lowHit := InstructionSet.conditionNE
  2382. | IntermediateCode.brlt: (* left < right *) lowHit := InstructionSet.conditionLT
  2383. | IntermediateCode.brge: (* left >= right *) lowHit := InstructionSet.conditionGE
  2384. ELSE HALT(100)
  2385. END
  2386. ELSIF IsDoublePrecisionFloat(irLeft) THEN
  2387. CASE irInstruction.opcode OF
  2388. IntermediateCode.breq:
  2389. hiHit := None; hiFail := InstructionSet.conditionNE; lowHit := InstructionSet.conditionEQ
  2390. |IntermediateCode.brne:
  2391. hiHit := InstructionSet.conditionNE; hiFail := None; lowHit := InstructionSet.conditionNE
  2392. |IntermediateCode.brge:
  2393. IF isSwapped THEN
  2394. hiHit := InstructionSet.conditionLT; hiFail := InstructionSet.conditionGT; lowHit := InstructionSet.conditionLS
  2395. ELSE
  2396. hiHit := InstructionSet.conditionGT; hiFail := InstructionSet.conditionLT; lowHit := InstructionSet.conditionHS
  2397. END;
  2398. |IntermediateCode.brlt:
  2399. IF isSwapped THEN
  2400. hiHit := InstructionSet.conditionGT; hiFail := InstructionSet.conditionLT; lowHit := InstructionSet.conditionHI
  2401. ELSE
  2402. hiHit := InstructionSet.conditionLT; hiFail := InstructionSet.conditionGT; lowHit := InstructionSet.conditionLO
  2403. END;
  2404. END;
  2405. (*
  2406. compare hi part (as float)
  2407. if hiHit then br dest
  2408. elsif hiFail then br fail
  2409. else compare low part (as unsigned int)
  2410. if lowHit then br dest
  2411. end
  2412. end,
  2413. fail:
  2414. *)
  2415. (* hi part *)
  2416. left[High] := RegisterFromIrOperand(irLeft, High, emptyOperand);
  2417. right[High] := RegisterOrImmediateFromIrOperand(irRight, High, emptyOperand);
  2418. Cmp(left[High], right[High], TRUE);
  2419. IF hiHit # None THEN
  2420. JmpDest(hiHit)
  2421. END;
  2422. IF hiFail # None THEN
  2423. NEW(fixupPatternList, 1);
  2424. fixupPatternList[0].offset := 0;
  2425. fixupPatternList[0].bits := 24;
  2426. identifier.name := in.name;
  2427. identifier.fingerprint := in.fingerprint;
  2428. failFixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, irInstruction.op1.symbolOffset, -8, -2, fixupPatternList);
  2429. out.fixupList.AddFixup(failFixup);
  2430. Emit1WithCondition(opB, InstructionSet.NewImmediate(branchDistance), hiFail)
  2431. END;
  2432. (* low part *)
  2433. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2434. right[Low] := RegisterFromIrOperand(irRight, Low, emptyOperand);
  2435. Cmp(left[Low], right[Low], FALSE);
  2436. ELSE
  2437. HALT(200)
  2438. END
  2439. END;
  2440. JmpDest(lowHit);
  2441. IF failFixup # NIL THEN
  2442. failFixup.SetSymbol(in.name, in.fingerprint, 0, out.pc+failFixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
  2443. failFixup.resolved := in;
  2444. END;
  2445. END EmitBr;
  2446. (* TODO: floats *)
  2447. PROCEDURE EmitConv(VAR irInstruction: IntermediateCode.Instruction);
  2448. VAR
  2449. irDestination, irSource: IntermediateCode.Operand;
  2450. destination, source: ARRAY 2 OF Operand;
  2451. temp: Operand;
  2452. partType: IntermediateCode.Type;
  2453. BEGIN
  2454. irDestination := irInstruction.op1; irSource := irInstruction.op2;
  2455. (* prepare operands *)
  2456. destination[Low] := AcquireDestinationRegister(irDestination, Low, emptyOperand); (* TODO: find more optimal register allocation *)
  2457. source[Low] := RegisterOrImmediateFromIrOperand(irSource, Low, destination[Low]);
  2458. IF IsComplex(irDestination) THEN destination[High]:= AcquireDestinationRegister(irDestination, High, emptyOperand) END;
  2459. IF IsComplex(irSource) THEN source[High] := RegisterOrImmediateFromIrOperand(irSource, High, destination[High]) END; (* note that the corresponding destination register is used as hint *)
  2460. IF IsInteger(irDestination) THEN
  2461. (* to integer: *)
  2462. IF IsComplex(irDestination) THEN
  2463. (* to complex integer: *)
  2464. IF IsInteger(irSource) THEN
  2465. (* integer to complex integer: *)
  2466. IF IsComplex(irSource) THEN
  2467. (* complex integer to complex integer: *)
  2468. MovIfDifferent(destination[Low], source[Low]);
  2469. MovIfDifferent(destination[High], source[High]);
  2470. ELSE
  2471. (* non-complex integer to complex integer: *)
  2472. SignOrZeroExtendOperand(source[Low], irSource.type);
  2473. MovIfDifferent(destination[Low], source[Low]);
  2474. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2475. Emit2(opMOV, destination[High], InstructionSet.NewImmediate(0));
  2476. ELSE
  2477. (* for signed values the high part is set to 0...0 or 1...1, depending on the sign of the low part *)
  2478. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftASR, None, 32))
  2479. END
  2480. END
  2481. ELSIF IsSinglePrecisionFloat(irSource) THEN
  2482. ASSERT(backend.useFPU);
  2483. (* single precision float to complex integer: *)
  2484. temp := GetFreeRegister(IntermediateCode.FloatType(32));
  2485. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2486. (* single precision float to non-complex unsigned integer: *)
  2487. Emit2(opFTOUIS, temp, source[Low]);
  2488. ELSE
  2489. (* single precision float to non-complex signed integer: *)
  2490. Emit2(opFTOSIS, temp, source[Low]);
  2491. END;
  2492. Emit2(opFMRS, destination[Low], temp);
  2493. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2494. Emit2(opMOV, destination[High], InstructionSet.NewImmediate(0));
  2495. ELSE
  2496. (* for signed values the high part is set to 0...0 or 1...1, depending on the sign of the low part *)
  2497. Emit2(opMOV, destination[High], InstructionSet.NewRegister(destination[Low].register, InstructionSet.shiftASR, None, 32))
  2498. END
  2499. ELSE
  2500. (* anything else to complex-integer: *)
  2501. HALT(200)
  2502. END
  2503. ELSE
  2504. (* to non-complex integer: *)
  2505. IF IsInteger(irSource) THEN
  2506. (* integer to non-complex integer: ignore high part of source *)
  2507. GetPartType(irSource.type, Low, partType);
  2508. SignOrZeroExtendOperand(source[Low], partType);
  2509. MovIfDifferent(destination[Low], source[Low])
  2510. ELSIF IsSinglePrecisionFloat(irSource) THEN
  2511. ASSERT(backend.useFPU);
  2512. (* single precision float to non-complex integer: *)
  2513. temp := GetFreeRegister(IntermediateCode.FloatType(32));
  2514. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2515. (* single precision float to non-complex unsigned integer: *)
  2516. Emit2(opFTOUIS, temp, source[Low]);
  2517. ELSE
  2518. (* single precision float to non-complex signed integer: *)
  2519. Emit2(opFTOSIS, temp, source[Low]);
  2520. END;
  2521. Emit2(opFMRS, destination[Low], temp)
  2522. ELSE
  2523. (* anything to non-complex integer: *)
  2524. HALT(200)
  2525. END
  2526. END
  2527. ELSIF IsSinglePrecisionFloat(irDestination) THEN
  2528. (* to single precision float: *)
  2529. IF IsInteger(irSource) THEN
  2530. (* integer to single precision float: ignore high part of source *)
  2531. temp := GetFreeRegister(IntermediateCode.FloatType(32));
  2532. Emit2(opFMSR, temp, source[Low]);
  2533. IF irSource.type.form = IntermediateCode.UnsignedInteger THEN
  2534. (* non-complex unsigned integer to single precision float: *)
  2535. Emit2(opFUITOS, destination[Low], temp)
  2536. ELSE
  2537. (* non-complex signed integer to single precision float: *)
  2538. Emit2(opFSITOS, destination[Low], temp)
  2539. END
  2540. ELSIF IsSinglePrecisionFloat(irSource) THEN
  2541. (* single precision float to single precision float: *)
  2542. MovIfDifferent(destination[Low], source[Low])
  2543. ELSE
  2544. (* anything else to single precision float: *)
  2545. HALT(200)
  2546. END
  2547. ELSE
  2548. (* to anything else: *)
  2549. HALT(200)
  2550. END;
  2551. WriteBack(irDestination, Low, destination[Low]);
  2552. IF IsComplex(irDestination) THEN WriteBack(irInstruction.op1, High, destination[High]) END
  2553. END EmitConv;
  2554. (** get the register that is dedicated to store a return value of a function **)
  2555. PROCEDURE ResultRegister(part: LONGINT; type: IntermediateCode.Type): InstructionSet.Operand;
  2556. VAR
  2557. result: Operand;
  2558. BEGIN
  2559. IF (type.form IN IntermediateCode.Integer) OR ~(backend.useFPU) THEN
  2560. IF part = Low THEN result := opRES
  2561. ELSIF part = High THEN result := opRESHI
  2562. ELSE HALT(200)
  2563. END
  2564. ELSIF type.form = IntermediateCode.Float THEN
  2565. ASSERT(type.sizeInBits = 32, 200);
  2566. result := opRESFS
  2567. END;
  2568. RETURN result
  2569. END ResultRegister;
  2570. PROCEDURE EmitReturn(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  2571. VAR
  2572. source: Operand;
  2573. BEGIN
  2574. source := RegisterOrImmediateFromIrOperand(irInstruction.op1, part, ResultRegister(part, irInstruction.op1.type)); (* note: the result register is given as a hint *)
  2575. MovIfDifferent(ResultRegister(part, irInstruction.op1.type), source)
  2576. END EmitReturn;
  2577. PROCEDURE EmitResult(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  2578. VAR
  2579. destinationRegister: Operand;
  2580. BEGIN
  2581. destinationRegister := AcquireDestinationRegister(irInstruction.op1, part, emptyOperand);
  2582. MovIfDifferent(destinationRegister, ResultRegister(part, irInstruction.op1.type));
  2583. WriteBack(irInstruction.op1, part, destinationRegister)
  2584. END EmitResult;
  2585. PROCEDURE EmitTrap(CONST irInstruction: IntermediateCode.Instruction);
  2586. BEGIN
  2587. ASSERT(irInstruction.op1.mode = IntermediateCode.ModeNumber);
  2588. Emit1(opSWI, InstructionSet.NewImmediate(LONGINT(irInstruction.op1.intValue))) (* software interrupt *)
  2589. END EmitTrap;
  2590. (* possible optimization: use a combination of LDR and LDRB (would be 4x faster on average) *)
  2591. PROCEDURE EmitCopy(VAR irInstruction: IntermediateCode.Instruction);
  2592. VAR
  2593. targetBaseReg, sourceBaseReg, length, lastSourceAddress, currentTargetReg, currentSourceReg, tempReg: Operand;
  2594. BEGIN
  2595. ASSERT((irInstruction.op1.type.form = IntermediateCode.UnsignedInteger) & (irInstruction.op1.type.sizeInBits = 32));
  2596. ASSERT((irInstruction.op2.type.form = IntermediateCode.UnsignedInteger) & (irInstruction.op2.type.sizeInBits = 32));
  2597. ASSERT((irInstruction.op3.type.form = IntermediateCode.UnsignedInteger) & (irInstruction.op3.type.sizeInBits = 32));
  2598. currentTargetReg := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2599. currentSourceReg := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2600. (* note that the registers that store the current addresses are used as hints: *)
  2601. targetBaseReg := RegisterFromIrOperand(irInstruction.op1, Low, currentTargetReg);
  2602. sourceBaseReg := RegisterFromIrOperand(irInstruction.op2, Low, currentSourceReg);
  2603. MovIfDifferent(currentTargetReg, targetBaseReg);
  2604. MovIfDifferent(currentSourceReg, sourceBaseReg);
  2605. lastSourceAddress := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2606. length := RegisterOrImmediateFromIrOperand(irInstruction.op3, Low, lastSourceAddress); (* note that the last source address register is used as hint*)
  2607. Emit3(opADD, lastSourceAddress, sourceBaseReg, length);
  2608. tempReg := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2609. Emit2WithFlags(opLDR, tempReg, InstructionSet.NewImmediateOffsetMemory(currentSourceReg.register, 1, {InstructionSet.Increment, InstructionSet.PostIndexed}), {InstructionSet.flagB});
  2610. Emit2WithFlags(opSTR, tempReg, InstructionSet.NewImmediateOffsetMemory(currentTargetReg.register, 1, {InstructionSet.Increment, InstructionSet.PostIndexed}), {InstructionSet.flagB});
  2611. Emit2(opCMP, currentSourceReg, lastSourceAddress);
  2612. Emit1WithCondition(opB, InstructionSet.NewImmediate(-20), InstructionSet.conditionLT)
  2613. END EmitCopy;
  2614. PROCEDURE EmitFill(CONST irInstruction: IntermediateCode.Instruction; down: BOOLEAN);
  2615. BEGIN
  2616. HALT(200) (* note that this instruction is not used at the moment *)
  2617. END EmitFill;
  2618. (* PREPARATION OF OPERATIONS *)
  2619. (** swap a pair of IR operands **)
  2620. PROCEDURE SwapIrOperands(VAR left, right: IntermediateCode.Operand);
  2621. VAR
  2622. temp: IntermediateCode.Operand;
  2623. BEGIN
  2624. temp := left;
  2625. left := right;
  2626. right := temp
  2627. END SwapIrOperands;
  2628. PROCEDURE PrepareSingleSourceOp(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, sourceOperand: Operand);
  2629. BEGIN
  2630. destinationRegister := AcquireDestinationRegister(irInstruction.op1, part, emptyOperand);
  2631. sourceOperand := RegisterFromIrOperand(irInstruction.op2, part, destinationRegister); (* note that the destination register is used as hint *)
  2632. END PrepareSingleSourceOp;
  2633. PROCEDURE PrepareSingleSourceOpWithImmediate(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, sourceOperand: Operand);
  2634. BEGIN
  2635. destinationRegister := AcquireDestinationRegister(irInstruction.op1, part, emptyOperand);
  2636. sourceOperand := RegisterOrImmediateFromIrOperand(irInstruction.op2, part, destinationRegister); (* note that the destination register is used as hint *)
  2637. END PrepareSingleSourceOpWithImmediate;
  2638. PROCEDURE PrepareDoubleSourceOpWithImmediate(CONST irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, leftSourceOperand, rightSourceOperand: Operand; VAR isSwapped: BOOLEAN);
  2639. VAR
  2640. irDestination, irLeft, irRight: IntermediateCode.Operand;
  2641. BEGIN
  2642. irDestination := irInstruction.op1;
  2643. irLeft := irInstruction.op2;
  2644. irRight := irInstruction.op3;
  2645. destinationRegister:= AcquireDestinationRegister(irDestination, part, emptyOperand);
  2646. (* swap operands such that the right one is an immediate *)
  2647. IF IrOperandIsDirectlyEncodable(irLeft, part) & ~IrOperandIsDirectlyEncodable(irRight, part) THEN
  2648. SwapIrOperands(irLeft, irRight);
  2649. isSwapped := TRUE
  2650. ELSIF IntermediateCode.OperandEquals(irRight, irDestination) THEN
  2651. SwapIrOperands(irLeft, irRight);
  2652. isSwapped := TRUE
  2653. ELSE
  2654. isSwapped := FALSE
  2655. END;
  2656. leftSourceOperand := RegisterFromIrOperand(irLeft, part, destinationRegister); (* the destination register is used as hint *)
  2657. IF IsSameRegister(leftSourceOperand, destinationRegister) THEN
  2658. rightSourceOperand := RegisterOrImmediateFromIrOperand(irRight, part, emptyOperand) (* no hint is provided *)
  2659. ELSE
  2660. rightSourceOperand := RegisterOrImmediateFromIrOperand(irRight, part, destinationRegister) (* the destination register is again used as hint *)
  2661. END
  2662. END PrepareDoubleSourceOpWithImmediate;
  2663. PROCEDURE PrepareDoubleSourceOp(CONST irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, leftSourceOperand, rightSourceOperand: Operand);
  2664. VAR
  2665. irDestination, irLeft, irRight: IntermediateCode.Operand;
  2666. BEGIN
  2667. irDestination := irInstruction.op1;
  2668. irLeft := irInstruction.op2;
  2669. irRight := irInstruction.op3;
  2670. destinationRegister:= AcquireDestinationRegister(irDestination, part, emptyOperand);
  2671. IF IntermediateCode.OperandEquals(irRight, irDestination) THEN
  2672. leftSourceOperand := RegisterFromIrOperand(irLeft, part, emptyOperand); (* do not use destination register as hint *)
  2673. ELSE
  2674. leftSourceOperand := RegisterFromIrOperand(irLeft, part, destinationRegister); (* the destination register is used as hint *)
  2675. END;
  2676. IF IsSameRegister(leftSourceOperand, destinationRegister) OR IntermediateCode.OperandEquals(irRight, irDestination) THEN
  2677. rightSourceOperand := RegisterFromIrOperand(irRight, part, emptyOperand) (* no hint is provided *)
  2678. ELSE
  2679. rightSourceOperand := RegisterFromIrOperand(irRight, part, destinationRegister) (* the destination register is again used as hint *)
  2680. END
  2681. END PrepareDoubleSourceOp;
  2682. END CodeGeneratorARM;
  2683. BackendARM = OBJECT(IntermediateBackend.IntermediateBackend)
  2684. VAR
  2685. cg: CodeGeneratorARM;
  2686. system: Global.System;
  2687. useFPU: BOOLEAN;
  2688. initLocals: BOOLEAN;
  2689. PROCEDURE & InitBackendARM;
  2690. BEGIN
  2691. useFPU := FALSE;
  2692. InitIntermediateBackend;
  2693. SetRuntimeModuleName(DefaultRuntimeModuleName);
  2694. SetNewObjectFile(TRUE,FALSE);
  2695. system := NIL;
  2696. initLocals := TRUE;
  2697. END InitBackendARM;
  2698. PROCEDURE Initialize(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System; activeCellsSpecification: ActiveCells.Specification);
  2699. BEGIN
  2700. Initialize^(diagnostics, log, flags, checker, system, activeCellsSpecification);
  2701. NEW(cg, runtimeModuleName, diagnostics, SELF)
  2702. END Initialize;
  2703. PROCEDURE EnterCustomBuiltins;
  2704. VAR
  2705. procedureType: SyntaxTree.ProcedureType;
  2706. parameter: SyntaxTree.Parameter;
  2707. PROCEDURE New;
  2708. BEGIN procedureType := SyntaxTree.NewProcedureType(-1, NIL)
  2709. END New;
  2710. PROCEDURE BoolRet;
  2711. BEGIN procedureType.SetReturnType(system.booleanType)
  2712. END BoolRet;
  2713. PROCEDURE IntRet;
  2714. BEGIN procedureType.SetReturnType(Global.Integer32)
  2715. END IntRet;
  2716. PROCEDURE IntPar;
  2717. BEGIN
  2718. parameter := SyntaxTree.NewParameter(-1, procedureType, SyntaxTree.NewIdentifier(""), SyntaxTree.ValueParameter);
  2719. parameter.SetType(Global.Integer32); procedureType.AddParameter(parameter)
  2720. END IntPar;
  2721. PROCEDURE IntVarPar;
  2722. BEGIN
  2723. parameter := SyntaxTree.NewParameter(-1, procedureType, SyntaxTree.NewIdentifier(""), SyntaxTree.VarParameter);
  2724. parameter.SetType(Global.Integer32); procedureType.AddParameter(parameter)
  2725. END IntVarPar;
  2726. PROCEDURE RealVarPar;
  2727. BEGIN
  2728. parameter := SyntaxTree.NewParameter(-1, procedureType, SyntaxTree.NewIdentifier(""), SyntaxTree.VarParameter);
  2729. parameter.SetType(Global.Float32); procedureType.AddParameter(parameter)
  2730. END RealVarPar;
  2731. PROCEDURE Finish(CONST name: ARRAY OF CHAR; number: SHORTINT);
  2732. BEGIN Global.NewCustomBuiltin(name, system.systemScope, number, procedureType);
  2733. END Finish;
  2734. BEGIN
  2735. New; IntRet; Finish("SP", GetSP);
  2736. New; IntPar; Finish("SetSP", SetSP);
  2737. New; IntRet; Finish("FP", GetFP);
  2738. New; IntPar; Finish("SetFP", SetFP);
  2739. New; IntRet; Finish("PC", GetPC);
  2740. New; IntPar; Finish("SetPC", SetPC);
  2741. New; IntRet; Finish("LNK", GetLNK);
  2742. New; IntPar; Finish("SetLNK", SetLNK);
  2743. New; IntPar; IntPar; Finish("LDPSR", LDPSR);
  2744. New; IntPar; IntVarPar; Finish("STPSR", STPSR);
  2745. New; IntPar; IntPar; IntPar; Finish("LDCPR", LDCPR);
  2746. New; IntPar; IntPar; IntVarPar; Finish("STCPR", STCPR);
  2747. New; IntPar; Finish("FLUSH", FLUSH);
  2748. New; BoolRet; IntPar; Finish("NULL", NULL);
  2749. New; IntRet; IntPar; IntPar; Finish("XOR", XOR);
  2750. New; IntVarPar; IntPar; IntPar; Finish("MULD", MULD);
  2751. New; IntVarPar; IntPar; IntPar; Finish("ADDC", ADDC);
  2752. New; RealVarPar; IntPar; Finish("PACK", PACK);
  2753. New; RealVarPar; IntVarPar; Finish("UNPK", UNPK);
  2754. END EnterCustomBuiltins;
  2755. PROCEDURE GetSystem(): Global.System;
  2756. BEGIN
  2757. (* create system object if not yet existing *)
  2758. IF system = NIL THEN
  2759. (* used stack frame layout:
  2760. param 1
  2761. param 2
  2762. ...
  2763. param n-1
  2764. FP+8 -> param n
  2765. FP+4 -> old LR
  2766. FP -> old FP
  2767. FP-4 -> local 1
  2768. local 2
  2769. ...
  2770. spill 1
  2771. spill 2
  2772. ....
  2773. *)
  2774. (*
  2775. codeUnit, dataUnit = 8, 8
  2776. addressSize = 32
  2777. minVarAlign, maxVarAlign = 32, 32
  2778. minParAlign, maxParAlign = 8, 32
  2779. offsetFirstPar = 32 * 2
  2780. registerParameters = 0
  2781. *)
  2782. NEW(system, 8, 8, 32, (*32*) 8, 32, 8, 32, 32 * 2, 0, cooperative);
  2783. IF oberon07 THEN
  2784. IF Trace THEN D.String("Oberon07"); D.Ln END;
  2785. Global.SetDefaultDeclarations(system, 32) (* each basic type uses at least 32 bits -> INTEGER will be 32 bits long *)
  2786. ELSE
  2787. IF Trace THEN D.String("not Oberon07"); D.Ln END;
  2788. Global.SetDefaultDeclarations(system, 8) (* INTEGER will be 16 bits long *)
  2789. END;
  2790. Global.SetDefaultOperators(system);
  2791. EnterCustomBuiltins
  2792. END;
  2793. RETURN system
  2794. END GetSystem;
  2795. (** whether the code generator can generate code for a certain IR instruction
  2796. if not, where to find the runtime procedure that is to be called instead **)
  2797. PROCEDURE SupportedInstruction(CONST irInstruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  2798. BEGIN
  2799. (* only necessary for binary object file format for symbol / module entry in IntermediateBackend *)
  2800. RETURN cg.Supported(irInstruction, moduleName, procedureName);
  2801. END SupportedInstruction;
  2802. (** whether a certain intermediate code immediate value can be directly appear in code
  2803. if not, the value is stored in a const section and loaded from there **)
  2804. PROCEDURE SupportedImmediate(CONST irImmediateOperand: IntermediateCode.Operand): BOOLEAN;
  2805. VAR
  2806. result: BOOLEAN;
  2807. BEGIN
  2808. (* TODO: remove this *)
  2809. RETURN TRUE; (* tentatively generate all immediates, as symbol fixups are not yet implemented *)
  2810. result := FALSE;
  2811. IF (irImmediateOperand.type.form IN IntermediateCode.Integer) & (irImmediateOperand.type.sizeInBits <= 32) THEN
  2812. (* 32 bit integers *)
  2813. IF cg.ValueIsDirectlyEncodable(LONGINT(irImmediateOperand.intValue)) THEN
  2814. (* the value can be directly encoded as an ARM immediate operand *)
  2815. result := TRUE
  2816. ELSIF cg.ValueComposition(LONGINT(irImmediateOperand.intValue), FALSE, emptyOperand) <= 2 THEN (* TODO: find reasonable limit *)
  2817. (* the value can be generated using a limited amount of intructions *)
  2818. result := TRUE
  2819. END
  2820. END;
  2821. RETURN result
  2822. END SupportedImmediate;
  2823. PROCEDURE GenerateBinary(module: Sections.Module; dump: Streams.Writer);
  2824. VAR
  2825. in: Sections.Section;
  2826. out: BinaryCode.Section;
  2827. name: Basic.SectionName;
  2828. procedure: SyntaxTree.Procedure;
  2829. i, j, initialSectionCount: LONGINT;
  2830. (* recompute fixup positions and assign binary sections *)
  2831. PROCEDURE PatchFixups(section: BinaryCode.Section);
  2832. VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; displacement,symbolOffset: LONGINT; in: IntermediateCode.Section;
  2833. symbol: Sections.Section;
  2834. BEGIN
  2835. fixup := section.fixupList.firstFixup;
  2836. WHILE fixup # NIL DO
  2837. symbol := module.allSections.FindByName(fixup.symbol.name);
  2838. IF (symbol # NIL) & (symbol(IntermediateCode.Section).resolved # NIL) THEN
  2839. resolved := symbol(IntermediateCode.Section).resolved(BinaryCode.Section);
  2840. in := symbol(IntermediateCode.Section);
  2841. symbolOffset := fixup.symbolOffset;
  2842. IF symbolOffset = in.pc THEN
  2843. displacement := resolved.pc
  2844. ELSIF (symbolOffset # 0) THEN
  2845. ASSERT(in.pc > symbolOffset);
  2846. displacement := in.instructions[symbolOffset].pc;
  2847. ELSE
  2848. displacement := 0;
  2849. END;
  2850. fixup.SetSymbol(fixup.symbol.name,fixup.symbol.fingerprint,0,fixup.displacement+displacement);
  2851. END;
  2852. fixup := fixup.nextFixup;
  2853. END;
  2854. END PatchFixups;
  2855. (*
  2856. PROCEDURE Resolve(VAR fixup: BinaryCode.Fixup);
  2857. BEGIN
  2858. IF (fixup.symbol.name # "") & (fixup.resolved = NIL) THEN fixup.resolved := module.allSections.FindByName(fixup.symbol.name) END;
  2859. END Resolve;
  2860. (* recompute fixup positions and assign binary sections *)
  2861. PROCEDURE PatchFixups(section: BinaryCode.Section);
  2862. VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; symbolOffset, offsetWithinSection: LONGINT; in: IntermediateCode.Section;
  2863. BEGIN
  2864. fixup := section.fixupList.firstFixup;
  2865. WHILE fixup # NIL DO
  2866. Resolve(fixup);
  2867. IF (fixup.resolved # NIL) & (fixup.resolved(IntermediateCode.Section).resolved # NIL) THEN
  2868. resolved := fixup.resolved(IntermediateCode.Section).resolved(BinaryCode.Section);
  2869. in := fixup.resolved(IntermediateCode.Section);
  2870. (* TODO: is this correct? *)
  2871. symbolOffset := fixup.symbolOffset;
  2872. ASSERT(fixup.symbolOffset < in.pc);
  2873. IF (fixup.symbolOffset # 0) & (symbolOffset < in.pc) THEN
  2874. offsetWithinSection := in.instructions[fixup.symbolOffset].pc;
  2875. (*
  2876. (* TENTATIVE *)
  2877. D.String("FIXUP PATCH:"); D.Ln;
  2878. D.String(" symbol name: "); fixup.symbol.DumpName(D.Log); D.String("/");
  2879. D.String(" symbol offset: "); D.Int(fixup.symbolOffset, 0); D.Ln;
  2880. D.String(" offsetWithinSection"); D.Int(offsetWithinSection, 0); D.Ln;
  2881. D.String(" fixup.displacement (before)"); D.Int(fixup.displacement, 0); D.Ln; ; D.Ln;
  2882. D.Update;
  2883. *)
  2884. (* remove the fixup's symbol offset (in IR units) and change the displacement (in system units) accordingly: *)
  2885. fixup.SetSymbol(fixup.symbol.name, fixup.symbol.fingerprint, 0, offsetWithinSection + fixup.displacement)
  2886. END
  2887. END;
  2888. fixup := fixup.nextFixup;
  2889. END;
  2890. END PatchFixups;
  2891. *)
  2892. BEGIN
  2893. cg.SetModule(module);
  2894. cg.dump := dump;
  2895. FOR i := 0 TO module.allSections.Length() - 1 DO
  2896. in := module.allSections.GetSection(i);
  2897. IF in.type = Sections.InlineCodeSection THEN
  2898. Basic.SegmentedNameToString(in.name, name);
  2899. out := ResolvedSection(in(IntermediateCode.Section));
  2900. cg.dump := out.comments;
  2901. cg.Section(in(IntermediateCode.Section), out);
  2902. IF in.symbol # NIL THEN
  2903. procedure := in.symbol(SyntaxTree.Procedure);
  2904. procedure.procedureScope.body.code.SetBinaryCode(out.os.bits);
  2905. END;
  2906. END
  2907. END;
  2908. initialSectionCount := 0;
  2909. REPEAT
  2910. j := initialSectionCount;
  2911. initialSectionCount := module.allSections.Length() ;
  2912. FOR i := j TO initialSectionCount - 1 DO
  2913. in := module.allSections.GetSection(i);
  2914. Basic.SegmentedNameToString(in.name, name);
  2915. IF (in.type # Sections.InlineCodeSection) & (in(IntermediateCode.Section).resolved = NIL) THEN
  2916. out := ResolvedSection(in(IntermediateCode.Section));
  2917. cg.Section(in(IntermediateCode.Section),out);
  2918. END
  2919. END
  2920. UNTIL initialSectionCount = module.allSections.Length(); (* process remaining sections that have been added during traversal of sections *)
  2921. FOR i := 0 TO module.allSections.Length() - 1 DO
  2922. in := module.allSections.GetSection(i);
  2923. Basic.SegmentedNameToString(in.name, name);
  2924. in := module.allSections.GetSection(i);
  2925. PatchFixups(in(IntermediateCode.Section).resolved)
  2926. END;
  2927. IF cg.error THEN Error("", Diagnostics.Invalid, Diagnostics.Invalid, "") END
  2928. END GenerateBinary;
  2929. (** create an ARM code module from an intermediate code module **)
  2930. PROCEDURE ProcessIntermediateCodeModule*(intermediateCodeModule: Formats.GeneratedModule): Formats.GeneratedModule;
  2931. VAR
  2932. result: Formats.GeneratedModule;
  2933. BEGIN
  2934. ASSERT(intermediateCodeModule IS Sections.Module);
  2935. result := ProcessIntermediateCodeModule^(intermediateCodeModule);
  2936. IF ~error THEN
  2937. GenerateBinary(result(Sections.Module), dump);
  2938. IF dump # NIL THEN
  2939. dump.Ln; dump.Ln;
  2940. dump.String("------------------ binary code -------------------"); dump.Ln;
  2941. IF (traceString="") OR (traceString="*") THEN
  2942. result.Dump(dump);
  2943. dump.Update
  2944. ELSE
  2945. Sections.DumpFiltered(dump, result(Sections.Module), traceString);
  2946. dump.Update;
  2947. END
  2948. END;
  2949. END;
  2950. RETURN result
  2951. FINALLY
  2952. IF dump # NIL THEN
  2953. dump.Ln; dump.Ln;
  2954. dump.String("------------------ rescued code (code generation trapped) -------------------"); dump.Ln;
  2955. IF (traceString="") OR (traceString="*") THEN
  2956. result.Dump(dump);
  2957. dump.Update
  2958. ELSE
  2959. Sections.DumpFiltered(dump,result(Sections.Module),traceString);
  2960. dump.Update;
  2961. END
  2962. END;
  2963. RETURN result
  2964. END ProcessIntermediateCodeModule;
  2965. PROCEDURE DefineOptions(options: Options.Options);
  2966. BEGIN
  2967. options.Add(0X, UseFPUFlag, Options.Flag);
  2968. options.Add(0X, "noInitLocals", Options.Flag);
  2969. DefineOptions^(options);
  2970. END DefineOptions;
  2971. PROCEDURE GetOptions(options: Options.Options);
  2972. BEGIN
  2973. IF options.GetFlag(UseFPUFlag) THEN useFPU := TRUE END;
  2974. IF options.GetFlag("noInitLocals") THEN initLocals := FALSE END;
  2975. GetOptions^(options);
  2976. END GetOptions;
  2977. PROCEDURE DefaultObjectFileFormat(): Formats.ObjectFileFormat;
  2978. BEGIN RETURN ObjectFileFormat.Get();
  2979. END DefaultObjectFileFormat;
  2980. PROCEDURE DefaultSymbolFileFormat(): Formats.SymbolFileFormat;
  2981. BEGIN RETURN NIL
  2982. END DefaultSymbolFileFormat;
  2983. (** get the name of the backend **)
  2984. PROCEDURE GetDescription(VAR instructionSet: ARRAY OF CHAR);
  2985. BEGIN instructionSet := "ARM"
  2986. END GetDescription;
  2987. PROCEDURE FindPC(x: SyntaxTree.Module; CONST sectionName: ARRAY OF CHAR; sectionOffset: LONGINT);
  2988. VAR
  2989. section: Sections.Section; binarySection: BinaryCode.Section; label: BinaryCode.LabelList; module: Formats.GeneratedModule;
  2990. i: LONGINT; pooledName: Basic.SegmentedName;
  2991. BEGIN
  2992. module := ProcessSyntaxTreeModule(x);
  2993. Basic.ToSegmentedName(sectionName, pooledName);
  2994. i := 0;
  2995. REPEAT
  2996. section := module(Sections.Module).allSections.GetSection(i);
  2997. INC(i);
  2998. UNTIL (i = module(Sections.Module).allSections.Length()) OR (section.name = pooledName);
  2999. IF section.name # pooledName THEN
  3000. diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
  3001. ELSE
  3002. binarySection := section(IntermediateCode.Section).resolved;
  3003. label := binarySection.labels;
  3004. WHILE (label # NIL) & (label.offset >= sectionOffset) DO
  3005. label := label.prev;
  3006. END;
  3007. IF label # NIL THEN
  3008. diagnostics.Information(module.module.sourceName,label.position,Diagnostics.Invalid," pc position");
  3009. ELSE
  3010. diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
  3011. END;
  3012. END;
  3013. END FindPC;
  3014. END BackendARM;
  3015. VAR
  3016. emptyOperand: Operand;
  3017. PROCEDURE Assert(condition: BOOLEAN; CONST message: ARRAY OF CHAR);
  3018. BEGIN ASSERT(condition, 100)
  3019. END Assert;
  3020. PROCEDURE Halt(CONST message: ARRAY OF CHAR);
  3021. BEGIN HALT(100)
  3022. END Halt;
  3023. PROCEDURE PowerOf2(val: HUGEINT; VAR exp: LONGINT): BOOLEAN;
  3024. BEGIN
  3025. IF val <= 0 THEN RETURN FALSE END;
  3026. exp := 0;
  3027. WHILE ~ODD(val) DO
  3028. val := val DIV 2;
  3029. INC(exp)
  3030. END;
  3031. RETURN val = 1
  3032. END PowerOf2;
  3033. (** get the ARM code section that corresponds to an intermediate code section **)
  3034. PROCEDURE ResolvedSection(irSection: IntermediateCode.Section): BinaryCode.Section;
  3035. VAR
  3036. result: BinaryCode.Section;
  3037. BEGIN
  3038. IF irSection.resolved = NIL THEN
  3039. NEW(result, irSection.type, irSection.priority, 8, irSection.name, irSection.comments # NIL, FALSE);
  3040. (* set fixed position or alignment
  3041. (also make sure that any section has an alignment of at least 4 bytes) *)
  3042. IF ~irSection.fixed & (irSection.positionOrAlignment < 4) THEN
  3043. result.SetAlignment(FALSE, 4)
  3044. ELSE
  3045. result.SetAlignment(irSection.fixed, irSection.positionOrAlignment);
  3046. END;
  3047. irSection.SetResolved(result)
  3048. ELSE
  3049. result := irSection.resolved
  3050. END;
  3051. RETURN result
  3052. END ResolvedSection;
  3053. (** initialize the module **)
  3054. PROCEDURE Init;
  3055. BEGIN InstructionSet.InitOperand(emptyOperand)
  3056. END Init;
  3057. (** get an instance of the ARM backend **)
  3058. PROCEDURE Get*(): Backend.Backend;
  3059. VAR
  3060. result: BackendARM;
  3061. BEGIN
  3062. NEW(result);
  3063. RETURN result
  3064. END Get;
  3065. (* only for testing purposes *)
  3066. PROCEDURE Test*;
  3067. VAR
  3068. codeGenerator: CodeGeneratorARM;
  3069. value, count: LONGINT;
  3070. BEGIN
  3071. NEW(codeGenerator, "", NIL, NIL);
  3072. FOR value := 0 TO 300 BY 1 DO
  3073. count := codeGenerator.ValueComposition(value, FALSE, emptyOperand);
  3074. D.String("value: "); D.Int(value, 0); D.String(" -> "); D.Int(count, 0); D.String(" instructions"); D.Ln;
  3075. END;
  3076. D.Ln; D.Update
  3077. END Test;
  3078. (* TODO: move this to Debugging.Mod or even Streams.Mod *)
  3079. (** write an integer in binary right-justified in a field of at least ABS(w) characters.
  3080. If w < 0 THEN ABS(w) least significant hex digits of 'value' are written (potentially including leading zeros or ones)
  3081. **)
  3082. PROCEDURE DBin*(value: HUGEINT; numberDigits: LONGINT);
  3083. CONST
  3084. MaxBitSize = SIZEOF(HUGEINT) * 8;
  3085. VAR
  3086. i, firstRelevantPos: LONGINT;
  3087. prefixWithSpaces: BOOLEAN;
  3088. chars: ARRAY MaxBitSize OF CHAR;
  3089. prefixChar: CHAR;
  3090. BEGIN
  3091. prefixWithSpaces := numberDigits >= 0;
  3092. numberDigits := ABS(numberDigits);
  3093. (*
  3094. - calculate an array containing the full bitstring
  3095. - determine the position of the first relevant digit
  3096. *)
  3097. firstRelevantPos := 0;
  3098. FOR i := MaxBitSize - 1 TO 0 BY -1 DO
  3099. IF ODD(value) THEN
  3100. chars[i] := '1';
  3101. firstRelevantPos := i (* occurence of a '1' -> changes the first relevant position *)
  3102. ELSE
  3103. chars[i] := '0'
  3104. END;
  3105. value := value DIV 2
  3106. END;
  3107. (* if space prefixing is enabled, limit the number of digits to the relevant digits *)
  3108. IF prefixWithSpaces THEN numberDigits := MAX(numberDigits, MaxBitSize - firstRelevantPos) END;
  3109. IF numberDigits > MaxBitSize THEN
  3110. IF prefixWithSpaces THEN prefixChar := ' ' ELSE prefixChar := chars[0] END; (* use spaces or sign bit *)
  3111. FOR i := 1 TO numberDigits - MaxBitSize DO D.Char(prefixChar) END;
  3112. numberDigits := MaxBitSize
  3113. END;
  3114. ASSERT((numberDigits >= 0) & (numberDigits <= MaxBitSize));
  3115. FOR i := MaxBitSize - numberDigits TO MaxBitSize - 1 DO
  3116. IF prefixWithSpaces & (i < firstRelevantPos) THEN D.Char(' ') ELSE D.Char(chars[i]) END
  3117. END;
  3118. D.Ln;
  3119. END DBin;
  3120. BEGIN
  3121. Init;
  3122. END FoxARMBackend.