FoxARMBackend.Mod 163 KB

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