FoxARMBackend.Mod 155 KB

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