FoxARMBackend.Mod 154 KB

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