FoxARMBackend.Mod 156 KB

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