FoxARMBackend.Mod 160 KB

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