FoxARMBackend.Mod 147 KB

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