FoxARMBackend.Mod 153 KB

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