ninl.pas 215 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518
  1. {
  2. Copyright (c) 1998-2007 by Florian Klaempfl
  3. Type checking and register allocation for inline nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit ninl;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. node,htypechk,symtype,compinnr;
  22. type
  23. tinlinenode = class(tunarynode)
  24. inlinenumber : tinlinenumber;
  25. constructor create(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
  26. constructor createintern(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
  27. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  28. procedure ppuwrite(ppufile:tcompilerppufile);override;
  29. function dogetcopy : tnode;override;
  30. procedure printnodeinfo(var t : text);override;
  31. {$ifdef DEBUG_NODE_XML}
  32. procedure XMLPrintNodeInfo(var t : text);override;
  33. {$endif DEBUG_NODE_XML}
  34. function pass_1 : tnode;override;
  35. function pass_typecheck:tnode;override;
  36. function pass_typecheck_cpu:tnode;virtual;
  37. function simplify(forinline : boolean): tnode;override;
  38. function docompare(p: tnode): boolean; override;
  39. procedure mark_write;override;
  40. { returns a node tree where the inc/dec are replaced by add/sub }
  41. function getaddsub_for_incdec : tnode;
  42. { pack and unpack are changed into for-loops by the compiler }
  43. function first_pack_unpack: tnode; virtual;
  44. property parameters : tnode read left write left;
  45. function may_have_sideeffect_norecurse: boolean;
  46. protected
  47. { All the following routines currently
  48. call compilerprocs, unless they are
  49. overridden in which case, the code
  50. generator handles them.
  51. }
  52. function first_pi: tnode ; virtual;
  53. function first_arctan_real: tnode; virtual;
  54. function first_abs_real: tnode; virtual;
  55. function first_sqr_real: tnode; virtual;
  56. function first_sqrt_real: tnode; virtual;
  57. function first_ln_real: tnode; virtual;
  58. function first_cos_real: tnode; virtual;
  59. function first_sin_real: tnode; virtual;
  60. function first_exp_real: tnode; virtual;
  61. function first_frac_real: tnode; virtual;
  62. function first_round_real: tnode; virtual;
  63. function first_trunc_real: tnode; virtual;
  64. function first_int_real: tnode; virtual;
  65. function first_abs_long: tnode; virtual;
  66. function first_IncDec: tnode; virtual;
  67. function first_IncludeExclude: tnode; virtual;
  68. function first_get_frame: tnode; virtual;
  69. function first_setlength: tnode; virtual;
  70. function first_copy: tnode; virtual;
  71. { This one by default generates an internal error, because such
  72. nodes are not generated by the parser. It's however used internally
  73. by the JVM backend to create new dynamic arrays. }
  74. function first_new: tnode; virtual;
  75. function first_length: tnode; virtual;
  76. function first_high: tnode; virtual;
  77. function first_box: tnode; virtual; abstract;
  78. function first_unbox: tnode; virtual; abstract;
  79. function first_assigned: tnode; virtual;
  80. function first_assert: tnode; virtual;
  81. function first_popcnt: tnode; virtual;
  82. function first_bitscan: tnode; virtual;
  83. { override these for Seg() support }
  84. function typecheck_seg: tnode; virtual;
  85. function first_seg: tnode; virtual;
  86. function first_sar: tnode; virtual;
  87. function first_fma : tnode; virtual;
  88. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  89. function first_ShiftRot_assign_64bitint: tnode; virtual;
  90. {$endif not cpu64bitalu and not cpuhighleveltarget}
  91. function first_AndOrXorShiftRot_assign: tnode; virtual;
  92. function first_NegNot_assign: tnode; virtual;
  93. function first_cpu : tnode; virtual;
  94. procedure CheckParameters(count : integer);
  95. private
  96. function handle_str: tnode;
  97. function handle_reset_rewrite_typed: tnode;
  98. function handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
  99. function handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
  100. function handle_read_write: tnode;
  101. function handle_val: tnode;
  102. function handle_default: tnode;
  103. function handle_setlength: tnode;
  104. function handle_copy: tnode;
  105. function handle_box: tnode;
  106. function handle_unbox: tnode;
  107. function handle_insert:tnode;
  108. function handle_delete:tnode;
  109. function handle_concat:tnode;
  110. end;
  111. tinlinenodeclass = class of tinlinenode;
  112. var
  113. cinlinenode : tinlinenodeclass = tinlinenode;
  114. function geninlinenode(number : tinlinenumber;is_const:boolean;l : tnode) : tinlinenode;
  115. implementation
  116. uses
  117. verbose,globals,systems,constexp,
  118. globtype,cutils,cclasses,fmodule,
  119. symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
  120. cpuinfo,cpubase,
  121. pass_1,
  122. ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
  123. nobjc,objcdef,
  124. cgbase,procinfo;
  125. function geninlinenode(number : tinlinenumber;is_const:boolean;l : tnode) : tinlinenode;
  126. begin
  127. geninlinenode:=cinlinenode.create(number,is_const,l);
  128. end;
  129. {*****************************************************************************
  130. TINLINENODE
  131. *****************************************************************************}
  132. constructor tinlinenode.create(number : tinlinenumber;is_const:boolean;l : tnode);
  133. begin
  134. inherited create(inlinen,l);
  135. if is_const then
  136. include(flags,nf_inlineconst);
  137. inlinenumber:=number;
  138. end;
  139. constructor tinlinenode.createintern(number : tinlinenumber; is_const : boolean;
  140. l : tnode);
  141. begin
  142. create(number,is_const,l);
  143. include(flags,nf_internal);
  144. end;
  145. constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  146. begin
  147. inherited ppuload(t,ppufile);
  148. inlinenumber:=tinlinenumber(ppufile.getlongint);
  149. end;
  150. procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile);
  151. begin
  152. inherited ppuwrite(ppufile);
  153. ppufile.putlongint(longint(inlinenumber));
  154. end;
  155. function tinlinenode.dogetcopy : tnode;
  156. var
  157. n : tinlinenode;
  158. begin
  159. n:=tinlinenode(inherited dogetcopy);
  160. n.inlinenumber:=inlinenumber;
  161. result:=n;
  162. end;
  163. procedure tinlinenode.printnodeinfo(var t : text);
  164. begin
  165. inherited;
  166. write(t,', inlinenumber = ',inlinenumber);
  167. end;
  168. {$ifdef DEBUG_NODE_XML}
  169. procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
  170. begin
  171. inherited;
  172. Write(T, ' inlinenumber="', inlinenumber, '"');
  173. end;
  174. {$endif DEBUG_NODE_XML}
  175. function get_str_int_func(def: tdef): string;
  176. var
  177. ordtype: tordtype;
  178. begin
  179. ordtype := torddef(def).ordtype;
  180. if not (ordtype in [scurrency,s64bit,u64bit,s32bit,u32bit,s16bit,u16bit,s8bit,u8bit]) then
  181. internalerror(2013032603);
  182. if is_oversizedord(def) then
  183. begin
  184. case ordtype of
  185. scurrency,
  186. s64bit: exit('int64');
  187. u64bit: exit('qword');
  188. s32bit: exit('longint');
  189. u32bit: exit('longword');
  190. s16bit: exit('smallint');
  191. u16bit: exit('word');
  192. else
  193. internalerror(2013032604);
  194. end;
  195. end
  196. else
  197. begin
  198. if is_nativeuint(def) then
  199. exit('uint')
  200. else
  201. exit('sint');
  202. end;
  203. internalerror(2013032605);
  204. end;
  205. function tinlinenode.handle_str : tnode;
  206. var
  207. lenpara,
  208. fracpara,
  209. newparas,
  210. tmppara,
  211. dest,
  212. source : tcallparanode;
  213. procname: string;
  214. is_real,is_enum : boolean;
  215. rt : aint;
  216. begin
  217. result := cerrornode.create;
  218. { get destination string }
  219. dest := tcallparanode(left);
  220. { get source para (number) }
  221. source := dest;
  222. while assigned(source.right) do
  223. source := tcallparanode(source.right);
  224. { destination parameter must be a normal (not a colon) parameter, this
  225. check is needed because str(v:len) also has 2 parameters }
  226. if (source=dest) or
  227. (cpf_is_colon_para in tcallparanode(dest).callparaflags) then
  228. begin
  229. CGMessage1(parser_e_wrong_parameter_size,'Str');
  230. exit;
  231. end;
  232. { in case we are in a generic definition, we cannot
  233. do all checks, the parameters might be type parameters }
  234. if df_generic in current_procinfo.procdef.defoptions then
  235. begin
  236. result.Free;
  237. result:=nil;
  238. resultdef:=voidtype;
  239. exit;
  240. end;
  241. is_real:=(source.resultdef.typ = floatdef) or is_currency(source.resultdef);
  242. is_enum:=source.left.resultdef.typ=enumdef;
  243. if ((dest.left.resultdef.typ<>stringdef) and
  244. not(is_chararray(dest.left.resultdef))) or
  245. not(is_real or is_enum or
  246. (source.left.resultdef.typ=orddef)) then
  247. begin
  248. CGMessagePos(fileinfo,parser_e_illegal_expression);
  249. exit;
  250. end;
  251. { get len/frac parameters }
  252. lenpara := nil;
  253. fracpara := nil;
  254. if (cpf_is_colon_para in tcallparanode(dest.right).callparaflags) then
  255. begin
  256. lenpara := tcallparanode(dest.right);
  257. { we can let the callnode do the type checking of these parameters too, }
  258. { but then the error messages aren't as nice }
  259. if not is_integer(lenpara.resultdef) then
  260. begin
  261. CGMessagePos1(lenpara.fileinfo,
  262. type_e_integer_expr_expected,lenpara.resultdef.typename);
  263. exit;
  264. end;
  265. if (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
  266. begin
  267. { parameters are in reverse order! }
  268. fracpara := lenpara;
  269. lenpara := tcallparanode(lenpara.right);
  270. if not is_real then
  271. begin
  272. CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
  273. exit
  274. end;
  275. if not is_integer(lenpara.resultdef) then
  276. begin
  277. CGMessagePos1(lenpara.fileinfo,
  278. type_e_integer_expr_expected,lenpara.resultdef.typename);
  279. exit;
  280. end;
  281. end;
  282. end;
  283. { generate the parameter list for the compilerproc }
  284. newparas := dest;
  285. { if we have a float parameter, insert the realtype, len and fracpara parameters }
  286. if is_real then
  287. begin
  288. { insert realtype parameter }
  289. if not is_currency(source.resultdef) then
  290. begin
  291. rt:=ord(tfloatdef(source.left.resultdef).floattype);
  292. newparas.right := ccallparanode.create(cordconstnode.create(
  293. rt,s32inttype,true),newparas.right);
  294. tmppara:=tcallparanode(newparas.right);
  295. end
  296. else
  297. tmppara:=newparas;
  298. { if necessary, insert a fraction parameter }
  299. if not assigned(fracpara) then
  300. begin
  301. tmppara.right := ccallparanode.create(
  302. cordconstnode.create(int64(-1),s32inttype,false),
  303. tmppara.right);
  304. fracpara := tcallparanode(tmppara.right);
  305. end;
  306. { if necessary, insert a length para }
  307. if not assigned(lenpara) then
  308. fracpara.right := ccallparanode.create(
  309. cordconstnode.create(int64(-32767),s32inttype,false),
  310. fracpara.right);
  311. end
  312. else if is_enum then
  313. begin
  314. {Insert a reference to the ord2string index.}
  315. newparas.right:=Ccallparanode.create(
  316. Caddrnode.create_internal(
  317. Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_normal)
  318. ),
  319. newparas.right);
  320. {Insert a reference to the typinfo.}
  321. newparas.right:=Ccallparanode.create(
  322. Caddrnode.create_internal(
  323. Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_ord2str)
  324. ),
  325. newparas.right);
  326. {Insert a type conversion from the enumeration to longint.}
  327. source.left:=Ctypeconvnode.create_internal(source.left,s32inttype);
  328. typecheckpass(source.left);
  329. { if necessary, insert a length para }
  330. if not assigned(lenpara) then
  331. Tcallparanode(Tcallparanode(newparas.right).right).right:=
  332. Ccallparanode.create(
  333. cordconstnode.create(int64(-1),s32inttype,false),
  334. Tcallparanode(Tcallparanode(newparas.right).right).right
  335. );
  336. end
  337. else
  338. { for a normal parameter, insert a only length parameter if one is missing }
  339. if not assigned(lenpara) then
  340. newparas.right := ccallparanode.create(cordconstnode.create(int64(-1),s32inttype,false),
  341. newparas.right);
  342. { remove the parameters from the original node so they won't get disposed, }
  343. { since they're reused }
  344. left := nil;
  345. { create procedure name }
  346. if is_chararray(dest.resultdef) then
  347. procname:='fpc_chararray_'
  348. else
  349. procname := 'fpc_' + tstringdef(dest.resultdef).stringtypname+'_';
  350. if is_real then
  351. if is_currency(source.resultdef) then
  352. procname := procname + 'currency'
  353. else
  354. procname := procname + 'float'
  355. else if is_enum then
  356. procname:=procname+'enum'
  357. else
  358. case torddef(source.resultdef).ordtype of
  359. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
  360. bool8bit,bool16bit,bool32bit,bool64bit:
  361. procname := procname + 'bool';
  362. else
  363. procname := procname + get_str_int_func(source.resultdef);
  364. end;
  365. { for ansistrings insert the encoding argument }
  366. if is_ansistring(dest.resultdef) then
  367. newparas:=ccallparanode.create(cordconstnode.create(
  368. getparaencoding(dest.resultdef),u16inttype,true),newparas);
  369. { free the errornode we generated in the beginning }
  370. result.free;
  371. { create the call node, }
  372. result := ccallnode.createintern(procname,newparas);
  373. end;
  374. function tinlinenode.handle_default: tnode;
  375. function getdefaultvarsym(def:tdef):tnode;
  376. var
  377. hashedid : thashedidstring;
  378. srsym : tsym;
  379. srsymtable : tsymtable;
  380. defaultname : tidstring;
  381. begin
  382. if not assigned(def) or
  383. not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
  384. ((def.typ=objectdef) and not is_object(def)) then
  385. internalerror(201202101);
  386. { extra '$' prefix because on darwin the result of makemangledname
  387. is prefixed by '_' and hence adding a '$' at the start of the
  388. prefix passed to makemangledname doesn't help (the whole point of
  389. the copy() operation below is to ensure that the id does not start
  390. with a '$', because that is interpreted specially by the symtable
  391. routines -- that's also why we prefix with '$_', so it will still
  392. work if make_mangledname() would somehow return a name that already
  393. starts with '$' }
  394. defaultname:='$_'+make_mangledname('zero',def.owner,def.typesym.Name);
  395. { can't hardcode the position of the '$', e.g. on darwin an underscore
  396. is added }
  397. hashedid.id:=copy(defaultname,2,255);
  398. { the default sym is always part of the current procedure/function }
  399. srsymtable:=current_procinfo.procdef.localst;
  400. srsym:=tsym(srsymtable.findwithhash(hashedid));
  401. if not assigned(srsym) then
  402. begin
  403. { no valid default variable found, so create it }
  404. srsym:=clocalvarsym.create(defaultname,vs_const,def,[]);
  405. srsymtable.insert(srsym);
  406. { mark the staticvarsym as typedconst }
  407. include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
  408. include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
  409. { The variable has a value assigned }
  410. tabstractvarsym(srsym).varstate:=vs_initialised;
  411. { the variable can't be placed in a register }
  412. tabstractvarsym(srsym).varregable:=vr_none;
  413. end;
  414. result:=cloadnode.create(srsym,srsymtable);
  415. end;
  416. var
  417. def : tdef;
  418. begin
  419. if not assigned(left) or (left.nodetype<>typen) then
  420. internalerror(2012032101);
  421. def:=ttypenode(left).typedef;
  422. result:=nil;
  423. case def.typ of
  424. enumdef,
  425. orddef:
  426. { don't do a rangecheck as Default will also return 0
  427. for the following types (Delphi compatible):
  428. TRange1 = -10..-5;
  429. TRange2 = 5..10;
  430. TEnum = (a:=5;b:=10); }
  431. result:=cordconstnode.create(0,def,false);
  432. classrefdef,
  433. pointerdef:
  434. result:=cpointerconstnode.create(0,def);
  435. procvardef:
  436. if tprocvardef(def).size<>sizeof(pint) then
  437. result:=getdefaultvarsym(def)
  438. else
  439. result:=cpointerconstnode.create(0,def);
  440. stringdef:
  441. result:=cstringconstnode.createstr('');
  442. floatdef:
  443. result:=crealconstnode.create(0,def);
  444. objectdef:
  445. begin
  446. if is_implicit_pointer_object_type(def) then
  447. result:=cpointerconstnode.create(0,def)
  448. else
  449. if is_object(def) then
  450. begin
  451. { Delphi does not recursively check whether
  452. an object contains unsupported types }
  453. if not (m_delphi in current_settings.modeswitches) and
  454. not is_valid_for_default(def) then
  455. Message(type_e_type_not_allowed_for_default);
  456. result:=getdefaultvarsym(def);
  457. end
  458. else
  459. Message(type_e_type_not_allowed_for_default);
  460. end;
  461. variantdef,
  462. recorddef:
  463. begin
  464. { Delphi does not recursively check whether a record
  465. contains unsupported types }
  466. if (def.typ=recorddef) and not (m_delphi in current_settings.modeswitches) and
  467. not is_valid_for_default(def) then
  468. Message(type_e_type_not_allowed_for_default);
  469. result:=getdefaultvarsym(def);
  470. end;
  471. setdef:
  472. begin
  473. result:=csetconstnode.create(nil,def);
  474. New(tsetconstnode(result).value_set);
  475. tsetconstnode(result).value_set^:=[];
  476. end;
  477. arraydef:
  478. begin
  479. { can other array types be parsed by single_type? }
  480. if ado_isdynamicarray in tarraydef(def).arrayoptions then
  481. result:=cpointerconstnode.create(0,def)
  482. else
  483. begin
  484. result:=getdefaultvarsym(def);
  485. end;
  486. end;
  487. undefineddef:
  488. begin
  489. if sp_generic_dummy in def.typesym.symoptions then
  490. begin
  491. { this matches the error messages that are printed
  492. in case of non-Delphi modes }
  493. Message(parser_e_no_generics_as_types);
  494. Message(type_e_type_id_expected);
  495. end
  496. else
  497. result:=cpointerconstnode.create(0,def);
  498. end;
  499. else
  500. Message(type_e_type_not_allowed_for_default);
  501. end;
  502. if not assigned(result) then
  503. result:=cerrornode.create;
  504. end;
  505. function tinlinenode.handle_reset_rewrite_typed: tnode;
  506. begin
  507. { since this is a "in_xxxx_typedfile" node, we can be sure we have }
  508. { a typed file as argument and we don't have to check it again (JM) }
  509. { add the recsize parameter }
  510. { iso mode extension with name? }
  511. if inlinenumber in [in_reset_typedfile_name,in_rewrite_typedfile_name] then
  512. begin
  513. left := ccallparanode.create(cordconstnode.create(
  514. tfiledef(tcallparanode(tcallparanode(left).nextpara).paravalue.resultdef).typedfiledef.size,s32inttype,true),left);
  515. end
  516. else
  517. begin
  518. { note: for some reason, the parameter of intern procedures with only one }
  519. { parameter is gets lifted out of its original tcallparanode (see round }
  520. { line 1306 of ncal.pas), so recreate a tcallparanode here (JM) }
  521. left := ccallparanode.create(cordconstnode.create(
  522. tfiledef(left.resultdef).typedfiledef.size,s32inttype,true),
  523. ccallparanode.create(left,nil));
  524. end;
  525. { create the correct call }
  526. if m_isolike_io in current_settings.modeswitches then
  527. begin
  528. case inlinenumber of
  529. in_reset_typedfile:
  530. result := ccallnode.createintern('fpc_reset_typed_iso',left);
  531. in_reset_typedfile_name:
  532. result := ccallnode.createintern('fpc_reset_typed_name_iso',left);
  533. in_rewrite_typedfile:
  534. result := ccallnode.createintern('fpc_rewrite_typed_iso',left);
  535. in_rewrite_typedfile_name:
  536. result := ccallnode.createintern('fpc_rewrite_typed_name_iso',left);
  537. else
  538. internalerror(2016101501);
  539. end;
  540. end
  541. else
  542. begin
  543. if inlinenumber=in_reset_typedfile then
  544. result := ccallnode.createintern('fpc_reset_typed',left)
  545. else
  546. result := ccallnode.createintern('fpc_rewrite_typed',left);
  547. end;
  548. { make sure left doesn't get disposed, since we use it in the new call }
  549. left := nil;
  550. end;
  551. procedure maybe_convert_to_string(var n: tnode);
  552. begin
  553. { stringconstnodes are arrays of char. It's much more }
  554. { efficient to write a constant string, so convert }
  555. { either to shortstring or ansistring depending on }
  556. { length }
  557. if (n.nodetype=stringconstn) then
  558. if is_chararray(n.resultdef) then
  559. if (tstringconstnode(n).len<=255) then
  560. inserttypeconv(n,cshortstringtype)
  561. else
  562. inserttypeconv(n,getansistringdef)
  563. else if is_widechararray(n.resultdef) then
  564. inserttypeconv(n,cunicodestringtype);
  565. end;
  566. procedure get_read_write_int_func(def: tdef; out func_suffix: string; out readfunctype: tdef);
  567. var
  568. ordtype: tordtype;
  569. begin
  570. ordtype := torddef(def).ordtype;
  571. if is_oversizedint(def) then
  572. begin
  573. case ordtype of
  574. s64bit:
  575. begin
  576. func_suffix := 'int64';
  577. readfunctype:=s64inttype;
  578. end;
  579. u64bit :
  580. begin
  581. func_suffix := 'qword';
  582. readfunctype:=u64inttype;
  583. end;
  584. s32bit:
  585. begin
  586. func_suffix := 'longint';
  587. readfunctype:=s32inttype;
  588. end;
  589. u32bit :
  590. begin
  591. func_suffix := 'longword';
  592. readfunctype:=u32inttype;
  593. end;
  594. s16bit:
  595. begin
  596. func_suffix := 'smallint';
  597. readfunctype:=s16inttype;
  598. end;
  599. u16bit :
  600. begin
  601. func_suffix := 'word';
  602. readfunctype:=u16inttype;
  603. end;
  604. else
  605. internalerror(2013032602);
  606. end;
  607. end
  608. else
  609. begin
  610. case ordtype of
  611. s64bit,
  612. s32bit,
  613. s16bit,
  614. s8bit:
  615. begin
  616. func_suffix := 'sint';
  617. readfunctype := sinttype;
  618. end;
  619. u64bit,
  620. u32bit,
  621. u16bit,
  622. u8bit:
  623. begin
  624. func_suffix := 'uint';
  625. readfunctype := uinttype;
  626. end;
  627. else
  628. internalerror(2013032601);
  629. end;
  630. end;
  631. end;
  632. function Tinlinenode.handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
  633. {Read(ln)/write(ln) for text files.}
  634. const procprefixes:array[boolean] of string[15]=('fpc_write_text_','fpc_read_text_');
  635. var error_para,is_real,special_handling,found_error,do_read:boolean;
  636. p1:Tnode;
  637. nextpara,
  638. indexpara,
  639. lenpara,
  640. para,
  641. fracpara:Tcallparanode;
  642. temp:Ttempcreatenode;
  643. readfunctype:Tdef;
  644. name:string[63];
  645. func_suffix:string[8];
  646. begin
  647. para:=Tcallparanode(params);
  648. found_error:=false;
  649. do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
  650. name:='';
  651. while assigned(para) do
  652. begin
  653. { is this parameter faulty? }
  654. error_para:=false;
  655. { is this parameter a real? }
  656. is_real:=false;
  657. { type used for the read(), this is used to check
  658. whether a temp is needed for range checking }
  659. readfunctype:=nil;
  660. { can't read/write types }
  661. if (para.left.nodetype=typen) and not(ttypenode(para.left).typedef.typ=undefineddef) then
  662. begin
  663. CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
  664. error_para := true;
  665. end;
  666. { support writeln(procvar) }
  667. if para.left.resultdef.typ=procvardef then
  668. begin
  669. p1:=ccallnode.create_procvar(nil,para.left);
  670. typecheckpass(p1);
  671. para.left:=p1;
  672. end;
  673. if inlinenumber in [in_write_x,in_writeln_x] then
  674. { prefer strings to chararrays }
  675. maybe_convert_to_string(para.left);
  676. case para.left.resultdef.typ of
  677. stringdef :
  678. name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname;
  679. pointerdef :
  680. begin
  681. if (not is_pchar(para.left.resultdef)) or do_read then
  682. begin
  683. CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
  684. error_para := true;
  685. end
  686. else
  687. name:=procprefixes[do_read]+'pchar_as_pointer';
  688. end;
  689. floatdef :
  690. begin
  691. is_real:=true;
  692. if Tfloatdef(para.left.resultdef).floattype=s64currency then
  693. name := procprefixes[do_read]+'currency'
  694. else
  695. begin
  696. name := procprefixes[do_read]+'float';
  697. readfunctype:=pbestrealtype^;
  698. end;
  699. { iso pascal needs a different handler }
  700. if (m_isolike_io in current_settings.modeswitches) and do_read then
  701. name:=name+'_iso';
  702. end;
  703. enumdef:
  704. begin
  705. name:=procprefixes[do_read]+'enum';
  706. readfunctype:=s32inttype;
  707. end;
  708. orddef :
  709. begin
  710. case Torddef(para.left.resultdef).ordtype of
  711. s8bit,
  712. s16bit,
  713. s32bit,
  714. s64bit,
  715. u8bit,
  716. u16bit,
  717. u32bit,
  718. u64bit:
  719. begin
  720. get_read_write_int_func(para.left.resultdef,func_suffix,readfunctype);
  721. name := procprefixes[do_read]+func_suffix;
  722. if (m_isolike_io in current_settings.modeswitches) and do_read then
  723. name:=name+'_iso';
  724. end;
  725. uchar :
  726. begin
  727. name := procprefixes[do_read]+'char';
  728. { iso pascal needs a different handler }
  729. if (m_isolike_io in current_settings.modeswitches) and do_read then
  730. name:=name+'_iso';
  731. readfunctype:=cansichartype;
  732. end;
  733. uwidechar :
  734. begin
  735. name := procprefixes[do_read]+'widechar';
  736. readfunctype:=cwidechartype;
  737. end;
  738. scurrency:
  739. begin
  740. name := procprefixes[do_read]+'currency';
  741. { iso pascal needs a different handler }
  742. if (m_isolike_io in current_settings.modeswitches) and do_read then
  743. name:=name+'_iso';
  744. readfunctype:=s64currencytype;
  745. is_real:=true;
  746. end;
  747. pasbool1,
  748. pasbool8,
  749. pasbool16,
  750. pasbool32,
  751. pasbool64,
  752. bool8bit,
  753. bool16bit,
  754. bool32bit,
  755. bool64bit:
  756. if do_read then
  757. begin
  758. CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
  759. error_para := true;
  760. end
  761. else
  762. begin
  763. name := procprefixes[do_read]+'boolean';
  764. readfunctype:=pasbool1type;
  765. end
  766. else
  767. begin
  768. CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
  769. error_para := true;
  770. end;
  771. end;
  772. end;
  773. variantdef :
  774. name:=procprefixes[do_read]+'variant';
  775. arraydef :
  776. begin
  777. if is_chararray(para.left.resultdef) then
  778. name := procprefixes[do_read]+'pchar_as_array'
  779. else
  780. begin
  781. CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
  782. error_para := true;
  783. end
  784. end;
  785. { generic parameter }
  786. undefineddef:
  787. { don't try to generate any code for a writeln on a generic parameter }
  788. error_para:=true;
  789. else
  790. begin
  791. CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
  792. error_para := true;
  793. end;
  794. end;
  795. { iso pascal needs a different handler }
  796. if (m_isolike_io in current_settings.modeswitches) and not(do_read) then
  797. name:=name+'_iso';
  798. { check for length/fractional colon para's }
  799. fracpara:=nil;
  800. lenpara:=nil;
  801. indexpara:=nil;
  802. if assigned(para.right) and
  803. (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
  804. begin
  805. lenpara := tcallparanode(para.right);
  806. if assigned(lenpara.right) and
  807. (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
  808. fracpara:=tcallparanode(lenpara.right);
  809. end;
  810. { get the next parameter now already, because we're going }
  811. { to muck around with the pointers }
  812. if assigned(fracpara) then
  813. nextpara := tcallparanode(fracpara.right)
  814. else if assigned(lenpara) then
  815. nextpara := tcallparanode(lenpara.right)
  816. else
  817. nextpara := tcallparanode(para.right);
  818. { check if a fracpara is allowed }
  819. if assigned(fracpara) and not is_real then
  820. begin
  821. CGMessagePos(fracpara.fileinfo,parser_e_illegal_colon_qualifier);
  822. error_para := true;
  823. end
  824. else if assigned(lenpara) and do_read then
  825. begin
  826. { I think this is already filtered out by parsing, but I'm not sure (JM) }
  827. CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
  828. error_para := true;
  829. end;
  830. { adjust found_error }
  831. found_error := found_error or error_para;
  832. if not error_para then
  833. begin
  834. special_handling:=false;
  835. { create dummy frac/len para's if necessary }
  836. if not do_read then
  837. begin
  838. { difference in default value for floats and the rest :( }
  839. if not is_real then
  840. begin
  841. if not assigned(lenpara) then
  842. begin
  843. if m_isolike_io in current_settings.modeswitches then
  844. lenpara := ccallparanode.create(
  845. cordconstnode.create(-1,s32inttype,false),nil)
  846. else
  847. lenpara := ccallparanode.create(
  848. cordconstnode.create(0,s32inttype,false),nil);
  849. end
  850. else
  851. { make sure we don't pass the successive }
  852. { parameters too. We also already have a }
  853. { reference to the next parameter in }
  854. { nextpara }
  855. lenpara.right := nil;
  856. end
  857. else
  858. begin
  859. if not assigned(lenpara) then
  860. lenpara := ccallparanode.create(
  861. cordconstnode.create(int64(-32767),s32inttype,false),nil);
  862. { also create a default fracpara if necessary }
  863. if not assigned(fracpara) then
  864. fracpara := ccallparanode.create(
  865. cordconstnode.create(int64(-1),s32inttype,false),nil);
  866. { add it to the lenpara }
  867. lenpara.right := fracpara;
  868. if not is_currency(para.left.resultdef) then
  869. begin
  870. { and add the realtype para (this also removes the link }
  871. { to any parameters coming after it) }
  872. fracpara.right := ccallparanode.create(
  873. cordconstnode.create(ord(tfloatdef(para.left.resultdef).floattype),
  874. s32inttype,true),nil);
  875. end
  876. else
  877. fracpara.right:=nil;
  878. end;
  879. if para.left.resultdef.typ=enumdef then
  880. begin
  881. {To write(ln) an enum we need a some extra parameters.}
  882. {Insert a reference to the ord2string index.}
  883. indexpara:=Ccallparanode.create(
  884. Caddrnode.create_internal(
  885. Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_normal)
  886. ),
  887. nil);
  888. {Insert a reference to the typinfo.}
  889. indexpara:=Ccallparanode.create(
  890. Caddrnode.create_internal(
  891. Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_ord2str)
  892. ),
  893. indexpara);
  894. {Insert a type conversion to to convert the enum to longint.}
  895. para.left:=Ctypeconvnode.create_internal(para.left,s32inttype);
  896. typecheckpass(para.left);
  897. end;
  898. end
  899. else
  900. begin
  901. {To read(ln) an enum we need a an extra parameter.}
  902. if para.left.resultdef.typ=enumdef then
  903. begin
  904. {Insert a reference to the string2ord index.}
  905. indexpara:=Ccallparanode.create(Caddrnode.create_internal(
  906. Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_str2ord)
  907. ),nil);
  908. {Insert a type conversion to to convert the enum to longint.}
  909. para.left:=Ctypeconvnode.create_internal(para.left,s32inttype);
  910. typecheckpass(para.left);
  911. end;
  912. { special handling of reading small numbers, because the helpers }
  913. { expect a longint/card/bestreal var parameter. Use a temp. can't }
  914. { use functions because then the call to FPC_IOCHECK destroys }
  915. { their result before we can store it }
  916. if (readfunctype<>nil) and (para.left.resultdef<>readfunctype) then
  917. special_handling:=true;
  918. end;
  919. if special_handling then
  920. begin
  921. { since we're not going to pass the parameter as var-parameter }
  922. { to the read function, manually check whether the parameter }
  923. { can be used as var-parameter (e.g., whether it isn't a }
  924. { property) }
  925. valid_for_var(para.left,true);
  926. { create the parameter list: the temp ... }
  927. temp := ctempcreatenode.create(readfunctype,readfunctype.size,tt_persistent,false);
  928. addstatement(Tstatementnode(newstatement),temp);
  929. { ... and the file }
  930. p1 := ccallparanode.create(ctemprefnode.create(temp),
  931. filepara.getcopy);
  932. Tcallparanode(Tcallparanode(p1).right).right:=indexpara;
  933. { create the call to the helper }
  934. addstatement(Tstatementnode(newstatement),
  935. ccallnode.createintern(name,tcallparanode(p1)));
  936. { assign the result to the original var (this automatically }
  937. { takes care of range checking) }
  938. addstatement(Tstatementnode(newstatement),
  939. cassignmentnode.create(para.left,
  940. ctemprefnode.create(temp)));
  941. { release the temp location }
  942. addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp));
  943. { statement of para is used }
  944. para.left := nil;
  945. { free the enclosing tcallparanode, but not the }
  946. { parameters coming after it }
  947. para.right := nil;
  948. para.free;
  949. end
  950. else
  951. { read of non s/u-8/16bit, or a write }
  952. begin
  953. { add the filepara to the current parameter }
  954. para.right := filepara.getcopy;
  955. {Add the lenpara and the indexpara(s) (fracpara and realtype are
  956. already linked with the lenpara if necessary).}
  957. if indexpara=nil then
  958. Tcallparanode(para.right).right:=lenpara
  959. else
  960. begin
  961. if lenpara=nil then
  962. Tcallparanode(para.right).right:=indexpara
  963. else
  964. begin
  965. Tcallparanode(para.right).right:=lenpara;
  966. lenpara.right:=indexpara;
  967. end;
  968. { indexpara.right:=lenpara;}
  969. end;
  970. { in case of writing a chararray, add whether it's zero-based }
  971. if para.left.resultdef.typ=arraydef then
  972. para := ccallparanode.create(cordconstnode.create(
  973. ord(tarraydef(para.left.resultdef).lowrange=0),pasbool1type,false),para)
  974. else
  975. { in case of reading an ansistring pass a codepage argument }
  976. if do_read and is_ansistring(para.left.resultdef) then
  977. para:=ccallparanode.create(cordconstnode.create(
  978. getparaencoding(para.left.resultdef),u16inttype,true),para);
  979. { create the call statement }
  980. addstatement(Tstatementnode(newstatement),
  981. ccallnode.createintern(name,para));
  982. end
  983. end
  984. else
  985. { error_para = true }
  986. begin
  987. { free the parameter, since it isn't referenced anywhere anymore }
  988. para.right := nil;
  989. para.free;
  990. if assigned(lenpara) then
  991. begin
  992. lenpara.right := nil;
  993. lenpara.free;
  994. end;
  995. if assigned(fracpara) then
  996. begin
  997. fracpara.right := nil;
  998. fracpara.free;
  999. end;
  1000. end;
  1001. { process next parameter }
  1002. para := nextpara;
  1003. end;
  1004. { if no error, add the write(ln)/read(ln) end calls }
  1005. if not found_error then
  1006. begin
  1007. case inlinenumber of
  1008. in_read_x,
  1009. in_readstr_x:
  1010. name:='fpc_read_end';
  1011. in_write_x,
  1012. in_writestr_x:
  1013. name:='fpc_write_end';
  1014. in_readln_x:
  1015. begin
  1016. name:='fpc_readln_end';
  1017. if m_isolike_io in current_settings.modeswitches then
  1018. name:=name+'_iso';
  1019. end;
  1020. in_writeln_x:
  1021. name:='fpc_writeln_end';
  1022. else
  1023. internalerror(2019050516);
  1024. end;
  1025. addstatement(Tstatementnode(newstatement),ccallnode.createintern(name,filepara.getcopy));
  1026. end;
  1027. handle_text_read_write:=found_error;
  1028. end;
  1029. function Tinlinenode.handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
  1030. {Read/write for typed files.}
  1031. const procprefixes:array[boolean,boolean] of string[19]=(('fpc_typed_write','fpc_typed_read'),
  1032. ('fpc_typed_write','fpc_typed_read_iso'));
  1033. procnamesdisplay:array[boolean,boolean] of string[8] = (('Write','Read'),('WriteStr','ReadStr'));
  1034. var found_error,do_read,is_rwstr:boolean;
  1035. para,nextpara:Tcallparanode;
  1036. p1:Tnode;
  1037. temp:Ttempcreatenode;
  1038. begin
  1039. found_error:=false;
  1040. para:=Tcallparanode(params);
  1041. do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
  1042. is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x];
  1043. temp:=nil;
  1044. { add the typesize to the filepara }
  1045. if filepara.resultdef.typ=filedef then
  1046. filepara.right := ccallparanode.create(cordconstnode.create(
  1047. tfiledef(filepara.resultdef).typedfiledef.size,s32inttype,true),nil);
  1048. { check for "no parameters" (you need at least one extra para for typed files) }
  1049. if not assigned(para) then
  1050. begin
  1051. CGMessage1(parser_e_wrong_parameter_size,procnamesdisplay[is_rwstr,do_read]);
  1052. found_error := true;
  1053. end;
  1054. { process all parameters }
  1055. while assigned(para) do
  1056. begin
  1057. { check if valid parameter }
  1058. if para.left.nodetype=typen then
  1059. begin
  1060. CGMessagePos(para.left.fileinfo,type_e_cant_read_write_type);
  1061. found_error := true;
  1062. end;
  1063. { support writeln(procvar) }
  1064. if (para.left.resultdef.typ=procvardef) then
  1065. begin
  1066. p1:=ccallnode.create_procvar(nil,para.left);
  1067. typecheckpass(p1);
  1068. para.left:=p1;
  1069. end;
  1070. if filepara.resultdef.typ=filedef then
  1071. inserttypeconv(para.left,tfiledef(filepara.resultdef).typedfiledef);
  1072. if assigned(para.right) and
  1073. (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
  1074. begin
  1075. CGMessagePos(para.right.fileinfo,parser_e_illegal_colon_qualifier);
  1076. { skip all colon para's }
  1077. nextpara := tcallparanode(tcallparanode(para.right).right);
  1078. while assigned(nextpara) and (cpf_is_colon_para in nextpara.callparaflags) do
  1079. nextpara := tcallparanode(nextpara.right);
  1080. found_error := true;
  1081. end
  1082. else
  1083. { get next parameter }
  1084. nextpara := tcallparanode(para.right);
  1085. { When we have a call, we have a problem: you can't pass the }
  1086. { result of a call as a formal const parameter. Solution: }
  1087. { assign the result to a temp and pass this temp as parameter }
  1088. { This is not very efficient, but write(typedfile,x) is }
  1089. { already slow by itself anyway (no buffering) (JM) }
  1090. { Actually, thge same goes for every non-simple expression }
  1091. { (such as an addition, ...) -> put everything but load nodes }
  1092. { into temps (JM) }
  1093. { of course, this must only be allowed for writes!!! (JM) }
  1094. if not(do_read) and (para.left.nodetype <> loadn) then
  1095. begin
  1096. { create temp for result }
  1097. temp := ctempcreatenode.create(para.left.resultdef,
  1098. para.left.resultdef.size,tt_persistent,false);
  1099. addstatement(Tstatementnode(newstatement),temp);
  1100. { assign result to temp }
  1101. addstatement(Tstatementnode(newstatement),
  1102. cassignmentnode.create(ctemprefnode.create(temp),
  1103. para.left));
  1104. { replace (reused) paranode with temp }
  1105. para.left := ctemprefnode.create(temp);
  1106. end;
  1107. { add fileparameter }
  1108. para.right := filepara.getcopy;
  1109. { create call statment }
  1110. { since the parameters are in the correct order, we have to insert }
  1111. { the statements always at the end of the current block }
  1112. addstatement(Tstatementnode(newstatement),
  1113. Ccallnode.createintern(procprefixes[m_isolike_io in current_settings.modeswitches,do_read],para
  1114. ));
  1115. { if we used a temp, free it }
  1116. if para.left.nodetype = temprefn then
  1117. addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp));
  1118. { process next parameter }
  1119. para := nextpara;
  1120. end;
  1121. handle_typed_read_write:=found_error;
  1122. end;
  1123. function tinlinenode.handle_read_write: tnode;
  1124. var
  1125. filepara,
  1126. nextpara,
  1127. params : tcallparanode;
  1128. newstatement : tstatementnode;
  1129. newblock : tblocknode;
  1130. filetemp : Ttempcreatenode;
  1131. name : string[31];
  1132. textsym : ttypesym;
  1133. is_typed,
  1134. do_read,
  1135. is_rwstr,
  1136. found_error : boolean;
  1137. begin
  1138. filepara := nil;
  1139. is_typed := false;
  1140. filetemp := nil;
  1141. do_read := inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
  1142. is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x];
  1143. { if we fail, we can quickly exit this way. We must generate something }
  1144. { instead of the inline node, because firstpass will bomb with an }
  1145. { internalerror if it encounters a read/write }
  1146. result := cerrornode.create;
  1147. { reverse the parameters (needed to get the colon parameters in the }
  1148. { correct order when processing write(ln) }
  1149. reverseparameters(tcallparanode(left));
  1150. if is_rwstr then
  1151. begin
  1152. filepara := tcallparanode(left);
  1153. { needs at least two parameters: source/dest string + min. 1 value }
  1154. if not(assigned(filepara)) or
  1155. not(assigned(filepara.right)) then
  1156. begin
  1157. CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'ReadStr/WriteStr');
  1158. exit;
  1159. end
  1160. else if (filepara.resultdef.typ <> stringdef) then
  1161. begin
  1162. { convert chararray to string, or give an appropriate error message }
  1163. { (if you want to optimize to use shortstring, keep in mind that }
  1164. { readstr internally always uses ansistring, and to account for }
  1165. { chararrays with > 255 characters) }
  1166. inserttypeconv(filepara.left,getansistringdef);
  1167. filepara.resultdef:=filepara.left.resultdef;
  1168. if codegenerror then
  1169. exit;
  1170. end
  1171. end
  1172. else if assigned(left) then
  1173. begin
  1174. { check if we have a file parameter and if yes, what kind it is }
  1175. filepara := tcallparanode(left);
  1176. if (filepara.resultdef.typ=filedef) then
  1177. begin
  1178. if (tfiledef(filepara.resultdef).filetyp=ft_untyped) then
  1179. begin
  1180. CGMessagePos(fileinfo,type_e_no_read_write_for_untyped_file);
  1181. exit;
  1182. end
  1183. else
  1184. begin
  1185. if (tfiledef(filepara.resultdef).filetyp=ft_typed) then
  1186. begin
  1187. if (inlinenumber in [in_readln_x,in_writeln_x]) then
  1188. begin
  1189. CGMessagePos(fileinfo,type_e_no_readln_writeln_for_typed_file);
  1190. exit;
  1191. end;
  1192. is_typed := true;
  1193. end
  1194. end;
  1195. end
  1196. else
  1197. filepara := nil;
  1198. end;
  1199. { create a blocknode in which the successive write/read statements will be }
  1200. { put, since they belong together. Also create a dummy statement already to }
  1201. { make inserting of additional statements easier }
  1202. newblock:=internalstatements(newstatement);
  1203. if is_rwstr then
  1204. begin
  1205. { create a dummy temp text file that will be used to cache the
  1206. readstr/writestr state. Can't use a global variable in the system
  1207. unit because these can be nested (in case of parameters to
  1208. writestr that are function calls to functions that also call
  1209. readstr/writestr) }
  1210. textsym:=search_system_type('TEXT');
  1211. filetemp:=ctempcreatenode.create(textsym.typedef,textsym.typedef.size,tt_persistent,false);
  1212. addstatement(newstatement,filetemp);
  1213. if (do_read) then
  1214. name:='fpc_setupreadstr_'
  1215. else
  1216. name:='fpc_setupwritestr_';
  1217. name:=name+tstringdef(filepara.resultdef).stringtypname;
  1218. { the file para is a var parameter, but it is properly initialized,
  1219. so it should be actually an out parameter }
  1220. if not(do_read) then
  1221. set_varstate(filepara.left,vs_written,[]);
  1222. { remove the source/destination string parameter from the }
  1223. { parameter chain }
  1224. left:=filepara.right;
  1225. filepara.right:=ccallparanode.create(ctemprefnode.create(filetemp),nil);
  1226. { in case of a writestr() to an ansistring, also pass the string's
  1227. code page }
  1228. if not do_read and
  1229. is_ansistring(filepara.left.resultdef) then
  1230. filepara:=ccallparanode.create(genintconstnode(tstringdef(filepara.left.resultdef).encoding),filepara);
  1231. { pass the temp text file and the source/destination string to the
  1232. setup routine, which will store the string's address in the
  1233. textrec }
  1234. addstatement(newstatement,ccallnode.createintern(name,filepara));
  1235. filepara:=ccallparanode.create(ctemprefnode.create(filetemp),nil);
  1236. end
  1237. { if we don't have a filepara, create one containing the default }
  1238. else if not assigned(filepara) then
  1239. begin
  1240. { since the input/output variables are threadvars loading them into
  1241. a temp once is faster. Create a temp which will hold a pointer to the file }
  1242. filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
  1243. addstatement(newstatement,filetemp);
  1244. { make sure the resultdef of the temp (and as such of the }
  1245. { temprefs coming after it) is set (necessary because the }
  1246. { temprefs will be part of the filepara, of which we need }
  1247. { the resultdef later on and temprefs can only be }
  1248. { typecheckpassed if the resultdef of the temp is known) }
  1249. typecheckpass(tnode(filetemp));
  1250. { assign the address of the file to the temp }
  1251. if do_read then
  1252. name := 'input'
  1253. else
  1254. name := 'output';
  1255. addstatement(newstatement,
  1256. cassignmentnode.create(ctemprefnode.create(filetemp),
  1257. ccallnode.createintern('fpc_get_'+name,nil)));
  1258. { create a new fileparameter as follows: file_type(temp^) }
  1259. { (so that we pass the value and not the address of the temp }
  1260. { to the read/write routine) }
  1261. textsym:=search_system_type('TEXT');
  1262. filepara := ccallparanode.create(ctypeconvnode.create_internal(
  1263. cderefnode.create(ctemprefnode.create(filetemp)),textsym.typedef),nil);
  1264. end
  1265. else
  1266. { remove filepara from the parameter chain }
  1267. begin
  1268. left := filepara.right;
  1269. filepara.right := nil;
  1270. { the file para is a var parameter, but it must be valid already }
  1271. set_varstate(filepara.left,vs_readwritten,[vsf_must_be_valid]);
  1272. { check if we should make a temp to store the result of a complex }
  1273. { expression (better heuristics, anyone?) (JM) }
  1274. if (filepara.left.nodetype <> loadn) then
  1275. begin
  1276. { create a temp which will hold a pointer to the file }
  1277. filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
  1278. { add it to the statements }
  1279. addstatement(newstatement,filetemp);
  1280. { make sure the resultdef of the temp (and as such of the }
  1281. { temprefs coming after it) is set (necessary because the }
  1282. { temprefs will be part of the filepara, of which we need }
  1283. { the resultdef later on and temprefs can only be }
  1284. { typecheckpassed if the resultdef of the temp is known) }
  1285. typecheckpass(tnode(filetemp));
  1286. { assign the address of the file to the temp }
  1287. addstatement(newstatement,
  1288. cassignmentnode.create(ctemprefnode.create(filetemp),
  1289. caddrnode.create_internal(filepara.left)));
  1290. typecheckpass(newstatement.left);
  1291. { create a new fileparameter as follows: file_type(temp^) }
  1292. { (so that we pass the value and not the address of the temp }
  1293. { to the read/write routine) }
  1294. nextpara := ccallparanode.create(ctypeconvnode.create_internal(
  1295. cderefnode.create(ctemprefnode.create(filetemp)),filepara.left.resultdef),nil);
  1296. { replace the old file para with the new one }
  1297. filepara.left := nil;
  1298. filepara.free;
  1299. filepara := nextpara;
  1300. end;
  1301. end;
  1302. { the resultdef of the filepara must be set since it's }
  1303. { used below }
  1304. filepara.get_paratype;
  1305. { now, filepara is nowhere referenced anymore, so we can safely dispose it }
  1306. { if something goes wrong or at the end of the procedure }
  1307. { we're going to reuse the paranodes, so make sure they don't get freed }
  1308. { twice }
  1309. params:=Tcallparanode(left);
  1310. left := nil;
  1311. if is_typed then
  1312. found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),tnode(newstatement))
  1313. else
  1314. found_error:=handle_text_read_write(filepara,Ttertiarynode(params),tnode(newstatement));
  1315. { free the file parameter (it's copied inside the handle_*_read_write methods) }
  1316. filepara.free;
  1317. { if we found an error, simply delete the generated blocknode }
  1318. if found_error then
  1319. begin
  1320. { ensure that the tempinfo is freed correctly by destroying a
  1321. delete node for it
  1322. Note: this might happen legitimately whe parsing a generic that
  1323. passes a undefined type to Write/Read }
  1324. if assigned(filetemp) then
  1325. ctempdeletenode.create(filetemp).free;
  1326. newblock.free
  1327. end
  1328. else
  1329. begin
  1330. { deallocate the temp for the file para if we used one }
  1331. if assigned(filetemp) then
  1332. addstatement(newstatement,ctempdeletenode.create(filetemp));
  1333. { otherwise return the newly generated block of instructions, }
  1334. { but first free the errornode we generated at the beginning }
  1335. result.free;
  1336. result := newblock
  1337. end;
  1338. end;
  1339. function get_val_int_func(def: tdef): string;
  1340. var
  1341. ordtype: tordtype;
  1342. begin
  1343. ordtype := torddef(def).ordtype;
  1344. if not (ordtype in [s64bit,u64bit,s32bit,u32bit,s16bit,u16bit,s8bit,u8bit]) then
  1345. internalerror(2013032603);
  1346. if is_oversizedint(def) then
  1347. begin
  1348. case ordtype of
  1349. s64bit: exit('int64');
  1350. u64bit: exit('qword');
  1351. s32bit: exit('longint');
  1352. u32bit: exit('longword');
  1353. s16bit: exit('smallint');
  1354. u16bit: exit('word');
  1355. else
  1356. internalerror(2013032604);
  1357. end;
  1358. end
  1359. else
  1360. begin
  1361. case ordtype of
  1362. s64bit,s32bit,s16bit,s8bit: exit('sint');
  1363. u64bit,u32bit,u16bit,u8bit: exit('uint');
  1364. else
  1365. internalerror(2013032604);
  1366. end;
  1367. end;
  1368. internalerror(2013032605);
  1369. end;
  1370. function tinlinenode.handle_val: tnode;
  1371. var
  1372. procname,
  1373. suffix : string[31];
  1374. sourcepara,
  1375. destpara,
  1376. codepara,
  1377. sizepara,
  1378. newparas : tcallparanode;
  1379. orgcode,tc : tnode;
  1380. newstatement : tstatementnode;
  1381. newblock : tblocknode;
  1382. tempcode : ttempcreatenode;
  1383. valsinttype : tdef;
  1384. begin
  1385. { for easy exiting if something goes wrong }
  1386. result := cerrornode.create;
  1387. { check the amount of parameters }
  1388. if not(assigned(left)) or
  1389. not(assigned(tcallparanode(left).right)) then
  1390. begin
  1391. CGMessage1(parser_e_wrong_parameter_size,'Val');
  1392. exit;
  1393. end;
  1394. suffix:='';
  1395. { in case we are in a generic definition, we cannot
  1396. do all checks, the parameters might be type parameters }
  1397. if df_generic in current_procinfo.procdef.defoptions then
  1398. begin
  1399. result.Free;
  1400. result:=nil;
  1401. resultdef:=voidtype;
  1402. exit;
  1403. end;
  1404. { retrieve the ValSInt type }
  1405. valsinttype:=search_system_type('VALSINT').typedef;
  1406. { reverse parameters for easier processing }
  1407. reverseparameters(tcallparanode(left));
  1408. { get the parameters }
  1409. tempcode := nil;
  1410. orgcode := nil;
  1411. sizepara := nil;
  1412. sourcepara := tcallparanode(left);
  1413. destpara := tcallparanode(sourcepara.right);
  1414. codepara := tcallparanode(destpara.right);
  1415. { check if codepara is valid }
  1416. if assigned(codepara) and
  1417. (
  1418. not is_integer(codepara.resultdef)
  1419. {$ifndef cpu64bitaddr}
  1420. or is_64bitint(codepara.resultdef)
  1421. {$endif not cpu64bitaddr}
  1422. ) then
  1423. begin
  1424. CGMessagePos1(codepara.fileinfo,type_e_integer_expr_expected,codepara.resultdef.typename);
  1425. exit;
  1426. end;
  1427. { check if dest para is valid }
  1428. if not is_integer(destpara.resultdef) and
  1429. not is_currency(destpara.resultdef) and
  1430. not(destpara.resultdef.typ in [floatdef,enumdef]) then
  1431. begin
  1432. CGMessagePos(destpara.fileinfo,type_e_integer_or_real_expr_expected);
  1433. exit;
  1434. end;
  1435. { we're going to reuse the exisiting para's, so make sure they }
  1436. { won't be disposed }
  1437. left := nil;
  1438. { create the blocknode which will hold the generated statements + }
  1439. { an initial dummy statement }
  1440. newblock:=internalstatements(newstatement);
  1441. { do we need a temp for code? Yes, if no code specified, or if }
  1442. { code is not a valsinttype sized parameter (we already checked }
  1443. { whether the code para, if specified, was an orddef) }
  1444. if not assigned(codepara) or
  1445. (codepara.resultdef.size<>valsinttype.size) then
  1446. begin
  1447. tempcode := ctempcreatenode.create(valsinttype,valsinttype.size,tt_persistent,false);
  1448. addstatement(newstatement,tempcode);
  1449. { set the resultdef of the temp (needed to be able to get }
  1450. { the resultdef of the tempref used in the new code para) }
  1451. typecheckpass(tnode(tempcode));
  1452. { create a temp codepara, but save the original code para to }
  1453. { assign the result to later on }
  1454. if assigned(codepara) then
  1455. begin
  1456. orgcode := codepara.left;
  1457. codepara.left := ctemprefnode.create(tempcode);
  1458. end
  1459. else
  1460. codepara := ccallparanode.create(ctemprefnode.create(tempcode),nil);
  1461. { we need its resultdef later on }
  1462. codepara.get_paratype;
  1463. end
  1464. else if (torddef(codepara.resultdef).ordtype <> torddef(valsinttype).ordtype) then
  1465. { because code is a var parameter, it must match types exactly }
  1466. { however, since it will return values >= 0, both signed and }
  1467. { and unsigned ints of the same size are fine. Since the formal }
  1468. { code para type is sinttype, insert a typecoversion to sint for }
  1469. { unsigned para's }
  1470. begin
  1471. codepara.left := ctypeconvnode.create_internal(codepara.left,valsinttype);
  1472. { make it explicit, oterwise you may get a nonsense range }
  1473. { check error if the cardinal already contained a value }
  1474. { > $7fffffff }
  1475. codepara.get_paratype;
  1476. end;
  1477. { create the procedure name }
  1478. procname := 'fpc_val_';
  1479. case destpara.resultdef.typ of
  1480. orddef:
  1481. begin
  1482. case torddef(destpara.resultdef).ordtype of
  1483. s8bit,s16bit,s32bit,s64bit,
  1484. u8bit,u16bit,u32bit,u64bit:
  1485. begin
  1486. suffix := get_val_int_func(destpara.resultdef) + '_';
  1487. { we also need a destsize para in the case of sint }
  1488. if suffix = 'sint_' then
  1489. sizepara := ccallparanode.create(cordconstnode.create
  1490. (destpara.resultdef.size,s32inttype,true),nil);
  1491. end;
  1492. scurrency: suffix := 'currency_';
  1493. else
  1494. internalerror(200304225);
  1495. end;
  1496. end;
  1497. floatdef:
  1498. suffix:='real_';
  1499. enumdef:
  1500. begin
  1501. suffix:='enum_';
  1502. sizepara:=Ccallparanode.create(Caddrnode.create_internal(
  1503. Crttinode.create(Tenumdef(destpara.resultdef),fullrtti,rdt_str2ord)
  1504. ),nil);
  1505. end;
  1506. else
  1507. internalerror(2019050515);
  1508. end;
  1509. procname := procname + suffix;
  1510. { play a trick to have tcallnode handle invalid source parameters: }
  1511. { the shortstring-longint val routine by default }
  1512. if (sourcepara.resultdef.typ = stringdef) then
  1513. procname := procname + tstringdef(sourcepara.resultdef).stringtypname
  1514. { zero-based arrays (of char) can be implicitely converted to ansistring, but don't do
  1515. so if not needed because the array is too short }
  1516. else if is_zero_based_array(sourcepara.resultdef) and (sourcepara.resultdef.size>255) then
  1517. procname := procname + 'ansistr'
  1518. else
  1519. procname := procname + 'shortstr';
  1520. { set up the correct parameters for the call: the code para... }
  1521. newparas := codepara;
  1522. { and the source para }
  1523. codepara.right := sourcepara;
  1524. { sizepara either contains nil if none is needed (which is ok, since }
  1525. { then the next statement severes any possible links with other paras }
  1526. { that sourcepara may have) or it contains the necessary size para and }
  1527. { its right field is nil }
  1528. sourcepara.right := sizepara;
  1529. { create the call and assign the result to dest (val helpers are functions).
  1530. Use a trick to prevent a type size mismatch warning to be generated by the
  1531. assignment node. First convert implicitly to the resultdef. This will insert
  1532. the range check. The Second conversion is done explicitly to hide the implicit conversion
  1533. for the assignment node and therefor preventing the warning (PFV)
  1534. The implicit conversion is avoided for enums because implicit conversion between
  1535. longint (which is what fpc_val_enum_shortstr returns) and enumerations is not
  1536. possible. (DM).
  1537. The implicit conversion is also avoided for COMP type if it is handled by FPU (x86)
  1538. to prevent warning about automatic type conversion. }
  1539. if (destpara.resultdef.typ=enumdef) or
  1540. ((destpara.resultdef.typ=floatdef) and (tfloatdef(destpara.resultdef).floattype=s64comp))
  1541. then
  1542. tc:=ccallnode.createintern(procname,newparas)
  1543. else
  1544. tc:=ctypeconvnode.create(ccallnode.createintern(procname,newparas),destpara.left.resultdef);
  1545. addstatement(newstatement,cassignmentnode.create(
  1546. destpara.left,ctypeconvnode.create_internal(tc,destpara.left.resultdef)));
  1547. { dispose of the enclosing paranode of the destination }
  1548. destpara.left := nil;
  1549. destpara.right := nil;
  1550. destpara.free;
  1551. { check if we used a temp for code and whether we have to store }
  1552. { it to the real code parameter }
  1553. if assigned(orgcode) then
  1554. addstatement(newstatement,cassignmentnode.create(
  1555. orgcode,
  1556. ctypeconvnode.create_internal(
  1557. ctemprefnode.create(tempcode),orgcode.resultdef)));
  1558. { release the temp if we allocated one }
  1559. if assigned(tempcode) then
  1560. addstatement(newstatement,ctempdeletenode.create(tempcode));
  1561. { free the errornode }
  1562. result.free;
  1563. { and return it }
  1564. result := newblock;
  1565. end;
  1566. function tinlinenode.handle_setlength: tnode;
  1567. var
  1568. def: tdef;
  1569. destppn,
  1570. paras: tnode;
  1571. newstatement: tstatementnode;
  1572. ppn: tcallparanode;
  1573. counter,
  1574. dims: longint;
  1575. isarray: boolean;
  1576. begin
  1577. { for easy exiting if something goes wrong }
  1578. result:=cerrornode.create;
  1579. resultdef:=voidtype;
  1580. paras:=left;
  1581. dims:=0;
  1582. if assigned(paras) then
  1583. begin
  1584. { check type of lengths }
  1585. ppn:=tcallparanode(paras);
  1586. while assigned(ppn.right) do
  1587. begin
  1588. set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
  1589. inserttypeconv(ppn.left,sinttype);
  1590. inc(dims);
  1591. ppn:=tcallparanode(ppn.right);
  1592. end;
  1593. end
  1594. else
  1595. internalerror(2013112912);
  1596. if dims=0 then
  1597. begin
  1598. CGMessage1(parser_e_wrong_parameter_size,'SetLength');
  1599. exit;
  1600. end;
  1601. { last param must be var }
  1602. destppn:=ppn.left;
  1603. valid_for_var(destppn,true);
  1604. set_varstate(destppn,vs_written,[vsf_must_be_valid,vsf_use_hints,vsf_use_hint_for_string_result]);
  1605. { first param must be a string or dynamic array ...}
  1606. isarray:=is_dynamic_array(destppn.resultdef);
  1607. if not((destppn.resultdef.typ=stringdef) or
  1608. isarray) then
  1609. begin
  1610. { possibly generic involved? }
  1611. if df_generic in current_procinfo.procdef.defoptions then
  1612. result:=internalstatements(newstatement)
  1613. else
  1614. CGMessage(type_e_mismatch);
  1615. exit;
  1616. end;
  1617. { only dynamic arrays accept more dimensions }
  1618. if (dims>1) then
  1619. begin
  1620. if (not isarray) then
  1621. CGMessage(type_e_mismatch)
  1622. else
  1623. begin
  1624. { check if the amount of dimensions is valid }
  1625. def:=tarraydef(destppn.resultdef).elementdef;
  1626. counter:=dims;
  1627. while counter > 1 do
  1628. begin
  1629. if not(is_dynamic_array(def)) then
  1630. begin
  1631. CGMessage1(parser_e_wrong_parameter_size,'SetLength');
  1632. break;
  1633. end;
  1634. dec(counter);
  1635. def:=tarraydef(def).elementdef;
  1636. end;
  1637. end;
  1638. end;
  1639. result.free;
  1640. result:=nil;
  1641. end;
  1642. function tinlinenode.handle_copy: tnode;
  1643. procedure do_error(typemismatch:boolean;func:string;fi:tfileposinfo);
  1644. procedure write_dynarray_copy;
  1645. begin
  1646. MessagePos1(fileinfo,sym_e_param_list,'Copy(Dynamic Array;'+sizesinttype.typename+'=`<low>`;'+sizesinttype.typename+'=`<length>`);');
  1647. end;
  1648. begin
  1649. if typemismatch then
  1650. CGMessagePos(fi,type_e_mismatch)
  1651. else
  1652. CGMessagePos1(fi,parser_e_wrong_parameter_size,'Copy');
  1653. if func='' then
  1654. begin
  1655. write_system_parameter_lists('fpc_shortstr_copy');
  1656. write_system_parameter_lists('fpc_char_copy');
  1657. write_system_parameter_lists('fpc_unicodestr_copy');
  1658. if tf_winlikewidestring in target_info.flags then
  1659. write_system_parameter_lists('fpc_widestr_copy');
  1660. write_system_parameter_lists('fpc_ansistr_copy');
  1661. write_dynarray_copy;
  1662. end
  1663. else if func='fpc_dynarray_copy' then
  1664. write_dynarray_copy
  1665. else
  1666. write_system_parameter_lists(func);
  1667. end;
  1668. var
  1669. paras : tnode;
  1670. ppn : tcallparanode;
  1671. paradef : tdef;
  1672. counter : integer;
  1673. minargs,
  1674. maxargs : longint;
  1675. func : string;
  1676. begin
  1677. if not assigned(left) then
  1678. begin
  1679. do_error(false,'',fileinfo);
  1680. exit(cerrornode.create);
  1681. end;
  1682. result:=nil;
  1683. { determine copy function to use based on the first argument,
  1684. also count the number of arguments in this loop }
  1685. counter:=1;
  1686. paras:=left;
  1687. ppn:=tcallparanode(paras);
  1688. while assigned(ppn.right) do
  1689. begin
  1690. inc(counter);
  1691. set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
  1692. ppn:=tcallparanode(ppn.right);
  1693. end;
  1694. set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
  1695. paradef:=ppn.left.resultdef;
  1696. { the string variants all require 2 or 3 args, only the array one allows less }
  1697. minargs:=2;
  1698. maxargs:=3;
  1699. func:='';
  1700. if is_ansistring(paradef) then
  1701. begin
  1702. // set resultdef to argument def
  1703. resultdef:=paradef;
  1704. func:='fpc_ansistr_copy';
  1705. end
  1706. else if (is_chararray(paradef) and (paradef.size>255)) or
  1707. ((cs_refcountedstrings in current_settings.localswitches) and is_pchar(paradef)) then
  1708. begin
  1709. // set resultdef to ansistring type since result will be in ansistring codepage
  1710. resultdef:=getansistringdef;
  1711. func:='fpc_ansistr_copy';
  1712. end
  1713. else if is_widestring(paradef) then
  1714. begin
  1715. resultdef:=cwidestringtype;
  1716. func:='fpc_widestr_copy';
  1717. end
  1718. else if is_unicodestring(paradef) or
  1719. is_widechararray(paradef) or
  1720. is_pwidechar(paradef) then
  1721. begin
  1722. resultdef:=cunicodestringtype;
  1723. func:='fpc_unicodestr_copy';
  1724. end
  1725. else
  1726. if is_char(paradef) then
  1727. begin
  1728. resultdef:=cshortstringtype;
  1729. func:='fpc_char_copy';
  1730. end
  1731. else
  1732. if is_dynamic_array(paradef) then
  1733. begin
  1734. minargs:=1;
  1735. resultdef:=paradef;
  1736. func:='fpc_dynarray_copy';
  1737. end
  1738. else if counter in [2..3] then
  1739. begin
  1740. resultdef:=cshortstringtype;
  1741. func:='fpc_shortstr_copy';
  1742. end
  1743. else if counter<=maxargs then
  1744. begin
  1745. do_error(true,'',ppn.left.fileinfo);
  1746. exit(cerrornode.create);
  1747. end;
  1748. if (counter<minargs) or (counter>maxargs) then
  1749. begin
  1750. do_error(false,func,fileinfo);
  1751. exit(cerrornode.create);
  1752. end;
  1753. end;
  1754. {$maxfpuregisters 0}
  1755. function getpi : bestreal;
  1756. begin
  1757. {$ifdef x86}
  1758. { x86 has pi in hardware }
  1759. result:=pi;
  1760. {$else x86}
  1761. {$ifdef cpuextended}
  1762. result:=MathPiExtended.Value;
  1763. {$else cpuextended}
  1764. result:=MathPi.Value;
  1765. {$endif cpuextended}
  1766. {$endif x86}
  1767. end;
  1768. function tinlinenode.simplify(forinline : boolean): tnode;
  1769. function do_lowhigh(def:tdef) : tnode;
  1770. var
  1771. v : tconstexprint;
  1772. enum : tenumsym;
  1773. hp : tnode;
  1774. i : integer;
  1775. begin
  1776. case def.typ of
  1777. orddef:
  1778. begin
  1779. set_varstate(left,vs_read,[]);
  1780. if inlinenumber=in_low_x then
  1781. v:=torddef(def).low
  1782. else
  1783. v:=torddef(def).high;
  1784. hp:=cordconstnode.create(v,def,true);
  1785. typecheckpass(hp);
  1786. do_lowhigh:=hp;
  1787. end;
  1788. enumdef:
  1789. begin
  1790. set_varstate(left,vs_read,[]);
  1791. if inlinenumber=in_high_x then
  1792. v:=tenumdef(def).maxval
  1793. else
  1794. v:=tenumdef(def).minval;
  1795. enum:=nil;
  1796. for i := 0 to tenumdef(def).symtable.SymList.Count - 1 do
  1797. if tenumsym(tenumdef(def).symtable.SymList[i]).value=v then
  1798. begin
  1799. enum:=tenumsym(tenumdef(def).symtable.SymList[i]);
  1800. break;
  1801. end;
  1802. if not assigned(enum) then
  1803. internalerror(309993)
  1804. else
  1805. hp:=genenumnode(enum);
  1806. do_lowhigh:=hp;
  1807. end;
  1808. else
  1809. internalerror(87);
  1810. end;
  1811. end;
  1812. function getconstrealvalue : bestreal;
  1813. begin
  1814. case left.nodetype of
  1815. ordconstn:
  1816. getconstrealvalue:=tordconstnode(left).value;
  1817. realconstn:
  1818. getconstrealvalue:=trealconstnode(left).value_real;
  1819. else
  1820. internalerror(309992);
  1821. end;
  1822. end;
  1823. procedure setconstrealvalue(r : bestreal);
  1824. begin
  1825. result:=crealconstnode.create(r,pbestrealtype^);
  1826. end;
  1827. function handle_ln_const(r : bestreal) : tnode;
  1828. begin
  1829. if r<=0.0 then
  1830. if floating_point_range_check_error then
  1831. begin
  1832. result:=crealconstnode.create(0,pbestrealtype^);
  1833. CGMessage(type_e_wrong_math_argument)
  1834. end
  1835. else
  1836. begin
  1837. if r=0.0 then
  1838. result:=crealconstnode.create(MathNegInf.Value,pbestrealtype^)
  1839. else
  1840. result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^)
  1841. end
  1842. else
  1843. result:=crealconstnode.create(ln(r),pbestrealtype^)
  1844. end;
  1845. function handle_sqrt_const(r : bestreal) : tnode;
  1846. begin
  1847. if r<0.0 then
  1848. if floating_point_range_check_error then
  1849. begin
  1850. result:=crealconstnode.create(0,pbestrealtype^);
  1851. CGMessage(type_e_wrong_math_argument)
  1852. end
  1853. else
  1854. result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^)
  1855. else
  1856. result:=crealconstnode.create(sqrt(r),pbestrealtype^)
  1857. end;
  1858. function handle_const_sar : tnode;
  1859. var
  1860. vl,vl2 : TConstExprInt;
  1861. bits,shift: integer;
  1862. mask : qword;
  1863. def : tdef;
  1864. begin
  1865. result:=nil;
  1866. if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then
  1867. begin
  1868. if (left.nodetype=callparan) and
  1869. assigned(tcallparanode(left).right) then
  1870. begin
  1871. vl:=tordconstnode(tcallparanode(left).left).value;
  1872. if forinline then
  1873. case resultdef.size of
  1874. 1,2,4:
  1875. vl:=vl and byte($1f);
  1876. 8:
  1877. vl:=vl and byte($3f);
  1878. else
  1879. internalerror(2013122302);
  1880. end;
  1881. if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
  1882. begin
  1883. def:=tcallparanode(tcallparanode(left).right).left.resultdef;
  1884. vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
  1885. end
  1886. else if vl=0 then
  1887. begin
  1888. result:=tcallparanode(tcallparanode(left).right).left;
  1889. tcallparanode(tcallparanode(left).right).left:=nil;
  1890. exit;
  1891. end
  1892. else
  1893. exit;
  1894. end
  1895. else
  1896. begin
  1897. def:=left.resultdef;
  1898. vl:=1;
  1899. vl2:=tordconstnode(left).value;
  1900. end;
  1901. bits:=def.size*8;
  1902. shift:=vl.svalue and (bits-1);
  1903. case bits of
  1904. 8:
  1905. mask:=$ff;
  1906. 16:
  1907. mask:=$ffff;
  1908. 32:
  1909. mask:=$ffffffff;
  1910. 64:
  1911. mask:=qword($ffffffffffffffff);
  1912. else
  1913. mask:=qword(1 shl bits)-1;
  1914. end;
  1915. {$push}
  1916. {$r-,q-}
  1917. if shift=0 then
  1918. result:=cordconstnode.create(vl2.svalue,def,false)
  1919. else if vl2.svalue<0 then
  1920. result:=cordconstnode.create(((vl2.svalue shr shift) or (mask shl (bits-shift))) and mask,def,false)
  1921. else
  1922. result:=cordconstnode.create((vl2.svalue shr shift) and mask,def,false);
  1923. {$pop}
  1924. end
  1925. else if (left.nodetype=callparan) and assigned(tcallparanode(left).right) and
  1926. (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
  1927. begin
  1928. def:=tcallparanode(tcallparanode(left).right).left.resultdef;
  1929. vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
  1930. { sar(0,x) is 0 }
  1931. { sar32(ffffffff,x) is ffffffff, etc. }
  1932. if ((vl2=0) or
  1933. ((resultdef.size=1) and (shortint(vl2.svalue)=-1)) or
  1934. ((resultdef.size=2) and (smallint(vl2.svalue)=-1)) or
  1935. ((resultdef.size=4) and (longint(vl2.svalue)=-1)) or
  1936. ((resultdef.size=8) and (int64(vl2.svalue)=-1))) and
  1937. ((cs_opt_level4 in current_settings.optimizerswitches) or
  1938. not might_have_sideeffects(tcallparanode(left).left)) then
  1939. begin
  1940. if vl2=0 then
  1941. result:=cordconstnode.create(0,resultdef,true)
  1942. else
  1943. result:=cordconstnode.create(-1,resultdef,true);
  1944. end;
  1945. end;
  1946. end;
  1947. function handle_const_rox : tnode;
  1948. var
  1949. vl,vl2 : TConstExprInt;
  1950. bits,shift: integer;
  1951. def : tdef;
  1952. begin
  1953. result:=nil;
  1954. if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then
  1955. begin
  1956. if (left.nodetype=callparan) and
  1957. assigned(tcallparanode(left).right) then
  1958. begin
  1959. vl:=tordconstnode(tcallparanode(left).left).value;
  1960. if forinline then
  1961. case resultdef.size of
  1962. { unlike shifts, for rotates, when masking out the higher bits
  1963. of the rotate count, we go all the way down to byte, because
  1964. it doesn't matter, it produces the same result, since it's a rotate }
  1965. 1:
  1966. vl:=vl and byte($07);
  1967. 2:
  1968. vl:=vl and byte($0f);
  1969. 4:
  1970. vl:=vl and byte($1f);
  1971. 8:
  1972. vl:=vl and byte($3f);
  1973. else
  1974. internalerror(2013122302);
  1975. end;
  1976. if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
  1977. begin
  1978. def:=tcallparanode(tcallparanode(left).right).left.resultdef;
  1979. vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
  1980. end
  1981. else if vl=0 then
  1982. begin
  1983. result:=tcallparanode(tcallparanode(left).right).left;
  1984. tcallparanode(tcallparanode(left).right).left:=nil;
  1985. exit;
  1986. end
  1987. else
  1988. exit;
  1989. end
  1990. else
  1991. begin
  1992. def:=left.resultdef;
  1993. vl:=1;
  1994. vl2:=tordconstnode(left).value;
  1995. end;
  1996. bits:=def.size*8;
  1997. shift:=vl.svalue and (bits-1);
  1998. {$push}
  1999. {$r-,q-}
  2000. if shift=0 then
  2001. result:=cordconstnode.create(vl2.svalue,def,false)
  2002. else
  2003. case inlinenumber of
  2004. in_ror_x,in_ror_x_y:
  2005. case def.size of
  2006. 1:
  2007. result:=cordconstnode.create(RorByte(Byte(vl2.svalue),shift),def,false);
  2008. 2:
  2009. result:=cordconstnode.create(RorWord(Word(vl2.svalue),shift),def,false);
  2010. 4:
  2011. result:=cordconstnode.create(RorDWord(DWord(vl2.svalue),shift),def,false);
  2012. 8:
  2013. result:=cordconstnode.create(RorQWord(QWord(vl2.svalue),shift),def,false);
  2014. else
  2015. internalerror(2011061903);
  2016. end;
  2017. in_rol_x,in_rol_x_y:
  2018. case def.size of
  2019. 1:
  2020. result:=cordconstnode.create(RolByte(Byte(vl2.svalue),shift),def,false);
  2021. 2:
  2022. result:=cordconstnode.create(RolWord(Word(vl2.svalue),shift),def,false);
  2023. 4:
  2024. result:=cordconstnode.create(RolDWord(DWord(vl2.svalue),shift),def,false);
  2025. 8:
  2026. result:=cordconstnode.create(RolQWord(QWord(vl2.svalue),shift),def,false);
  2027. else
  2028. internalerror(2011061902);
  2029. end;
  2030. else
  2031. internalerror(2011061901);
  2032. end;
  2033. {$pop}
  2034. end
  2035. else if (left.nodetype=callparan) and assigned(tcallparanode(left).right) and
  2036. (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
  2037. begin
  2038. def:=tcallparanode(tcallparanode(left).right).left.resultdef;
  2039. vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
  2040. { rol/ror are unsigned operations, so cut off upper bits }
  2041. case resultdef.size of
  2042. 1:
  2043. vl2:=vl2 and byte($ff);
  2044. 2:
  2045. vl2:=vl2 and word($ffff);
  2046. 4:
  2047. vl2:=vl2 and dword($ffffffff);
  2048. 8:
  2049. vl2:=vl2 and qword($ffffffffffffffff);
  2050. else
  2051. internalerror(2017050101);
  2052. end;
  2053. { rol(0,x) and ror(0,x) are 0 }
  2054. { rol32(ffffffff,x) and ror32(ffffffff,x) are ffffffff, etc. }
  2055. if ((vl2=0) or
  2056. ((resultdef.size=1) and (vl2=$ff)) or
  2057. ((resultdef.size=2) and (vl2=$ffff)) or
  2058. ((resultdef.size=4) and (vl2=$ffffffff)) or
  2059. ((resultdef.size=8) and (vl2.uvalue=qword($ffffffffffffffff)))) and
  2060. ((cs_opt_level4 in current_settings.optimizerswitches) or
  2061. not might_have_sideeffects(tcallparanode(left).left)) then
  2062. result:=cordconstnode.create(vl2,resultdef,true);
  2063. end;
  2064. end;
  2065. var
  2066. hp : tnode;
  2067. vl,vl2 : TConstExprInt;
  2068. vr : bestreal;
  2069. begin { simplify }
  2070. result:=nil;
  2071. { handle intern constant functions in separate case }
  2072. if nf_inlineconst in flags then
  2073. begin
  2074. { no parameters? }
  2075. if not assigned(left) then
  2076. internalerror(200501231)
  2077. else
  2078. begin
  2079. vl:=0;
  2080. vl2:=0; { second parameter Ex: ptr(vl,vl2) }
  2081. case left.nodetype of
  2082. realconstn :
  2083. begin
  2084. { Real functions are all handled with internproc below }
  2085. CGMessage1(type_e_integer_expr_expected,left.resultdef.typename)
  2086. end;
  2087. ordconstn :
  2088. vl:=tordconstnode(left).value;
  2089. callparan :
  2090. begin
  2091. { both exists, else it was not generated }
  2092. vl:=tordconstnode(tcallparanode(left).left).value;
  2093. vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
  2094. end;
  2095. else
  2096. CGMessage(parser_e_illegal_expression);
  2097. end;
  2098. case inlinenumber of
  2099. in_const_abs :
  2100. if vl.signed then
  2101. hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline,false)
  2102. else
  2103. hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline,false);
  2104. in_const_sqr:
  2105. if vl.signed then
  2106. hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline,false)
  2107. else
  2108. hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline,false);
  2109. in_const_odd :
  2110. hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool1type,true);
  2111. in_const_swap_word :
  2112. hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resultdef,true);
  2113. in_const_swap_long :
  2114. hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resultdef,true);
  2115. in_const_swap_qword :
  2116. hp:=cordconstnode.create((vl and $ffffffff) shl 32+(vl shr 32),left.resultdef,true);
  2117. in_const_ptr:
  2118. begin
  2119. {Don't construct pointers from negative values.}
  2120. if (vl.signed and (vl.svalue<0)) or (vl2.signed and (vl2.svalue<0)) then
  2121. cgmessage(parser_e_range_check_error);
  2122. {$if defined(i8086)}
  2123. hp:=cpointerconstnode.create((vl2.uvalue shl 16)+vl.uvalue,voidfarpointertype);
  2124. {$elseif defined(i386)}
  2125. hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidnearfspointertype);
  2126. {$else}
  2127. hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidpointertype);
  2128. {$endif}
  2129. end;
  2130. in_const_eh_return_data_regno:
  2131. begin
  2132. vl:=eh_return_data_regno(vl.svalue);
  2133. if vl=-1 then
  2134. CGMessagePos(left.fileinfo,type_e_range_check_error_bounds);
  2135. hp:=genintconstnode(vl);
  2136. end;
  2137. else
  2138. internalerror(88);
  2139. end;
  2140. end;
  2141. if hp=nil then
  2142. hp:=cerrornode.create;
  2143. result:=hp;
  2144. end
  2145. else
  2146. begin
  2147. case inlinenumber of
  2148. in_lo_long,
  2149. in_hi_long,
  2150. in_lo_qword,
  2151. in_hi_qword,
  2152. in_lo_word,
  2153. in_hi_word :
  2154. begin
  2155. if left.nodetype=ordconstn then
  2156. begin
  2157. case inlinenumber of
  2158. in_lo_word :
  2159. result:=cordconstnode.create(tordconstnode(left).value and $ff,u8inttype,true);
  2160. in_hi_word :
  2161. result:=cordconstnode.create(tordconstnode(left).value shr 8,u8inttype,true);
  2162. in_lo_long :
  2163. result:=cordconstnode.create(tordconstnode(left).value and $ffff,u16inttype,true);
  2164. in_hi_long :
  2165. result:=cordconstnode.create(tordconstnode(left).value shr 16,u16inttype,true);
  2166. in_lo_qword :
  2167. result:=cordconstnode.create(tordconstnode(left).value and $ffffffff,u32inttype,true);
  2168. in_hi_qword :
  2169. result:=cordconstnode.create(tordconstnode(left).value shr 32,u32inttype,true);
  2170. else
  2171. internalerror(2019050514);
  2172. end;
  2173. end;
  2174. end;
  2175. in_ord_x:
  2176. begin
  2177. case left.resultdef.typ of
  2178. orddef :
  2179. begin
  2180. case torddef(left.resultdef).ordtype of
  2181. pasbool1,
  2182. pasbool8,
  2183. uchar:
  2184. begin
  2185. { change to byte() }
  2186. result:=ctypeconvnode.create_internal(left,u8inttype);
  2187. left:=nil;
  2188. end;
  2189. pasbool16,
  2190. uwidechar :
  2191. begin
  2192. { change to word() }
  2193. result:=ctypeconvnode.create_internal(left,u16inttype);
  2194. left:=nil;
  2195. end;
  2196. pasbool32 :
  2197. begin
  2198. { change to dword() }
  2199. result:=ctypeconvnode.create_internal(left,u32inttype);
  2200. left:=nil;
  2201. end;
  2202. pasbool64 :
  2203. begin
  2204. { change to qword() }
  2205. result:=ctypeconvnode.create_internal(left,u64inttype);
  2206. left:=nil;
  2207. end;
  2208. bool8bit:
  2209. begin
  2210. { change to shortint() }
  2211. result:=ctypeconvnode.create_internal(left,s8inttype);
  2212. left:=nil;
  2213. end;
  2214. bool16bit :
  2215. begin
  2216. { change to smallint() }
  2217. result:=ctypeconvnode.create_internal(left,s16inttype);
  2218. left:=nil;
  2219. end;
  2220. bool32bit :
  2221. begin
  2222. { change to longint() }
  2223. result:=ctypeconvnode.create_internal(left,s32inttype);
  2224. left:=nil;
  2225. end;
  2226. bool64bit :
  2227. begin
  2228. { change to int64() }
  2229. result:=ctypeconvnode.create_internal(left,s64inttype);
  2230. left:=nil;
  2231. end;
  2232. uvoid :
  2233. CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
  2234. else
  2235. begin
  2236. { all other orddef need no transformation }
  2237. result:=left;
  2238. left:=nil;
  2239. end;
  2240. end;
  2241. end;
  2242. enumdef :
  2243. begin
  2244. result:=ctypeconvnode.create_internal(left,s32inttype);
  2245. left:=nil;
  2246. end;
  2247. undefineddef :
  2248. begin
  2249. { we just create a constant 0 here, that's marked as a
  2250. parameter }
  2251. result:=cordconstnode.create(0,s32inttype,false);
  2252. include(result.flags,nf_generic_para);
  2253. left:=nil;
  2254. end;
  2255. pointerdef :
  2256. begin
  2257. if m_mac in current_settings.modeswitches then
  2258. begin
  2259. result:=ctypeconvnode.create_internal(left,ptruinttype);
  2260. left:=nil;
  2261. end
  2262. end;
  2263. else
  2264. internalerror(2019050513);
  2265. end;
  2266. (*
  2267. if (left.nodetype=ordconstn) then
  2268. begin
  2269. result:=cordconstnode.create(
  2270. tordconstnode(left).value,sinttype,true);
  2271. end
  2272. else if (m_mac in current_settings.modeswitches) and
  2273. (left.ndoetype=pointerconstn) then
  2274. result:=cordconstnode.create(
  2275. tpointerconstnode(left).value,ptruinttype,true);
  2276. *)
  2277. end;
  2278. in_chr_byte:
  2279. begin
  2280. { convert to explicit char() }
  2281. result:=ctypeconvnode.create_internal(left,cansichartype);
  2282. left:=nil;
  2283. end;
  2284. in_length_x:
  2285. begin
  2286. case left.resultdef.typ of
  2287. stringdef :
  2288. begin
  2289. if (left.nodetype=stringconstn) then
  2290. begin
  2291. result:=cordconstnode.create(
  2292. tstringconstnode(left).len,sinttype,true);
  2293. end;
  2294. end;
  2295. orddef :
  2296. begin
  2297. { length of char is always one }
  2298. if is_char(left.resultdef) or
  2299. is_widechar(left.resultdef) then
  2300. begin
  2301. result:=cordconstnode.create(1,sinttype,false);
  2302. end
  2303. end;
  2304. arraydef :
  2305. begin
  2306. if (left.nodetype=stringconstn) then
  2307. begin
  2308. result:=cordconstnode.create(
  2309. tstringconstnode(left).len,sinttype,true);
  2310. end
  2311. else if not is_open_array(left.resultdef) and
  2312. not is_array_of_const(left.resultdef) and
  2313. not is_dynamic_array(left.resultdef) then
  2314. result:=cordconstnode.create(tarraydef(left.resultdef).highrange-
  2315. tarraydef(left.resultdef).lowrange+1,
  2316. sinttype,true);
  2317. end;
  2318. else
  2319. ;
  2320. end;
  2321. end;
  2322. in_assigned_x:
  2323. begin
  2324. if is_constnode(tcallparanode(left).left) or
  2325. (tcallparanode(left).left.nodetype = pointerconstn) then
  2326. begin
  2327. { let an add node figure it out }
  2328. result:=caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
  2329. tcallparanode(left).left := nil;
  2330. end;
  2331. end;
  2332. in_pred_x,
  2333. in_succ_x:
  2334. begin
  2335. case left.nodetype of
  2336. ordconstn:
  2337. begin
  2338. if inlinenumber=in_succ_x then
  2339. vl:=tordconstnode(left).value+1
  2340. else
  2341. vl:=tordconstnode(left).value-1;
  2342. if is_integer(left.resultdef) then
  2343. { the type of the original integer constant is irrelevant,
  2344. it should be automatically adapted to the new value
  2345. (except when inlining) }
  2346. result:=create_simplified_ord_const(vl,resultdef,forinline,cs_check_range in localswitches)
  2347. else
  2348. { check the range for enums, chars, booleans }
  2349. result:=cordconstnode.create(vl,left.resultdef,not(nf_internal in flags));
  2350. result.flags:=result.flags+(flags*[nf_internal]);
  2351. end;
  2352. addn,
  2353. subn:
  2354. begin
  2355. { fold succ/pred in child add/sub nodes with a constant if possible:
  2356. - no overflow/range checking
  2357. - equal types
  2358. }
  2359. if ([cs_check_overflow,cs_check_range]*current_settings.localswitches)=[] then
  2360. begin
  2361. if inlinenumber=in_succ_x then
  2362. vl:=1
  2363. else
  2364. vl:=-1;
  2365. if (taddnode(left).left.nodetype=ordconstn) and equal_defs(resultdef,taddnode(left).left.resultdef) then
  2366. begin
  2367. tordconstnode(taddnode(left).left).value:=tordconstnode(taddnode(left).left).value+vl;
  2368. result:=left;
  2369. left:=nil;
  2370. end
  2371. else if (taddnode(left).right.nodetype=ordconstn) and equal_defs(resultdef,taddnode(left).right.resultdef) then
  2372. begin
  2373. if left.nodetype=subn then
  2374. tordconstnode(taddnode(left).right).value:=tordconstnode(taddnode(left).right).value-vl
  2375. else
  2376. tordconstnode(taddnode(left).right).value:=tordconstnode(taddnode(left).right).value+vl;
  2377. result:=left;
  2378. left:=nil;
  2379. end;
  2380. end;
  2381. end;
  2382. else
  2383. ;
  2384. end;
  2385. end;
  2386. in_low_x,
  2387. in_high_x:
  2388. begin
  2389. case left.resultdef.typ of
  2390. orddef,
  2391. enumdef:
  2392. begin
  2393. result:=do_lowhigh(left.resultdef);
  2394. end;
  2395. setdef:
  2396. begin
  2397. result:=do_lowhigh(tsetdef(left.resultdef).elementdef);
  2398. end;
  2399. arraydef:
  2400. begin
  2401. if (inlinenumber=in_low_x) then
  2402. begin
  2403. result:=cordconstnode.create(int64(tarraydef(
  2404. left.resultdef).lowrange),tarraydef(left.resultdef).rangedef,true);
  2405. end
  2406. else if not is_open_array(left.resultdef) and
  2407. not is_array_of_const(left.resultdef) and
  2408. not is_dynamic_array(left.resultdef) then
  2409. result:=cordconstnode.create(int64(tarraydef(left.resultdef).highrange),
  2410. tarraydef(left.resultdef).rangedef,true);
  2411. end;
  2412. stringdef:
  2413. begin
  2414. if inlinenumber=in_low_x then
  2415. begin
  2416. if is_dynamicstring(left.resultdef) and
  2417. not(cs_zerobasedstrings in current_settings.localswitches) then
  2418. result:=cordconstnode.create(1,u8inttype,false)
  2419. else
  2420. result:=cordconstnode.create(0,u8inttype,false);
  2421. end
  2422. else if not is_dynamicstring(left.resultdef) then
  2423. result:=cordconstnode.create(tstringdef(left.resultdef).len,u8inttype,true)
  2424. end;
  2425. undefineddef:
  2426. begin
  2427. result:=cordconstnode.create(0,u8inttype,false);
  2428. end;
  2429. errordef:
  2430. ;
  2431. else
  2432. internalerror(2019050512);
  2433. end;
  2434. end;
  2435. in_exp_real :
  2436. begin
  2437. if left.nodetype in [ordconstn,realconstn] then
  2438. begin
  2439. result:=crealconstnode.create(exp(getconstrealvalue),pbestrealtype^);
  2440. if (trealconstnode(result).value_real=MathInf.Value) and
  2441. floating_point_range_check_error then
  2442. begin
  2443. result:=crealconstnode.create(0,pbestrealtype^);
  2444. CGMessage(parser_e_range_check_error);
  2445. end;
  2446. end
  2447. end;
  2448. in_trunc_real :
  2449. begin
  2450. if left.nodetype in [ordconstn,realconstn] then
  2451. begin
  2452. vr:=getconstrealvalue;
  2453. if (vr>=9223372036854775807.99) or (vr<=-9223372036854775808.0) then
  2454. begin
  2455. message3(type_e_range_check_error_bounds,realtostr(vr),'-9223372036854775808.0','9223372036854775807.99..');
  2456. result:=cordconstnode.create(1,s64inttype,false)
  2457. end
  2458. else
  2459. result:=cordconstnode.create(trunc(vr),s64inttype,true)
  2460. end
  2461. end;
  2462. in_round_real :
  2463. begin
  2464. { can't evaluate while inlining, may depend on fpu setting }
  2465. if (not forinline) and
  2466. (left.nodetype in [ordconstn,realconstn]) then
  2467. begin
  2468. vr:=getconstrealvalue;
  2469. if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
  2470. begin
  2471. message3(type_e_range_check_error_bounds,realtostr(vr),'-9223372036854775808.49..','9223372036854775807.49..');
  2472. result:=cordconstnode.create(1,s64inttype,false)
  2473. end
  2474. else
  2475. result:=cordconstnode.create(round(vr),s64inttype,true)
  2476. end
  2477. end;
  2478. in_frac_real :
  2479. begin
  2480. if left.nodetype in [ordconstn,realconstn] then
  2481. setconstrealvalue(frac(getconstrealvalue))
  2482. end;
  2483. in_int_real :
  2484. begin
  2485. if left.nodetype in [ordconstn,realconstn] then
  2486. setconstrealvalue(int(getconstrealvalue));
  2487. end;
  2488. in_pi_real :
  2489. begin
  2490. if block_type=bt_const then
  2491. setconstrealvalue(getpi)
  2492. end;
  2493. in_cos_real :
  2494. begin
  2495. if left.nodetype in [ordconstn,realconstn] then
  2496. setconstrealvalue(cos(getconstrealvalue))
  2497. end;
  2498. in_sin_real :
  2499. begin
  2500. if left.nodetype in [ordconstn,realconstn] then
  2501. setconstrealvalue(sin(getconstrealvalue))
  2502. end;
  2503. in_arctan_real :
  2504. begin
  2505. if left.nodetype in [ordconstn,realconstn] then
  2506. setconstrealvalue(arctan(getconstrealvalue))
  2507. end;
  2508. in_abs_real :
  2509. begin
  2510. if left.nodetype in [ordconstn,realconstn] then
  2511. setconstrealvalue(abs(getconstrealvalue))
  2512. end;
  2513. in_abs_long:
  2514. begin
  2515. if left.nodetype=ordconstn then
  2516. begin
  2517. if tordconstnode(left).value<0 then
  2518. result:=cordconstnode.create((-tordconstnode(left).value),resultdef,false)
  2519. else
  2520. result:=cordconstnode.create((tordconstnode(left).value),resultdef,false);
  2521. end
  2522. end;
  2523. in_sqr_real :
  2524. begin
  2525. if left.nodetype in [ordconstn,realconstn] then
  2526. setconstrealvalue(sqr(getconstrealvalue))
  2527. end;
  2528. in_sqrt_real :
  2529. begin
  2530. if left.nodetype in [ordconstn,realconstn] then
  2531. result:=handle_sqrt_const(getconstrealvalue);
  2532. end;
  2533. in_ln_real :
  2534. begin
  2535. if left.nodetype in [ordconstn,realconstn] then
  2536. result:=handle_ln_const(getconstrealvalue);
  2537. end;
  2538. in_assert_x_y :
  2539. begin
  2540. if not(cs_do_assertion in current_settings.localswitches) then
  2541. { we need a valid node, so insert a nothingn }
  2542. result:=cnothingnode.create;
  2543. end;
  2544. in_sar_x,
  2545. in_sar_x_y :
  2546. begin
  2547. result:=handle_const_sar;
  2548. end;
  2549. in_rol_x,
  2550. in_rol_x_y,
  2551. in_ror_x,
  2552. in_ror_x_y :
  2553. result:=handle_const_rox;
  2554. in_bsf_x:
  2555. begin
  2556. if left.nodetype=ordconstn then
  2557. begin
  2558. case left.resultdef.size of
  2559. 1:
  2560. result:=cordconstnode.create(BsfByte(Byte(tordconstnode(left).value.uvalue)),resultdef,false);
  2561. 2:
  2562. result:=cordconstnode.create(BsfWord(Word(tordconstnode(left).value.uvalue)),resultdef,false);
  2563. 4:
  2564. result:=cordconstnode.create(BsfDWord(DWord(tordconstnode(left).value.uvalue)),resultdef,false);
  2565. 8:
  2566. result:=cordconstnode.create(BsfQWord(QWord(tordconstnode(left).value.uvalue)),resultdef,false);
  2567. else
  2568. internalerror(2017042401);
  2569. end;
  2570. end;
  2571. end;
  2572. in_bsr_x :
  2573. begin
  2574. if left.nodetype=ordconstn then
  2575. begin
  2576. case left.resultdef.size of
  2577. 1:
  2578. result:=cordconstnode.create(BsrByte(Byte(tordconstnode(left).value.uvalue)),resultdef,false);
  2579. 2:
  2580. result:=cordconstnode.create(BsrWord(Word(tordconstnode(left).value.uvalue)),resultdef,false);
  2581. 4:
  2582. result:=cordconstnode.create(BsrDWord(DWord(tordconstnode(left).value.uvalue)),resultdef,false);
  2583. 8:
  2584. result:=cordconstnode.create(BsrQWord(QWord(tordconstnode(left).value.uvalue)),resultdef,false);
  2585. else
  2586. internalerror(2017042401);
  2587. end;
  2588. end;
  2589. end;
  2590. in_popcnt_x :
  2591. begin
  2592. if left.nodetype=ordconstn then
  2593. begin
  2594. result:=cordconstnode.create(PopCnt(tordconstnode(left).value),resultdef,false);
  2595. end;
  2596. end;
  2597. else
  2598. ;
  2599. end;
  2600. end;
  2601. end;
  2602. function tinlinenode.pass_typecheck:tnode;
  2603. procedure setfloatresultdef;
  2604. var
  2605. hnode: tnode;
  2606. begin
  2607. { System unit declares internal functions like this:
  2608. function foo(x: valreal): valreal; [internproc: number];
  2609. Calls to such functions are initially processed by callnode,
  2610. which typechecks the arguments, possibly inserting conversion to valreal.
  2611. To handle smaller types without excess precision, we need to remove
  2612. these extra typecasts. }
  2613. if (left.nodetype=typeconvn) and
  2614. (ttypeconvnode(left).left.resultdef.typ=floatdef) and
  2615. (left.flags*[nf_explicit,nf_internal]=[]) and
  2616. (tfloatdef(ttypeconvnode(left).left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
  2617. begin
  2618. hnode:=ttypeconvnode(left).left;
  2619. ttypeconvnode(left).left:=nil;
  2620. left.free;
  2621. left:=hnode;
  2622. resultdef:=left.resultdef;
  2623. end
  2624. else if (left.resultdef.typ=floatdef) and
  2625. (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
  2626. resultdef:=left.resultdef
  2627. else
  2628. begin
  2629. if (left.nodetype <> ordconstn) then
  2630. inserttypeconv(left,pbestrealtype^);
  2631. resultdef:=pbestrealtype^;
  2632. end;
  2633. end;
  2634. procedure handle_pack_unpack;
  2635. var
  2636. source, target, index: tcallparanode;
  2637. unpackedarraydef, packedarraydef: tarraydef;
  2638. tempindex: TConstExprInt;
  2639. begin
  2640. resultdef:=voidtype;
  2641. unpackedarraydef := nil;
  2642. packedarraydef := nil;
  2643. source := tcallparanode(left);
  2644. if (inlinenumber = in_unpack_x_y_z) then
  2645. begin
  2646. target := tcallparanode(source.right);
  2647. index := tcallparanode(target.right);
  2648. { source must be a packed array }
  2649. if not is_packed_array(source.left.resultdef) then
  2650. CGMessagePos2(source.left.fileinfo,type_e_got_expected_packed_array,'1',source.left.resultdef.typename)
  2651. else
  2652. packedarraydef := tarraydef(source.left.resultdef);
  2653. { target can be any kind of array, as long as it's not packed }
  2654. if (target.left.resultdef.typ <> arraydef) or
  2655. is_packed_array(target.left.resultdef) then
  2656. CGMessagePos2(target.left.fileinfo,type_e_got_expected_unpacked_array,'2',target.left.resultdef.typename)
  2657. else
  2658. unpackedarraydef := tarraydef(target.left.resultdef);
  2659. end
  2660. else
  2661. begin
  2662. index := tcallparanode(source.right);
  2663. target := tcallparanode(index.right);
  2664. { source can be any kind of array, as long as it's not packed }
  2665. if (source.left.resultdef.typ <> arraydef) or
  2666. is_packed_array(source.left.resultdef) then
  2667. CGMessagePos2(source.left.fileinfo,type_e_got_expected_unpacked_array,'1',source.left.resultdef.typename)
  2668. else
  2669. unpackedarraydef := tarraydef(source.left.resultdef);
  2670. { target must be a packed array }
  2671. if not is_packed_array(target.left.resultdef) then
  2672. CGMessagePos2(target.left.fileinfo,type_e_got_expected_packed_array,'3',target.left.resultdef.typename)
  2673. else
  2674. packedarraydef := tarraydef(target.left.resultdef);
  2675. end;
  2676. if assigned(unpackedarraydef) then
  2677. begin
  2678. { index must be compatible with the unpacked array's indextype }
  2679. inserttypeconv(index.left,unpackedarraydef.rangedef);
  2680. { range check at compile time if possible }
  2681. if assigned(packedarraydef) and
  2682. (index.left.nodetype = ordconstn) and
  2683. not is_special_array(unpackedarraydef) then
  2684. begin
  2685. adaptrange(unpackedarraydef,tordconstnode(index.left).value,false,false,cs_check_range in current_settings.localswitches);
  2686. tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
  2687. adaptrange(unpackedarraydef,tempindex,false,false,cs_check_range in current_settings.localswitches);
  2688. end;
  2689. end;
  2690. { source array is read and must be valid }
  2691. set_varstate(source.left,vs_read,[vsf_must_be_valid]);
  2692. { target array is written }
  2693. valid_for_assignment(target.left,true);
  2694. set_varstate(target.left,vs_written,[]);
  2695. { index in the unpacked array is read and must be valid }
  2696. set_varstate(index.left,vs_read,[vsf_must_be_valid]);
  2697. { if the size of the arrays is 0 (array of empty records), }
  2698. { do nothing }
  2699. if (source.resultdef.size = 0) then
  2700. result:=cnothingnode.create;
  2701. end;
  2702. function handle_objc_encode: tnode;
  2703. var
  2704. encodedtype: ansistring;
  2705. errordef: tdef;
  2706. begin
  2707. encodedtype:='';
  2708. if not objctryencodetype(left.resultdef,encodedtype,errordef) then
  2709. Message1(type_e_objc_type_unsupported,errordef.typename);
  2710. result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype),nil);
  2711. end;
  2712. var
  2713. hightree,
  2714. hp : tnode;
  2715. temp_pnode: pnode;
  2716. begin
  2717. result:=nil;
  2718. { when handling writeln "left" contains no valid address }
  2719. if assigned(left) then
  2720. begin
  2721. if left.nodetype=callparan then
  2722. tcallparanode(left).get_paratype
  2723. else
  2724. typecheckpass(left);
  2725. end;
  2726. if not(nf_inlineconst in flags) then
  2727. begin
  2728. case inlinenumber of
  2729. in_lo_long,
  2730. in_hi_long,
  2731. in_lo_qword,
  2732. in_hi_qword,
  2733. in_lo_word,
  2734. in_hi_word :
  2735. begin
  2736. { give warning for incompatibility with tp and delphi }
  2737. if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and
  2738. ((m_tp7 in current_settings.modeswitches) or
  2739. (m_delphi in current_settings.modeswitches)) then
  2740. CGMessage(type_w_maybe_wrong_hi_lo);
  2741. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2742. if not is_integer(left.resultdef) then
  2743. CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
  2744. case inlinenumber of
  2745. in_lo_word,
  2746. in_hi_word :
  2747. resultdef:=u8inttype;
  2748. in_lo_long,
  2749. in_hi_long :
  2750. resultdef:=u16inttype;
  2751. in_lo_qword,
  2752. in_hi_qword :
  2753. resultdef:=u32inttype;
  2754. else
  2755. ;
  2756. end;
  2757. end;
  2758. in_sizeof_x:
  2759. begin
  2760. { the constant evaluation of in_sizeof_x happens in pexpr where possible }
  2761. set_varstate(left,vs_read,[]);
  2762. if (left.resultdef.typ<>undefineddef) and
  2763. paramanager.push_high_param(vs_value,left.resultdef,current_procinfo.procdef.proccalloption) then
  2764. begin
  2765. { this should be an open array or array of const, both of
  2766. which can only be simple load nodes of parameters }
  2767. if left.nodetype<>loadn then
  2768. internalerror(2014120701);
  2769. hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
  2770. if assigned(hightree) then
  2771. begin
  2772. hp:=caddnode.create(addn,hightree,
  2773. cordconstnode.create(1,sizesinttype,false));
  2774. if (left.resultdef.typ=arraydef) then
  2775. if not is_packed_array(tarraydef(left.resultdef)) then
  2776. begin
  2777. if (tarraydef(left.resultdef).elesize<>1) then
  2778. hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(
  2779. left.resultdef).elesize,sizesinttype,true));
  2780. end
  2781. else if (tarraydef(left.resultdef).elepackedbitsize <> 8) then
  2782. begin
  2783. { no packed open array support yet }
  2784. if (hp.nodetype <> ordconstn) then
  2785. internalerror(2006081511);
  2786. hp.free;
  2787. hp := cordconstnode.create(left.resultdef.size,sizesinttype,true);
  2788. {
  2789. hp:=
  2790. ctypeconvnode.create_explicit(sizesinttype,
  2791. cmoddivnode.create(divn,
  2792. caddnode.create(addn,
  2793. caddnode.create(muln,hp,cordconstnode.create(tarraydef(
  2794. left.resultdef).elepackedbitsize,s64inttype,true)),
  2795. cordconstnode.create(a,s64inttype,true)),
  2796. cordconstnode.create(8,s64inttype,true)),
  2797. sizesinttype);
  2798. }
  2799. end;
  2800. result:=hp;
  2801. end;
  2802. end
  2803. else
  2804. resultdef:=sizesinttype;
  2805. end;
  2806. in_typeof_x:
  2807. begin
  2808. if target_info.system in systems_managed_vm then
  2809. message(parser_e_feature_unsupported_for_vm);
  2810. typecheckpass(left);
  2811. set_varstate(left,vs_read,[]);
  2812. if (left.resultdef.typ=objectdef) and
  2813. not(oo_has_vmt in tobjectdef(left.resultdef).objectoptions) then
  2814. message(type_e_typeof_requires_vmt);
  2815. resultdef:=voidpointertype;
  2816. end;
  2817. in_ord_x:
  2818. begin
  2819. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2820. case left.resultdef.typ of
  2821. orddef,
  2822. enumdef,
  2823. undefineddef :
  2824. ;
  2825. pointerdef :
  2826. begin
  2827. if not(m_mac in current_settings.modeswitches) then
  2828. CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
  2829. end
  2830. else
  2831. CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
  2832. end;
  2833. end;
  2834. in_chr_byte:
  2835. begin
  2836. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2837. end;
  2838. in_length_x:
  2839. begin
  2840. if ((left.resultdef.typ=arraydef) and
  2841. (not is_special_array(left.resultdef) or
  2842. is_open_array(left.resultdef))) or
  2843. (left.resultdef.typ=orddef) then
  2844. set_varstate(left,vs_read,[])
  2845. else
  2846. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2847. case left.resultdef.typ of
  2848. variantdef:
  2849. begin
  2850. inserttypeconv(left,getansistringdef);
  2851. end;
  2852. stringdef :
  2853. begin
  2854. { we don't need string convertions here, }
  2855. { except if from widestring to ansistring }
  2856. { and vice versa (that can change the }
  2857. { length) }
  2858. if (left.nodetype=typeconvn) and
  2859. (ttypeconvnode(left).left.resultdef.typ=stringdef) and
  2860. not(is_wide_or_unicode_string(left.resultdef) xor
  2861. is_wide_or_unicode_string(ttypeconvnode(left).left.resultdef)) then
  2862. begin
  2863. hp:=ttypeconvnode(left).left;
  2864. ttypeconvnode(left).left:=nil;
  2865. left.free;
  2866. left:=hp;
  2867. end;
  2868. end;
  2869. orddef :
  2870. begin
  2871. { will be handled in simplify }
  2872. if not is_char(left.resultdef) and
  2873. not is_widechar(left.resultdef) then
  2874. CGMessage(type_e_mismatch);
  2875. end;
  2876. pointerdef :
  2877. begin
  2878. if is_pchar(left.resultdef) then
  2879. begin
  2880. hp := ccallparanode.create(left,nil);
  2881. result := ccallnode.createintern('fpc_pchar_length',hp);
  2882. { make sure the left node doesn't get disposed, since it's }
  2883. { reused in the new node (JM) }
  2884. left:=nil;
  2885. exit;
  2886. end
  2887. else if is_pwidechar(left.resultdef) then
  2888. begin
  2889. hp := ccallparanode.create(left,nil);
  2890. result := ccallnode.createintern('fpc_pwidechar_length',hp);
  2891. { make sure the left node doesn't get disposed, since it's }
  2892. { reused in the new node (JM) }
  2893. left:=nil;
  2894. exit;
  2895. end
  2896. else
  2897. CGMessage(type_e_mismatch);
  2898. end;
  2899. arraydef :
  2900. begin
  2901. if is_open_array(left.resultdef) or
  2902. is_array_of_const(left.resultdef) then
  2903. begin
  2904. hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
  2905. if assigned(hightree) then
  2906. result:=caddnode.create(addn,hightree,
  2907. cordconstnode.create(1,sinttype,false));
  2908. exit;
  2909. end
  2910. { Length() for dynamic arrays is inlined }
  2911. else
  2912. begin
  2913. { will be handled in simplify }
  2914. end;
  2915. end;
  2916. undefineddef :
  2917. begin
  2918. if not (df_generic in current_procinfo.procdef.defoptions) then
  2919. CGMessage(type_e_mismatch);
  2920. { otherwise nothing }
  2921. end;
  2922. else
  2923. CGMessage(type_e_mismatch);
  2924. end;
  2925. { shortstring return an 8 bit value as the length
  2926. is the first byte of the string }
  2927. if is_shortstring(left.resultdef) then
  2928. resultdef:=u8inttype
  2929. else
  2930. resultdef:=ossinttype;
  2931. end;
  2932. in_typeinfo_x:
  2933. begin
  2934. if target_info.system in systems_managed_vm then
  2935. message(parser_e_feature_unsupported_for_vm);
  2936. if (left.resultdef.typ=enumdef) and
  2937. (tenumdef(left.resultdef).has_jumps) then
  2938. CGMessage(type_e_no_type_info);
  2939. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2940. resultdef:=voidpointertype;
  2941. end;
  2942. in_gettypekind_x:
  2943. begin
  2944. if target_info.system in systems_managed_vm then
  2945. message(parser_e_feature_unsupported_for_vm);
  2946. if (left.resultdef.typ=enumdef) and
  2947. (tenumdef(left.resultdef).has_jumps) then
  2948. CGMessage(type_e_no_type_info);
  2949. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2950. resultdef:=typekindtype;
  2951. end;
  2952. in_ismanagedtype_x:
  2953. begin
  2954. if target_info.system in systems_managed_vm then
  2955. message(parser_e_feature_unsupported_for_vm);
  2956. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2957. resultdef:=pasbool1type;
  2958. end;
  2959. in_assigned_x:
  2960. begin
  2961. { the parser has already made sure the expression is valid }
  2962. { in case of a complex procvar, only check the "code" pointer }
  2963. if (tcallparanode(left).left.resultdef.typ=procvardef) and
  2964. not tprocvardef(tcallparanode(left).left.resultdef).is_addressonly then
  2965. begin
  2966. inserttypeconv_explicit(tcallparanode(left).left,search_system_type('TMETHOD').typedef);
  2967. tcallparanode(left).left:=csubscriptnode.create(tsym(tabstractrecorddef(tcallparanode(left).left.resultdef).symtable.find('CODE')),tcallparanode(left).left);
  2968. tcallparanode(left).get_paratype;
  2969. end;
  2970. { Postpone conversion into addnode until firstpass, so targets
  2971. may override first_assigned and insert specific code. }
  2972. set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
  2973. resultdef:=pasbool1type;
  2974. end;
  2975. in_ofs_x :
  2976. internalerror(2000101001);
  2977. in_seg_x :
  2978. begin
  2979. result := typecheck_seg;
  2980. end;
  2981. in_pred_x,
  2982. in_succ_x:
  2983. begin
  2984. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2985. resultdef:=left.resultdef;
  2986. if is_ordinal(resultdef) or is_typeparam(resultdef) then
  2987. begin
  2988. if (resultdef.typ=enumdef) and
  2989. (tenumdef(resultdef).has_jumps) and
  2990. not(m_delphi in current_settings.modeswitches) and
  2991. not(nf_internal in flags) then
  2992. CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible);
  2993. end
  2994. else
  2995. CGMessage(type_e_ordinal_expr_expected)
  2996. end;
  2997. in_copy_x:
  2998. result:=handle_copy;
  2999. in_initialize_x,
  3000. in_finalize_x:
  3001. begin
  3002. { inlined from pinline }
  3003. internalerror(200204231);
  3004. end;
  3005. in_setlength_x:
  3006. begin
  3007. result:=handle_setlength;
  3008. end;
  3009. in_inc_x,
  3010. in_dec_x:
  3011. begin
  3012. resultdef:=voidtype;
  3013. if not(df_generic in current_procinfo.procdef.defoptions) then
  3014. begin
  3015. if assigned(left) then
  3016. begin
  3017. { first param must be var }
  3018. valid_for_var(tcallparanode(left).left,true);
  3019. set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
  3020. if (left.resultdef.typ in [enumdef,pointerdef]) or
  3021. is_ordinal(left.resultdef) or
  3022. is_currency(left.resultdef) then
  3023. begin
  3024. { value of left gets changed -> must be unique }
  3025. set_unique(tcallparanode(left).left);
  3026. { two paras ? }
  3027. if assigned(tcallparanode(left).right) then
  3028. begin
  3029. if is_integer(tcallparanode(left).right.resultdef) then
  3030. begin
  3031. set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
  3032. { when range/overflow checking is on, we
  3033. convert this to a regular add, and for proper
  3034. checking we need the original type }
  3035. if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then
  3036. if (tcallparanode(left).left.resultdef.typ=pointerdef) then
  3037. begin
  3038. { don't convert values added to pointers into the pointer types themselves,
  3039. because that will turn signed values into unsigned ones, which then
  3040. goes wrong when they have to be multiplied with the size of the elements
  3041. to which the pointer points in ncginl (mantis #17342) }
  3042. if is_signed(tcallparanode(tcallparanode(left).right).left.resultdef) then
  3043. inserttypeconv(tcallparanode(tcallparanode(left).right).left,tpointerdef(tcallparanode(left).left.resultdef).pointer_arithmetic_int_type)
  3044. else
  3045. inserttypeconv(tcallparanode(tcallparanode(left).right).left,tpointerdef(tcallparanode(left).left.resultdef).pointer_arithmetic_uint_type)
  3046. end
  3047. else if is_integer(tcallparanode(left).left.resultdef) then
  3048. inserttypeconv(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef)
  3049. else
  3050. inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef);
  3051. if assigned(tcallparanode(tcallparanode(left).right).right) then
  3052. { should be handled in the parser (JM) }
  3053. internalerror(2006020901);
  3054. end
  3055. else
  3056. CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
  3057. end;
  3058. end
  3059. { generic type parameter? }
  3060. else if is_typeparam(left.resultdef) then
  3061. begin
  3062. result:=cnothingnode.create;
  3063. exit;
  3064. end
  3065. else
  3066. begin
  3067. hp:=self;
  3068. if isunaryoverloaded(hp,[]) then
  3069. begin
  3070. { inc(rec) and dec(rec) assigns result value to argument }
  3071. result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);
  3072. exit;
  3073. end
  3074. else
  3075. CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
  3076. end;
  3077. end
  3078. else
  3079. CGMessagePos(fileinfo,type_e_mismatch);
  3080. end;
  3081. end;
  3082. in_and_assign_x_y,
  3083. in_or_assign_x_y,
  3084. in_xor_assign_x_y,
  3085. in_sar_assign_x_y,
  3086. in_shl_assign_x_y,
  3087. in_shr_assign_x_y,
  3088. in_rol_assign_x_y,
  3089. in_ror_assign_x_y:
  3090. begin
  3091. resultdef:=voidtype;
  3092. if not(df_generic in current_procinfo.procdef.defoptions) then
  3093. begin
  3094. { first parameter must exist }
  3095. if not assigned(left) or (left.nodetype<>callparan) then
  3096. internalerror(2017032501);
  3097. { second parameter must exist }
  3098. if not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype<>callparan) then
  3099. internalerror(2017032502);
  3100. { third parameter must NOT exist }
  3101. if assigned(tcallparanode(tcallparanode(left).right).right) then
  3102. internalerror(2017032503);
  3103. valid_for_var(tcallparanode(tcallparanode(left).right).left,true);
  3104. set_varstate(tcallparanode(tcallparanode(left).right).left,vs_readwritten,[vsf_must_be_valid]);
  3105. if is_integer(tcallparanode(left).right.resultdef) then
  3106. begin
  3107. { value of right gets changed -> must be unique }
  3108. set_unique(tcallparanode(tcallparanode(left).right).left);
  3109. if is_integer(left.resultdef) then
  3110. begin
  3111. set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
  3112. { these nodes shouldn't be created, when range checking is on }
  3113. if [cs_check_range,cs_check_overflow]*localswitches<>[] then
  3114. internalerror(2017032701);
  3115. if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y] then
  3116. inserttypeconv(tcallparanode(left).left,sinttype)
  3117. else
  3118. inserttypeconv(tcallparanode(left).left,tcallparanode(tcallparanode(left).right).left.resultdef);
  3119. end
  3120. else
  3121. CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
  3122. end
  3123. { generic type parameter? }
  3124. else if is_typeparam(tcallparanode(left).right.resultdef) then
  3125. begin
  3126. result:=cnothingnode.create;
  3127. exit;
  3128. end
  3129. else
  3130. CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
  3131. end;
  3132. end;
  3133. in_neg_assign_x,
  3134. in_not_assign_x:
  3135. begin
  3136. resultdef:=voidtype;
  3137. if not(df_generic in current_procinfo.procdef.defoptions) then
  3138. begin
  3139. valid_for_var(left,true);
  3140. set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
  3141. if is_integer(left.resultdef) then
  3142. begin
  3143. { value of left gets changed -> must be unique }
  3144. set_unique(left);
  3145. { these nodes shouldn't be created, when range checking is on }
  3146. if [cs_check_range,cs_check_overflow]*current_settings.localswitches<>[] then
  3147. internalerror(2017040703);
  3148. end
  3149. { generic type parameter? }
  3150. else if is_typeparam(left.resultdef) then
  3151. begin
  3152. result:=cnothingnode.create;
  3153. exit;
  3154. end
  3155. else
  3156. CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
  3157. end;
  3158. end;
  3159. in_read_x,
  3160. in_readln_x,
  3161. in_readstr_x,
  3162. in_write_x,
  3163. in_writeln_x,
  3164. in_writestr_x :
  3165. begin
  3166. result := handle_read_write;
  3167. end;
  3168. in_settextbuf_file_x :
  3169. begin
  3170. if target_info.system in systems_managed_vm then
  3171. message(parser_e_feature_unsupported_for_vm);
  3172. resultdef:=voidtype;
  3173. { now we know the type of buffer }
  3174. hp:=ccallparanode.create(cordconstnode.create(
  3175. tcallparanode(left).left.resultdef.size,s32inttype,true),left);
  3176. result:=ccallnode.createintern('SETTEXTBUF',hp);
  3177. left:=nil;
  3178. end;
  3179. { the firstpass of the arg has been done in firstcalln ? }
  3180. in_reset_typedfile,
  3181. in_rewrite_typedfile,
  3182. in_reset_typedfile_name,
  3183. in_rewrite_typedfile_name :
  3184. begin
  3185. result := handle_reset_rewrite_typed;
  3186. end;
  3187. in_str_x_string :
  3188. begin
  3189. result:=handle_str;
  3190. end;
  3191. in_val_x :
  3192. begin
  3193. result:=handle_val;
  3194. end;
  3195. in_include_x_y,
  3196. in_exclude_x_y:
  3197. begin
  3198. resultdef:=voidtype;
  3199. { the parser already checks whether we have two (and exactly two) }
  3200. { parameters (JM) }
  3201. { first param must be var }
  3202. valid_for_var(tcallparanode(left).left,true);
  3203. set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
  3204. { check type }
  3205. if (left.resultdef.typ=setdef) then
  3206. begin
  3207. { insert a type conversion }
  3208. { to the type of the set elements }
  3209. set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
  3210. inserttypeconv(tcallparanode(tcallparanode(left).right).left,
  3211. tsetdef(left.resultdef).elementdef);
  3212. end
  3213. else
  3214. CGMessage(type_e_mismatch);
  3215. end;
  3216. in_pack_x_y_z,
  3217. in_unpack_x_y_z :
  3218. begin
  3219. handle_pack_unpack;
  3220. end;
  3221. in_slice_x:
  3222. begin
  3223. if target_info.system in systems_managed_vm then
  3224. message(parser_e_feature_unsupported_for_vm);
  3225. result:=nil;
  3226. resultdef:=tcallparanode(left).left.resultdef;
  3227. if (resultdef.typ <> arraydef) then
  3228. CGMessagePos(left.fileinfo,type_e_mismatch)
  3229. else if is_packed_array(resultdef) then
  3230. CGMessagePos2(left.fileinfo,type_e_got_expected_unpacked_array,'1',resultdef.typename);
  3231. if not(is_integer(tcallparanode(tcallparanode(left).right).left.resultdef)) then
  3232. CGMessagePos1(tcallparanode(left).right.fileinfo,
  3233. type_e_integer_expr_expected,
  3234. tcallparanode(tcallparanode(left).right).left.resultdef.typename);
  3235. end;
  3236. in_new_x:
  3237. resultdef:=left.resultdef;
  3238. in_low_x,
  3239. in_high_x:
  3240. begin
  3241. case left.resultdef.typ of
  3242. undefineddef,
  3243. orddef,
  3244. enumdef,
  3245. setdef:
  3246. ;
  3247. arraydef:
  3248. begin
  3249. if (inlinenumber=in_low_x) then
  3250. set_varstate(left,vs_read,[])
  3251. else
  3252. begin
  3253. if is_open_array(left.resultdef) or
  3254. is_array_of_const(left.resultdef) then
  3255. begin
  3256. set_varstate(left,vs_read,[]);
  3257. result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
  3258. end
  3259. else
  3260. begin
  3261. set_varstate(left,vs_read,[]);
  3262. resultdef:=sizesinttype;
  3263. end;
  3264. end;
  3265. end;
  3266. stringdef:
  3267. begin
  3268. if inlinenumber=in_low_x then
  3269. begin
  3270. set_varstate(left,vs_read,[]);
  3271. end
  3272. else
  3273. begin
  3274. if is_open_string(left.resultdef) then
  3275. begin
  3276. set_varstate(left,vs_read,[]);
  3277. result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry))
  3278. end
  3279. else if is_dynamicstring(left.resultdef) then
  3280. begin
  3281. result:=cinlinenode.create(in_length_x,false,left);
  3282. if cs_zerobasedstrings in current_settings.localswitches then
  3283. result:=caddnode.create(subn,result,cordconstnode.create(1,sinttype,false));
  3284. { make sure the left node doesn't get disposed, since it's }
  3285. { reused in the new node (JM) }
  3286. left:=nil;
  3287. end
  3288. end;
  3289. end;
  3290. else
  3291. CGMessage(type_e_mismatch);
  3292. end;
  3293. end;
  3294. in_exp_real,
  3295. in_frac_real,
  3296. in_int_real,
  3297. in_cos_real,
  3298. in_sin_real,
  3299. in_arctan_real,
  3300. in_ln_real :
  3301. begin
  3302. { on the Z80, the double result is returned in a var param, because
  3303. it's too big to fit in registers. In that case we have 2 parameters
  3304. and left.nodetype is a callparan. }
  3305. if left.nodetype = callparan then
  3306. temp_pnode := @tcallparanode(left).left
  3307. else
  3308. temp_pnode := @left;
  3309. set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
  3310. { converting an int64 to double on platforms without }
  3311. { extended can cause precision loss }
  3312. if not(temp_pnode^.nodetype in [ordconstn,realconstn]) then
  3313. inserttypeconv(temp_pnode^,pbestrealtype^);
  3314. resultdef:=pbestrealtype^;
  3315. end;
  3316. in_trunc_real,
  3317. in_round_real :
  3318. begin
  3319. { on i8086, the int64 result is returned in a var param, because
  3320. it's too big to fit in a register or a pair of registers. In
  3321. that case we have 2 parameters and left.nodetype is a callparan. }
  3322. if left.nodetype = callparan then
  3323. temp_pnode := @tcallparanode(left).left
  3324. else
  3325. temp_pnode := @left;
  3326. set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
  3327. { for direct float rounding, no best real type cast should be necessary }
  3328. if not((temp_pnode^.resultdef.typ=floatdef) and
  3329. (tfloatdef(temp_pnode^.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and
  3330. { converting an int64 to double on platforms without }
  3331. { extended can cause precision loss }
  3332. not(temp_pnode^.nodetype in [ordconstn,realconstn]) then
  3333. inserttypeconv(temp_pnode^,pbestrealtype^);
  3334. resultdef:=s64inttype;
  3335. end;
  3336. in_pi_real :
  3337. begin
  3338. resultdef:=pbestrealtype^;
  3339. end;
  3340. in_abs_long:
  3341. begin
  3342. set_varstate(left,vs_read,[vsf_must_be_valid]);
  3343. resultdef:=left.resultdef;
  3344. end;
  3345. in_abs_real,
  3346. in_sqr_real,
  3347. in_sqrt_real :
  3348. begin
  3349. { on the Z80, the double result is returned in a var param, because
  3350. it's too big to fit in registers. In that case we have 2 parameters
  3351. and left.nodetype is a callparan. }
  3352. if left.nodetype = callparan then
  3353. temp_pnode := @tcallparanode(left).left
  3354. else
  3355. temp_pnode := @left;
  3356. set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
  3357. setfloatresultdef;
  3358. end;
  3359. {$ifdef SUPPORT_MMX}
  3360. in_mmx_pcmpeqb..in_mmx_pcmpgtw:
  3361. begin
  3362. end;
  3363. {$endif SUPPORT_MMX}
  3364. in_aligned_x,
  3365. in_unaligned_x:
  3366. begin
  3367. resultdef:=left.resultdef;
  3368. end;
  3369. in_volatile_x:
  3370. begin
  3371. resultdef:=left.resultdef;
  3372. { volatile only makes sense if the value is in memory }
  3373. make_not_regable(left,[ra_addr_regable]);
  3374. end;
  3375. in_assert_x_y :
  3376. begin
  3377. resultdef:=voidtype;
  3378. if assigned(left) then
  3379. begin
  3380. set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
  3381. { check type }
  3382. if is_boolean(left.resultdef) or
  3383. (
  3384. (left.resultdef.typ=undefineddef) and
  3385. (df_generic in current_procinfo.procdef.defoptions)
  3386. ) then
  3387. begin
  3388. set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
  3389. { must always be a string }
  3390. inserttypeconv(tcallparanode(tcallparanode(left).right).left,cshortstringtype);
  3391. end
  3392. else
  3393. CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
  3394. end
  3395. else
  3396. CGMessage(type_e_mismatch);
  3397. if (cs_do_assertion in current_settings.localswitches) then
  3398. include(current_procinfo.flags,pi_do_call);
  3399. end;
  3400. in_prefetch_var:
  3401. resultdef:=voidtype;
  3402. in_get_frame,
  3403. in_get_caller_frame,
  3404. in_get_caller_addr:
  3405. begin
  3406. resultdef:=voidpointertype;
  3407. end;
  3408. in_rol_x,
  3409. in_ror_x,
  3410. in_sar_x:
  3411. begin
  3412. set_varstate(left,vs_read,[vsf_must_be_valid]);
  3413. resultdef:=left.resultdef;
  3414. end;
  3415. in_rol_x_y,
  3416. in_ror_x_y,
  3417. in_sar_x_y:
  3418. begin
  3419. set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
  3420. set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
  3421. resultdef:=tcallparanode(tcallparanode(left).right).left.resultdef;
  3422. end;
  3423. in_bsf_x,
  3424. in_bsr_x:
  3425. begin
  3426. set_varstate(left,vs_read,[vsf_must_be_valid]);
  3427. if not is_integer(left.resultdef) then
  3428. CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
  3429. if torddef(left.resultdef).ordtype in [u64bit, s64bit] then
  3430. resultdef:=u64inttype
  3431. else
  3432. resultdef:=u32inttype
  3433. end;
  3434. in_popcnt_x:
  3435. begin
  3436. set_varstate(left,vs_read,[vsf_must_be_valid]);
  3437. if not is_integer(left.resultdef) then
  3438. CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
  3439. resultdef:=left.resultdef;
  3440. end;
  3441. in_objc_selector_x:
  3442. begin
  3443. result:=cobjcselectornode.create(left);
  3444. { reused }
  3445. left:=nil;
  3446. end;
  3447. in_objc_protocol_x:
  3448. begin
  3449. result:=cobjcprotocolnode.create(left);
  3450. { reused }
  3451. left:=nil;
  3452. end;
  3453. in_objc_encode_x:
  3454. begin
  3455. result:=handle_objc_encode;
  3456. end;
  3457. in_default_x:
  3458. begin
  3459. result:=handle_default;
  3460. end;
  3461. in_box_x:
  3462. begin
  3463. result:=handle_box;
  3464. end;
  3465. in_unbox_x_y:
  3466. begin
  3467. result:=handle_unbox;
  3468. end;
  3469. in_fma_single,
  3470. in_fma_double,
  3471. in_fma_extended,
  3472. in_fma_float128:
  3473. begin
  3474. set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
  3475. set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
  3476. set_varstate(tcallparanode(tcallparanode(tcallparanode(left).right).right).left,vs_read,[vsf_must_be_valid]);
  3477. resultdef:=tcallparanode(left).left.resultdef;
  3478. end;
  3479. in_delete_x_y_z:
  3480. begin
  3481. result:=handle_delete;
  3482. end;
  3483. in_insert_x_y_z:
  3484. begin
  3485. result:=handle_insert;
  3486. end;
  3487. in_concat_x:
  3488. begin
  3489. result:=handle_concat;
  3490. end;
  3491. else
  3492. result:=pass_typecheck_cpu;
  3493. end;
  3494. end;
  3495. if not assigned(result) and not
  3496. codegenerror then
  3497. result:=simplify(false);
  3498. end;
  3499. function tinlinenode.pass_typecheck_cpu : tnode;
  3500. begin
  3501. Result:=nil;
  3502. internalerror(2017110102);
  3503. end;
  3504. function tinlinenode.pass_1 : tnode;
  3505. var
  3506. hp: tnode;
  3507. shiftconst: longint;
  3508. objdef: tobjectdef;
  3509. sym : tsym;
  3510. begin
  3511. result:=nil;
  3512. { if we handle writeln; left contains no valid address }
  3513. if assigned(left) then
  3514. begin
  3515. if left.nodetype=callparan then
  3516. tcallparanode(left).firstcallparan
  3517. else
  3518. firstpass(left);
  3519. end;
  3520. { intern const should already be handled }
  3521. if nf_inlineconst in flags then
  3522. internalerror(200104044);
  3523. case inlinenumber of
  3524. in_lo_qword,
  3525. in_hi_qword,
  3526. in_lo_long,
  3527. in_hi_long,
  3528. in_lo_word,
  3529. in_hi_word:
  3530. begin
  3531. shiftconst := 0;
  3532. case inlinenumber of
  3533. in_hi_qword:
  3534. shiftconst := 32;
  3535. in_hi_long:
  3536. shiftconst := 16;
  3537. in_hi_word:
  3538. shiftconst := 8;
  3539. else
  3540. ;
  3541. end;
  3542. if shiftconst <> 0 then
  3543. result := ctypeconvnode.create_internal(cshlshrnode.create(shrn,left,
  3544. cordconstnode.create(shiftconst,sinttype,false)),resultdef)
  3545. else
  3546. result := ctypeconvnode.create_internal(left,resultdef);
  3547. left := nil;
  3548. firstpass(result);
  3549. end;
  3550. in_sizeof_x,
  3551. in_typeof_x:
  3552. begin
  3553. expectloc:=LOC_REGISTER;
  3554. case left.resultdef.typ of
  3555. objectdef,classrefdef:
  3556. begin
  3557. if left.resultdef.typ=objectdef then
  3558. begin
  3559. result:=cloadvmtaddrnode.create(left);
  3560. objdef:=tobjectdef(left.resultdef);
  3561. end
  3562. else
  3563. begin
  3564. result:=left;
  3565. objdef:=tobjectdef(tclassrefdef(left.resultdef).pointeddef);
  3566. end;
  3567. left:=nil;
  3568. if inlinenumber=in_sizeof_x then
  3569. begin
  3570. inserttypeconv_explicit(result,cpointerdef.getreusable(objdef.vmt_def));
  3571. result:=cderefnode.create(result);
  3572. result:=genloadfield(result,'VINSTANCESIZE');
  3573. end
  3574. else
  3575. inserttypeconv_explicit(result,voidpointertype);
  3576. end;
  3577. undefineddef:
  3578. ;
  3579. else
  3580. internalerror(2015122702);
  3581. end;
  3582. end;
  3583. in_length_x:
  3584. begin
  3585. result:=first_length;
  3586. end;
  3587. in_typeinfo_x:
  3588. begin
  3589. result:=caddrnode.create_internal(
  3590. crttinode.create(tstoreddef(left.resultdef),fullrtti,rdt_normal)
  3591. );
  3592. end;
  3593. in_gettypekind_x:
  3594. begin
  3595. sym:=tenumdef(typekindtype).int2enumsym(get_typekind(left.resultdef));
  3596. if not assigned(sym) then
  3597. internalerror(2017081101);
  3598. if sym.typ<>enumsym then
  3599. internalerror(2017081102);
  3600. result:=genenumnode(tenumsym(sym));
  3601. end;
  3602. in_ismanagedtype_x:
  3603. begin
  3604. if left.resultdef.needs_inittable then
  3605. result:=cordconstnode.create(1,resultdef,false)
  3606. else
  3607. result:=cordconstnode.create(0,resultdef,false);
  3608. end;
  3609. in_assigned_x:
  3610. begin
  3611. result:=first_assigned;
  3612. end;
  3613. in_pred_x,
  3614. in_succ_x:
  3615. begin
  3616. expectloc:=LOC_REGISTER;
  3617. { in case of range/overflow checking, use a regular addnode
  3618. because it's too complex to handle correctly otherwise }
  3619. {$ifndef jvm}
  3620. { enums are class instances in the JVM -> always need conversion }
  3621. if (([cs_check_overflow,cs_check_range]*current_settings.localswitches)<>[]) and not(nf_internal in flags) then
  3622. {$endif}
  3623. begin
  3624. { create constant 1 }
  3625. hp:=cordconstnode.create(1,left.resultdef,false);
  3626. typecheckpass(hp);
  3627. if not is_integer(hp.resultdef) then
  3628. inserttypeconv_internal(hp,sinttype);
  3629. { avoid type errors from the addn/subn }
  3630. if not is_integer(left.resultdef) then
  3631. inserttypeconv_internal(left,sinttype);
  3632. { addition/substraction depending on succ/pred }
  3633. if inlinenumber=in_succ_x then
  3634. hp:=caddnode.create(addn,left,hp)
  3635. else
  3636. hp:=caddnode.create(subn,left,hp);
  3637. { the condition above is not tested for jvm, so we need to avoid overflow checks here
  3638. by setting nf_internal for the add/sub node as well }
  3639. if nf_internal in flags then
  3640. include(hp.flags,nf_internal);
  3641. { assign result of addition }
  3642. if not(is_integer(resultdef)) then
  3643. inserttypeconv(hp,corddef.create(
  3644. {$ifdef cpu64bitaddr}
  3645. s64bit,
  3646. {$else cpu64bitaddr}
  3647. s32bit,
  3648. {$endif cpu64bitaddr}
  3649. get_min_value(resultdef),
  3650. get_max_value(resultdef),
  3651. true))
  3652. else
  3653. inserttypeconv(hp,resultdef);
  3654. if nf_internal in flags then
  3655. include(hp.flags,nf_internal);
  3656. { avoid any possible errors/warnings }
  3657. inserttypeconv_internal(hp,resultdef);
  3658. { firstpass it }
  3659. firstpass(hp);
  3660. { left is reused }
  3661. left:=nil;
  3662. { return new node }
  3663. result:=hp;
  3664. end;
  3665. end;
  3666. in_setlength_x:
  3667. result:=first_setlength;
  3668. in_copy_x:
  3669. result:=first_copy;
  3670. in_initialize_x,
  3671. in_finalize_x:
  3672. begin
  3673. expectloc:=LOC_VOID;
  3674. end;
  3675. in_inc_x,
  3676. in_dec_x:
  3677. begin
  3678. result:=first_IncDec;
  3679. end;
  3680. in_and_assign_x_y,
  3681. in_or_assign_x_y,
  3682. in_xor_assign_x_y,
  3683. in_sar_assign_x_y,
  3684. in_shl_assign_x_y,
  3685. in_shr_assign_x_y,
  3686. in_rol_assign_x_y,
  3687. in_ror_assign_x_y:
  3688. begin
  3689. result:=first_AndOrXorShiftRot_assign;
  3690. end;
  3691. in_neg_assign_x,
  3692. in_not_assign_x:
  3693. begin
  3694. result:=first_NegNot_assign;
  3695. end;
  3696. in_include_x_y,
  3697. in_exclude_x_y:
  3698. begin
  3699. result:=first_IncludeExclude;
  3700. end;
  3701. in_pack_x_y_z,
  3702. in_unpack_x_y_z:
  3703. begin
  3704. result:=first_pack_unpack;
  3705. end;
  3706. in_exp_real:
  3707. begin
  3708. result:= first_exp_real;
  3709. end;
  3710. in_round_real:
  3711. begin
  3712. result:= first_round_real;
  3713. end;
  3714. in_trunc_real:
  3715. begin
  3716. result:= first_trunc_real;
  3717. end;
  3718. in_int_real:
  3719. begin
  3720. result:= first_int_real;
  3721. end;
  3722. in_frac_real:
  3723. begin
  3724. result:= first_frac_real;
  3725. end;
  3726. in_cos_real:
  3727. begin
  3728. result:= first_cos_real;
  3729. end;
  3730. in_sin_real:
  3731. begin
  3732. result := first_sin_real;
  3733. end;
  3734. in_arctan_real:
  3735. begin
  3736. result := first_arctan_real;
  3737. end;
  3738. in_pi_real :
  3739. begin
  3740. result := first_pi;
  3741. end;
  3742. in_abs_real:
  3743. begin
  3744. result := first_abs_real;
  3745. end;
  3746. in_abs_long:
  3747. begin
  3748. result := first_abs_long;
  3749. end;
  3750. in_sqr_real:
  3751. begin
  3752. result := first_sqr_real;
  3753. end;
  3754. in_sqrt_real:
  3755. begin
  3756. result := first_sqrt_real;
  3757. end;
  3758. in_ln_real:
  3759. begin
  3760. result := first_ln_real;
  3761. end;
  3762. {$ifdef SUPPORT_MMX}
  3763. in_mmx_pcmpeqb..in_mmx_pcmpgtw:
  3764. begin
  3765. end;
  3766. {$endif SUPPORT_MMX}
  3767. in_assert_x_y :
  3768. begin
  3769. result:=first_assert;
  3770. end;
  3771. in_low_x:
  3772. internalerror(200104047);
  3773. in_high_x:
  3774. begin
  3775. result:=first_high;
  3776. end;
  3777. in_slice_x:
  3778. internalerror(2005101501);
  3779. in_ord_x,
  3780. in_chr_byte:
  3781. begin
  3782. { should not happend as it's converted to typeconv }
  3783. internalerror(200104045);
  3784. end;
  3785. in_ofs_x :
  3786. internalerror(2000101001);
  3787. in_seg_x :
  3788. begin
  3789. result:=first_seg;
  3790. end;
  3791. in_settextbuf_file_x,
  3792. in_reset_typedfile,
  3793. in_rewrite_typedfile,
  3794. in_reset_typedfile_name,
  3795. in_rewrite_typedfile_name,
  3796. in_str_x_string,
  3797. in_val_x,
  3798. in_read_x,
  3799. in_readln_x,
  3800. in_write_x,
  3801. in_writeln_x :
  3802. begin
  3803. { should be handled by pass_typecheck }
  3804. internalerror(200108234);
  3805. end;
  3806. in_get_frame:
  3807. begin
  3808. result:=first_get_frame;
  3809. end;
  3810. in_get_caller_frame:
  3811. begin
  3812. expectloc:=LOC_REGISTER;
  3813. end;
  3814. in_get_caller_addr:
  3815. begin
  3816. expectloc:=LOC_REGISTER;
  3817. end;
  3818. in_prefetch_var:
  3819. begin
  3820. expectloc:=LOC_VOID;
  3821. end;
  3822. in_aligned_x,
  3823. in_unaligned_x,
  3824. in_volatile_x:
  3825. begin
  3826. expectloc:=tcallparanode(left).left.expectloc;
  3827. end;
  3828. in_rol_x,
  3829. in_rol_x_y,
  3830. in_ror_x,
  3831. in_ror_x_y:
  3832. expectloc:=LOC_REGISTER;
  3833. in_bsf_x,
  3834. in_bsr_x:
  3835. result:=first_bitscan;
  3836. in_sar_x,
  3837. in_sar_x_y:
  3838. result:=first_sar;
  3839. in_popcnt_x:
  3840. result:=first_popcnt;
  3841. in_new_x:
  3842. result:=first_new;
  3843. in_box_x:
  3844. result:=first_box;
  3845. in_unbox_x_y:
  3846. result:=first_unbox;
  3847. in_fma_single,
  3848. in_fma_double,
  3849. in_fma_extended,
  3850. in_fma_float128:
  3851. result:=first_fma;
  3852. else
  3853. result:=first_cpu;
  3854. end;
  3855. end;
  3856. {$maxfpuregisters default}
  3857. function tinlinenode.docompare(p: tnode): boolean;
  3858. begin
  3859. docompare :=
  3860. inherited docompare(p) and
  3861. (inlinenumber = tinlinenode(p).inlinenumber);
  3862. end;
  3863. procedure tinlinenode.mark_write;
  3864. begin
  3865. case inlinenumber of
  3866. in_aligned_x, in_unaligned_x:
  3867. tcallparanode(left).left.mark_write;
  3868. else
  3869. inherited mark_write;
  3870. end;
  3871. end;
  3872. function tinlinenode.first_pi : tnode;
  3873. begin
  3874. result:=crealconstnode.create(getpi,pbestrealtype^);
  3875. end;
  3876. function tinlinenode.first_arctan_real : tnode;
  3877. var
  3878. temp_pnode: pnode;
  3879. begin
  3880. { create the call to the helper }
  3881. { on entry left node contains the parameter }
  3882. if left.nodetype = callparan then
  3883. temp_pnode := @tcallparanode(left).left
  3884. else
  3885. temp_pnode := @left;
  3886. result := ccallnode.createintern('fpc_arctan_real',
  3887. ccallparanode.create(temp_pnode^,nil));
  3888. temp_pnode^ := nil;
  3889. end;
  3890. function tinlinenode.first_abs_real : tnode;
  3891. var
  3892. callnode : tcallnode;
  3893. temp_pnode: pnode;
  3894. begin
  3895. { create the call to the helper }
  3896. { on entry left node contains the parameter }
  3897. if left.nodetype = callparan then
  3898. temp_pnode := @tcallparanode(left).left
  3899. else
  3900. temp_pnode := @left;
  3901. callnode:=ccallnode.createintern('fpc_abs_real',
  3902. ccallparanode.create(temp_pnode^,nil));
  3903. result := ctypeconvnode.create(callnode,resultdef);
  3904. include(callnode.callnodeflags,cnf_check_fpu_exceptions);
  3905. temp_pnode^ := nil;
  3906. end;
  3907. function tinlinenode.first_sqr_real : tnode;
  3908. var
  3909. callnode : tcallnode;
  3910. temp_pnode: pnode;
  3911. begin
  3912. {$ifndef cpufpemu}
  3913. { this procedure might be only used for cpus definining cpufpemu else
  3914. the optimizer might go into an endless loop when doing x*x -> changes }
  3915. internalerror(2011092401);
  3916. {$endif cpufpemu}
  3917. { create the call to the helper }
  3918. { on entry left node contains the parameter }
  3919. if left.nodetype = callparan then
  3920. temp_pnode := @tcallparanode(left).left
  3921. else
  3922. temp_pnode := @left;
  3923. callnode:=ccallnode.createintern('fpc_sqr_real',
  3924. ccallparanode.create(temp_pnode^,nil));
  3925. result := ctypeconvnode.create(callnode,resultdef);
  3926. include(callnode.callnodeflags,cnf_check_fpu_exceptions);
  3927. temp_pnode^ := nil;
  3928. end;
  3929. function tinlinenode.first_sqrt_real : tnode;
  3930. var
  3931. fdef: tdef;
  3932. procname: string[31];
  3933. callnode: tcallnode;
  3934. temp_pnode: pnode;
  3935. begin
  3936. if left.nodetype = callparan then
  3937. temp_pnode := @tcallparanode(left).left
  3938. else
  3939. temp_pnode := @left;
  3940. if ((cs_fp_emulation in current_settings.moduleswitches)
  3941. {$ifdef cpufpemu}
  3942. or (current_settings.fputype=fpu_soft)
  3943. {$endif cpufpemu}
  3944. ) and not (target_info.system in systems_wince) then
  3945. begin
  3946. case tfloatdef(temp_pnode^.resultdef).floattype of
  3947. s32real:
  3948. begin
  3949. fdef:=search_system_type('FLOAT32REC').typedef;
  3950. procname:='float32_sqrt';
  3951. end;
  3952. s64real:
  3953. begin
  3954. fdef:=search_system_type('FLOAT64').typedef;
  3955. procname:='float64_sqrt';
  3956. end;
  3957. {!!! not yet implemented
  3958. s128real:
  3959. }
  3960. else
  3961. internalerror(2014052101);
  3962. end;
  3963. result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
  3964. ctypeconvnode.create_internal(temp_pnode^,fdef),nil)),resultdef);
  3965. end
  3966. else
  3967. begin
  3968. { create the call to the helper }
  3969. { on entry left node contains the parameter }
  3970. callnode := ccallnode.createintern('fpc_sqrt_real',
  3971. ccallparanode.create(temp_pnode^,nil));
  3972. result := ctypeconvnode.create(callnode,resultdef);
  3973. include(callnode.callnodeflags,cnf_check_fpu_exceptions);
  3974. end;
  3975. temp_pnode^ := nil;
  3976. end;
  3977. function tinlinenode.first_ln_real : tnode;
  3978. var
  3979. temp_pnode: pnode;
  3980. begin
  3981. { create the call to the helper }
  3982. { on entry left node contains the parameter }
  3983. if left.nodetype = callparan then
  3984. temp_pnode := @tcallparanode(left).left
  3985. else
  3986. temp_pnode := @left;
  3987. result := ccallnode.createintern('fpc_ln_real',
  3988. ccallparanode.create(temp_pnode^,nil));
  3989. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  3990. temp_pnode^ := nil;
  3991. end;
  3992. function tinlinenode.first_cos_real : tnode;
  3993. var
  3994. temp_pnode: pnode;
  3995. begin
  3996. { create the call to the helper }
  3997. { on entry left node contains the parameter }
  3998. if left.nodetype = callparan then
  3999. temp_pnode := @tcallparanode(left).left
  4000. else
  4001. temp_pnode := @left;
  4002. result := ccallnode.createintern('fpc_cos_real',
  4003. ccallparanode.create(temp_pnode^,nil));
  4004. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  4005. temp_pnode^ := nil;
  4006. end;
  4007. function tinlinenode.first_sin_real : tnode;
  4008. var
  4009. temp_pnode: pnode;
  4010. begin
  4011. { create the call to the helper }
  4012. { on entry left node contains the parameter }
  4013. if left.nodetype = callparan then
  4014. temp_pnode := @tcallparanode(left).left
  4015. else
  4016. temp_pnode := @left;
  4017. result := ccallnode.createintern('fpc_sin_real',
  4018. ccallparanode.create(temp_pnode^,nil));
  4019. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  4020. temp_pnode^ := nil;
  4021. end;
  4022. function tinlinenode.first_exp_real : tnode;
  4023. var
  4024. temp_pnode: pnode;
  4025. begin
  4026. { create the call to the helper }
  4027. { on entry left node contains the parameter }
  4028. if left.nodetype = callparan then
  4029. temp_pnode := @tcallparanode(left).left
  4030. else
  4031. temp_pnode := @left;
  4032. result := ccallnode.createintern('fpc_exp_real',ccallparanode.create(temp_pnode^,nil));
  4033. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  4034. temp_pnode^ := nil;
  4035. end;
  4036. function tinlinenode.first_int_real : tnode;
  4037. var
  4038. temp_pnode: pnode;
  4039. begin
  4040. { create the call to the helper }
  4041. { on entry left node contains the parameter }
  4042. if left.nodetype = callparan then
  4043. temp_pnode := @tcallparanode(left).left
  4044. else
  4045. temp_pnode := @left;
  4046. result := ccallnode.createintern('fpc_int_real',ccallparanode.create(temp_pnode^,nil));
  4047. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  4048. temp_pnode^ := nil;
  4049. end;
  4050. function tinlinenode.first_frac_real : tnode;
  4051. var
  4052. temp_pnode: pnode;
  4053. begin
  4054. { create the call to the helper }
  4055. { on entry left node contains the parameter }
  4056. if left.nodetype = callparan then
  4057. temp_pnode := @tcallparanode(left).left
  4058. else
  4059. temp_pnode := @left;
  4060. result := ccallnode.createintern('fpc_frac_real',ccallparanode.create(temp_pnode^,nil));
  4061. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  4062. temp_pnode^ := nil;
  4063. end;
  4064. function tinlinenode.first_round_real : tnode;
  4065. var
  4066. temp_pnode: pnode;
  4067. begin
  4068. { create the call to the helper }
  4069. { on entry left node contains the parameter }
  4070. if left.nodetype = callparan then
  4071. temp_pnode := @tcallparanode(left).left
  4072. else
  4073. temp_pnode := @left;
  4074. result := ccallnode.createintern('fpc_round_real',ccallparanode.create(temp_pnode^,nil));
  4075. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  4076. temp_pnode^ := nil;
  4077. end;
  4078. function tinlinenode.first_trunc_real : tnode;
  4079. var
  4080. temp_pnode: pnode;
  4081. begin
  4082. { create the call to the helper }
  4083. { on entry left node contains the parameter }
  4084. if left.nodetype = callparan then
  4085. temp_pnode := @tcallparanode(left).left
  4086. else
  4087. temp_pnode := @left;
  4088. result := ccallnode.createintern('fpc_trunc_real',ccallparanode.create(temp_pnode^,nil));
  4089. include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
  4090. temp_pnode^ := nil;
  4091. end;
  4092. function tinlinenode.first_abs_long : tnode;
  4093. begin
  4094. expectloc:=LOC_REGISTER;
  4095. result:=nil;
  4096. end;
  4097. function tinlinenode.getaddsub_for_incdec : tnode;
  4098. var
  4099. hp,hpp,resultnode : tnode;
  4100. tempnode: ttempcreatenode;
  4101. newstatement: tstatementnode;
  4102. newblock: tblocknode;
  4103. begin
  4104. newblock := internalstatements(newstatement);
  4105. { extra parameter? }
  4106. if assigned(tcallparanode(left).right) then
  4107. begin
  4108. { Yes, use for add node }
  4109. hpp := tcallparanode(tcallparanode(left).right).left;
  4110. tcallparanode(tcallparanode(left).right).left := nil;
  4111. if assigned(tcallparanode(tcallparanode(left).right).right) then
  4112. CGMessage(parser_e_illegal_expression);
  4113. end
  4114. else
  4115. begin
  4116. { no, create constant 1 }
  4117. hpp := cordconstnode.create(1,tcallparanode(left).left.resultdef,false);
  4118. end;
  4119. typecheckpass(hpp);
  4120. { make sure we don't call functions part of the left node twice (and generally }
  4121. { optimize the code generation) }
  4122. { Storing address is not always an optimization: alignment of left is not known
  4123. at this point, so we must assume the worst and use an unaligned pointer.
  4124. This results in larger and slower code on alignment-sensitive targets.
  4125. Therefore the complexity condition below is questionable, maybe just filtering
  4126. out calls with "= NODE_COMPLEXITY_INF" is sufficient.
  4127. Value of 3 corresponds to subscript nodes, i.e. record field. }
  4128. if node_complexity(tcallparanode(left).left) > 3 then
  4129. begin
  4130. tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
  4131. addstatement(newstatement,tempnode);
  4132. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
  4133. caddrnode.create_internal(tcallparanode(left).left.getcopy)));
  4134. hp := cderefnode.create(ctemprefnode.create(tempnode));
  4135. inserttypeconv_internal(hp,tcallparanode(left).left.resultdef);
  4136. end
  4137. else
  4138. begin
  4139. hp := tcallparanode(left).left.getcopy;
  4140. tempnode := nil;
  4141. end;
  4142. resultnode := hp.getcopy;
  4143. { get varstates right }
  4144. node_reset_flags(resultnode,[nf_pass1_done,nf_modify]);
  4145. { avoid type errors from the addn/subn }
  4146. if not is_integer(resultnode.resultdef) then
  4147. begin
  4148. inserttypeconv_internal(hp,sinttype);
  4149. inserttypeconv_internal(hpp,sinttype);
  4150. end;
  4151. { addition/substraction depending on inc/dec }
  4152. if inlinenumber = in_inc_x then
  4153. hpp := caddnode.create_internal(addn,hp,hpp)
  4154. else
  4155. hpp := caddnode.create_internal(subn,hp,hpp);
  4156. { assign result of addition }
  4157. { inherit internal flag }
  4158. if not(is_integer(resultnode.resultdef)) then
  4159. begin
  4160. if nf_internal in flags then
  4161. inserttypeconv_internal(hpp,corddef.create(
  4162. {$ifdef cpu64bitaddr}
  4163. s64bit,
  4164. {$else cpu64bitaddr}
  4165. s32bit,
  4166. {$endif cpu64bitaddr}
  4167. get_min_value(resultnode.resultdef),
  4168. get_max_value(resultnode.resultdef),
  4169. true))
  4170. else
  4171. inserttypeconv(hpp,corddef.create(
  4172. {$ifdef cpu64bitaddr}
  4173. s64bit,
  4174. {$else cpu64bitaddr}
  4175. s32bit,
  4176. {$endif cpu64bitaddr}
  4177. get_min_value(resultnode.resultdef),
  4178. get_max_value(resultnode.resultdef),
  4179. true))
  4180. end
  4181. else
  4182. begin
  4183. if nf_internal in flags then
  4184. inserttypeconv_internal(hpp,resultnode.resultdef)
  4185. else
  4186. inserttypeconv(hpp,resultnode.resultdef);
  4187. end;
  4188. { avoid any possible warnings }
  4189. inserttypeconv_internal(hpp,resultnode.resultdef);
  4190. { get varstates right }
  4191. node_reset_flags(hpp,[nf_pass1_done,nf_modify,nf_write]);
  4192. do_typecheckpass(hpp);
  4193. addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
  4194. { force pass 1, so copied trees get first pass'ed as well and flags like nf_write, nf_call_unique
  4195. get set right }
  4196. node_reset_flags(newstatement.statement,[nf_pass1_done]);
  4197. { firstpass it }
  4198. firstpass(tnode(newstatement.left));
  4199. { deallocate the temp }
  4200. if assigned(tempnode) then
  4201. addstatement(newstatement,ctempdeletenode.create(tempnode));
  4202. { firstpass it }
  4203. firstpass(tnode(newblock));
  4204. { return new node }
  4205. result := newblock;
  4206. end;
  4207. function tinlinenode.first_IncDec: tnode;
  4208. begin
  4209. expectloc:=LOC_VOID;
  4210. result:=nil;
  4211. { range/overflow checking doesn't work properly }
  4212. { with the inc/dec code that's generated (JM) }
  4213. if ((localswitches * [cs_check_overflow,cs_check_range] <> []) and
  4214. { No overflow check for pointer operations, because inc(pointer,-1) will always
  4215. trigger an overflow. For uint32 it works because then the operation is done
  4216. in 64bit. Range checking is not applicable to pointers either }
  4217. (tcallparanode(left).left.resultdef.typ<>pointerdef))
  4218. {$ifdef jvm}
  4219. { enums are class instances on the JVM -> special treatment }
  4220. or (tcallparanode(left).left.resultdef.typ=enumdef)
  4221. {$endif}
  4222. then
  4223. { convert to simple add (JM) }
  4224. result:=getaddsub_for_incdec
  4225. end;
  4226. function tinlinenode.first_IncludeExclude: tnode;
  4227. begin
  4228. result:=nil;
  4229. expectloc:=LOC_VOID;
  4230. end;
  4231. function tinlinenode.first_get_frame: tnode;
  4232. begin
  4233. include(current_procinfo.flags,pi_needs_stackframe);
  4234. include(current_procinfo.flags,pi_uses_get_frame);
  4235. expectloc:=LOC_CREGISTER;
  4236. result:=nil;
  4237. end;
  4238. function tinlinenode.first_setlength: tnode;
  4239. var
  4240. paras : tnode;
  4241. npara,
  4242. ppn : tcallparanode;
  4243. dims,
  4244. counter : integer;
  4245. isarray : boolean;
  4246. destppn : tnode;
  4247. newstatement : tstatementnode;
  4248. temp : ttempcreatenode;
  4249. newblock : tnode;
  4250. begin
  4251. paras:=left;
  4252. ppn:=tcallparanode(paras);
  4253. dims:=0;
  4254. while assigned(ppn.right) do
  4255. begin
  4256. inc(dims);
  4257. ppn:=tcallparanode(ppn.right);
  4258. end;
  4259. destppn:=ppn.left;
  4260. isarray:=is_dynamic_array(destppn.resultdef);
  4261. { first param must be a string or dynamic array ...}
  4262. if isarray then
  4263. begin
  4264. { create statements with call initialize the arguments and
  4265. call fpc_dynarr_setlength }
  4266. newblock:=internalstatements(newstatement);
  4267. { get temp for array of lengths }
  4268. temp:=ctempcreatenode.create(carraydef.getreusable(sinttype,dims),dims*sinttype.size,tt_persistent,false);
  4269. addstatement(newstatement,temp);
  4270. { load array of lengths }
  4271. ppn:=tcallparanode(paras);
  4272. counter:=dims-1;
  4273. while assigned(ppn.right) do
  4274. begin
  4275. addstatement(newstatement,cassignmentnode.create(
  4276. cvecnode.create(
  4277. ctemprefnode.create(temp),
  4278. genintconstnode(counter)
  4279. ),
  4280. ppn.left));
  4281. ppn.left:=nil;
  4282. dec(counter);
  4283. ppn:=tcallparanode(ppn.right);
  4284. end;
  4285. { destppn is also reused }
  4286. ppn.left:=nil;
  4287. { create call to fpc_dynarr_setlength }
  4288. npara:=ccallparanode.create(caddrnode.create_internal(
  4289. cvecnode.create(
  4290. ctemprefnode.create(temp),
  4291. genintconstnode(0)
  4292. )),
  4293. ccallparanode.create(cordconstnode.create
  4294. (dims,sinttype,true),
  4295. ccallparanode.create(caddrnode.create_internal
  4296. (crttinode.create(tstoreddef(destppn.resultdef),initrtti,rdt_normal)),
  4297. ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil))));
  4298. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara));
  4299. addstatement(newstatement,ctempdeletenode.create(temp));
  4300. end
  4301. else if is_ansistring(destppn.resultdef) then
  4302. begin
  4303. newblock:=ccallnode.createintern(
  4304. 'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',
  4305. ccallparanode.create(
  4306. cordconstnode.create(getparaencoding(destppn.resultdef),u16inttype,true),
  4307. paras
  4308. )
  4309. );
  4310. { we reused the parameters, make sure we don't release them }
  4311. left:=nil;
  4312. end
  4313. else
  4314. begin
  4315. { we can reuse the supplied parameters }
  4316. newblock:=ccallnode.createintern(
  4317. 'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',paras);
  4318. { we reused the parameters, make sure we don't release them }
  4319. left:=nil;
  4320. end;
  4321. result:=newblock;
  4322. end;
  4323. function tinlinenode.first_copy: tnode;
  4324. var
  4325. lowppn,
  4326. highppn,
  4327. npara,
  4328. paras : tnode;
  4329. ppn : tcallparanode;
  4330. paradef : tdef;
  4331. counter : integer;
  4332. begin
  4333. { determine copy function to use based on the first argument,
  4334. also count the number of arguments in this loop }
  4335. counter:=1;
  4336. paras:=left;
  4337. ppn:=tcallparanode(paras);
  4338. while assigned(ppn.right) do
  4339. begin
  4340. inc(counter);
  4341. ppn:=tcallparanode(ppn.right);
  4342. end;
  4343. paradef:=ppn.left.resultdef;
  4344. { fill up third parameter }
  4345. if counter=2 then
  4346. begin
  4347. paras:=ccallparanode.create(cordconstnode.create(torddef(sinttype).high,sinttype,false),paras);
  4348. counter:=3;
  4349. end;
  4350. if is_ansistring(resultdef) then
  4351. { keep the specific kind of ansistringdef as result }
  4352. result:=ccallnode.createinternres('fpc_ansistr_copy',paras,resultdef)
  4353. else if is_widestring(resultdef) then
  4354. result:=ccallnode.createintern('fpc_widestr_copy',paras)
  4355. else if is_unicodestring(resultdef) then
  4356. result:=ccallnode.createintern('fpc_unicodestr_copy',paras)
  4357. { can't check for resultdef = cansichartype, because resultdef=
  4358. cshortstringtype here }
  4359. else if is_char(paradef) then
  4360. result:=ccallnode.createintern('fpc_char_copy',paras)
  4361. else if is_dynamic_array(resultdef) then
  4362. begin
  4363. { create statements with call }
  4364. case counter of
  4365. 1:
  4366. begin
  4367. { copy the whole array using [0..high(sizeint)] range }
  4368. highppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
  4369. lowppn:=cordconstnode.create(0,sinttype,false);
  4370. end;
  4371. 3:
  4372. begin
  4373. highppn:=tcallparanode(paras).left.getcopy;
  4374. lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
  4375. end;
  4376. else
  4377. internalerror(2012100701);
  4378. end;
  4379. { create call to fpc_dynarray_copy }
  4380. npara:=ccallparanode.create(highppn,
  4381. ccallparanode.create(lowppn,
  4382. ccallparanode.create(caddrnode.create_internal
  4383. (crttinode.create(tstoreddef(paradef),initrtti,rdt_normal)),
  4384. ccallparanode.create
  4385. (ctypeconvnode.create_internal(ppn.left,voidpointertype),nil))));
  4386. result:=ccallnode.createinternres('fpc_dynarray_copy',npara,paradef);
  4387. ppn.left:=nil;
  4388. paras.free;
  4389. end
  4390. else
  4391. result:=ccallnode.createintern('fpc_shortstr_copy',paras);
  4392. { parameters are reused }
  4393. left:=nil;
  4394. end;
  4395. function tinlinenode.first_new: tnode;
  4396. var
  4397. newstatement : tstatementnode;
  4398. newblock : tblocknode;
  4399. temp : ttempcreatenode;
  4400. para : tcallparanode;
  4401. begin
  4402. { create statements with call to getmem+initialize }
  4403. newblock:=internalstatements(newstatement);
  4404. { create temp for result }
  4405. temp := ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
  4406. addstatement(newstatement,temp);
  4407. { create call to fpc_getmem }
  4408. para := ccallparanode.create(cordconstnode.create
  4409. (tpointerdef(left.resultdef).pointeddef.size,s32inttype,true),nil);
  4410. addstatement(newstatement,cassignmentnode.create(
  4411. ctemprefnode.create(temp),
  4412. ccallnode.createintern('fpc_getmem',para)));
  4413. { create call to fpc_initialize }
  4414. if is_managed_type(tpointerdef(left.resultdef).pointeddef) then
  4415. begin
  4416. para := ccallparanode.create(caddrnode.create_internal(crttinode.create
  4417. (tstoreddef(tpointerdef(left.resultdef).pointeddef),initrtti,rdt_normal)),
  4418. ccallparanode.create(ctemprefnode.create
  4419. (temp),nil));
  4420. addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
  4421. end;
  4422. { the last statement should return the value as
  4423. location and type, this is done be referencing the
  4424. temp and converting it first from a persistent temp to
  4425. normal temp }
  4426. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  4427. addstatement(newstatement,ctemprefnode.create(temp));
  4428. result:=newblock;
  4429. end;
  4430. function tinlinenode.first_length: tnode;
  4431. begin
  4432. result:=nil;
  4433. if is_shortstring(left.resultdef) then
  4434. expectloc:=left.expectloc
  4435. else
  4436. begin
  4437. { ansi/wide string }
  4438. expectloc:=LOC_REGISTER;
  4439. end;
  4440. end;
  4441. function tinlinenode.first_high: tnode;
  4442. begin
  4443. result:=nil;
  4444. if not(is_dynamic_array(left.resultdef)) then
  4445. Internalerror(2019122802);
  4446. expectloc:=LOC_REGISTER;
  4447. end;
  4448. function tinlinenode.first_assigned: tnode;
  4449. begin
  4450. { Comparison must not call procvars, indicate that with nf_load_procvar flag }
  4451. result:=caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
  4452. include(result.flags,nf_load_procvar);
  4453. tcallparanode(left).left:=nil;
  4454. end;
  4455. function tinlinenode.first_assert: tnode;
  4456. var
  4457. paras: tcallparanode;
  4458. begin
  4459. paras:=tcallparanode(tcallparanode(left).right);
  4460. paras:=ccallparanode.create(cstringconstnode.createstr(current_module.sourcefiles.get_file_name(current_filepos.fileindex)),paras);
  4461. paras:=ccallparanode.create(genintconstnode(fileinfo.line),paras);
  4462. {$ifdef SUPPORT_GET_FRAME}
  4463. paras:=ccallparanode.create(geninlinenode(in_get_frame,false,nil),paras);
  4464. {$else}
  4465. paras:=ccallparanode.create(ccallnode.createinternfromunit('SYSTEM','GET_FRAME',nil),paras);
  4466. {$endif}
  4467. result:=cifnode.create(cnotnode.create(tcallparanode(left).left),
  4468. ccallnode.createintern('fpc_assert',paras),nil);
  4469. include(result.flags,nf_internal);
  4470. tcallparanode(left).left:=nil;
  4471. tcallparanode(left).right:=nil;
  4472. end;
  4473. function tinlinenode.first_popcnt: tnode;
  4474. var
  4475. suffix : string;
  4476. begin
  4477. case torddef(left.resultdef).ordtype of
  4478. u8bit: suffix:='byte';
  4479. u16bit: suffix:='word';
  4480. u32bit: suffix:='dword';
  4481. u64bit: suffix:='qword';
  4482. else
  4483. internalerror(2012082601);
  4484. end;
  4485. result:=ccallnode.createintern('fpc_popcnt_'+suffix,ccallparanode.create(left,nil));
  4486. left:=nil;
  4487. end;
  4488. function tinlinenode.first_bitscan: tnode;
  4489. begin
  4490. result:=nil;
  4491. expectloc:=LOC_REGISTER;
  4492. end;
  4493. function tinlinenode.typecheck_seg: tnode;
  4494. begin
  4495. if target_info.system in systems_managed_vm then
  4496. message(parser_e_feature_unsupported_for_vm);
  4497. set_varstate(left,vs_read,[]);
  4498. result:=cordconstnode.create(0,s32inttype,false);
  4499. end;
  4500. function tinlinenode.first_seg: tnode;
  4501. begin
  4502. internalerror(200104046);
  4503. result:=nil;
  4504. end;
  4505. function tinlinenode.first_sar: tnode;
  4506. begin
  4507. result:=nil;
  4508. expectloc:=LOC_REGISTER;
  4509. {$if not defined(cpu64bitalu) and not defined(cpucg64shiftsupport)}
  4510. if is_64bitint(resultdef) then
  4511. begin
  4512. if (inlinenumber=in_sar_x) then
  4513. left:=ccallparanode.create(cordconstnode.create(1,u8inttype,false),
  4514. ccallparanode.create(left,nil));
  4515. result:=ccallnode.createintern('fpc_sarint64',left);
  4516. left:=nil;
  4517. end;
  4518. {$endif not defined(cpu64bitalu) and not defined(cpucg64shiftsupport)}
  4519. end;
  4520. function tinlinenode.handle_box: tnode;
  4521. begin
  4522. result:=nil;
  4523. if not assigned(left) or
  4524. assigned(tcallparanode(left).right) then
  4525. CGMessage1(parser_e_wrong_parameter_size,'FpcInternalBox');
  4526. resultdef:=class_tobject;
  4527. end;
  4528. function tinlinenode.handle_unbox: tnode;
  4529. begin
  4530. result:=nil;
  4531. if not assigned(left) or
  4532. not assigned(tcallparanode(left).right) or
  4533. assigned(tcallparanode(tcallparanode(left).right).right) then
  4534. CGMessage1(parser_e_wrong_parameter_size,'FpcInternalUnBox');
  4535. if tcallparanode(left).left.nodetype<>typen then
  4536. internalerror(2011071701);
  4537. ttypenode(tcallparanode(left).left).allowed:=true;
  4538. resultdef:=tcallparanode(left).left.resultdef;
  4539. end;
  4540. function tinlinenode.handle_insert: tnode;
  4541. procedure do_error;
  4542. begin
  4543. CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Insert');
  4544. write_system_parameter_lists('fpc_shortstr_insert');
  4545. write_system_parameter_lists('fpc_shortstr_insert_char');
  4546. write_system_parameter_lists('fpc_unicodestr_insert');
  4547. if tf_winlikewidestring in target_info.flags then
  4548. write_system_parameter_lists('fpc_widestr_insert');
  4549. write_system_parameter_lists('fpc_ansistr_insert');
  4550. MessagePos1(fileinfo,sym_e_param_list,'Insert(Dynamic Array;var Dynamic Array;'+sinttype.typename+');');
  4551. MessagePos1(fileinfo,sym_e_param_list,'Insert(Element;var Dynamic Array;'+sinttype.typename+');');
  4552. end;
  4553. var
  4554. procname : String;
  4555. newn,
  4556. datan,
  4557. datacountn,
  4558. firstn,
  4559. secondn : tnode;
  4560. first,
  4561. second : tdef;
  4562. isconstr,
  4563. iscomparray,
  4564. iscompelem : boolean;
  4565. datatemp : ttempcreatenode;
  4566. insertblock : tblocknode;
  4567. insertstatement : tstatementnode;
  4568. begin
  4569. if not assigned(left) or
  4570. not assigned(tcallparanode(left).right) or
  4571. not assigned(tcallparanode(tcallparanode(left).right).right) or
  4572. assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
  4573. begin
  4574. do_error;
  4575. exit(cerrornode.create);
  4576. end;
  4577. { determine the correct function based on the second parameter }
  4578. firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
  4579. first:=firstn.resultdef;
  4580. secondn:=tcallparanode(tcallparanode(left).right).left;
  4581. second:=secondn.resultdef;
  4582. if is_shortstring(second) then
  4583. begin
  4584. if is_char(first) then
  4585. procname:='fpc_shortstr_insert_char'
  4586. else
  4587. procname:='fpc_shortstr_insert';
  4588. end
  4589. else if is_unicodestring(second) then
  4590. procname:='fpc_unicodestr_insert'
  4591. else if is_widestring(second) then
  4592. procname:='fpc_widestr_insert'
  4593. else if is_ansistring(second) then
  4594. procname:='fpc_ansistr_insert'
  4595. else if is_dynamic_array(second) then
  4596. begin
  4597. { The first parameter needs to be
  4598. a) a dynamic array of the same type
  4599. b) a single element of the same type
  4600. c) a static array of the same type (not Delphi compatible)
  4601. }
  4602. isconstr:=is_array_constructor(first);
  4603. iscomparray:=(first.typ=arraydef) and equal_defs(tarraydef(first).elementdef,tarraydef(second).elementdef);
  4604. iscompelem:=compare_defs(first,tarraydef(second).elementdef,niln)<>te_incompatible;
  4605. if not iscomparray
  4606. and not iscompelem
  4607. and not isconstr then
  4608. begin
  4609. CGMessagePos(fileinfo,type_e_array_required);
  4610. exit(cerrornode.create);
  4611. end;
  4612. insertblock:=internalstatements(insertstatement);
  4613. datatemp:=nil;
  4614. if iscomparray then
  4615. begin
  4616. datatemp:=ctempcreatenode.create_value(first,first.size,tt_normal,false,firstn);
  4617. addstatement(insertstatement,datatemp);
  4618. if is_dynamic_array(first) then
  4619. datan:=ctypeconvnode.create_internal(ctemprefnode.create(datatemp),voidpointertype)
  4620. else
  4621. datan:=caddrnode.create_internal(cvecnode.create(ctemprefnode.create(datatemp),cordconstnode.create(0,sizesinttype,false)));
  4622. datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
  4623. end
  4624. else if isconstr then
  4625. begin
  4626. inserttypeconv(firstn,second);
  4627. datatemp:=ctempcreatenode.create_value(second,second.size,tt_normal,false,firstn);
  4628. addstatement(insertstatement,datatemp);
  4629. datan:=ctypeconvnode.create_internal(ctemprefnode.create(datatemp),voidpointertype);
  4630. datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
  4631. end
  4632. else
  4633. begin
  4634. if is_const(firstn) then
  4635. begin
  4636. datatemp:=ctempcreatenode.create_value(tarraydef(second).elementdef,tarraydef(second).elementdef.size,tt_normal,false,firstn);
  4637. addstatement(insertstatement,datatemp);
  4638. datan:=caddrnode.create_internal(ctemprefnode.create(datatemp));
  4639. end
  4640. else
  4641. datan:=caddrnode.create_internal(ctypeconvnode.create_internal(firstn,tarraydef(second).elementdef));
  4642. datacountn:=cordconstnode.create(1,sizesinttype,false);
  4643. end;
  4644. procname:='fpc_dynarray_insert';
  4645. { recreate the parameters as array pointer, source, data, count, typeinfo }
  4646. newn:=ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(second),initrtti,rdt_normal)),
  4647. ccallparanode.create(datacountn,
  4648. ccallparanode.create(datan,
  4649. ccallparanode.create(tcallparanode(left).left,
  4650. ccallparanode.create(ctypeconvnode.create_internal(secondn,voidpointertype),nil)))));
  4651. addstatement(insertstatement,ccallnode.createintern(procname,newn));
  4652. if assigned(datatemp) then
  4653. addstatement(insertstatement,ctempdeletenode.create(datatemp));
  4654. tcallparanode(tcallparanode(tcallparanode(left).right).right).left:=nil; // insert idx
  4655. tcallparanode(tcallparanode(left).right).left:=nil; // dyn array
  4656. tcallparanode(left).left:=nil; // insert element/array
  4657. left.free;
  4658. left:=nil;
  4659. result:=insertblock;
  4660. exit; { ! }
  4661. end
  4662. else if second.typ=undefineddef then
  4663. { just pick one }
  4664. procname:='fpc_ansistr_insert'
  4665. else
  4666. begin
  4667. do_error;
  4668. exit(cerrornode.create);
  4669. end;
  4670. result:=ccallnode.createintern(procname,left);
  4671. left:=nil;
  4672. end;
  4673. function tinlinenode.handle_delete: tnode;
  4674. procedure do_error;
  4675. begin
  4676. CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Delete');
  4677. write_system_parameter_lists('fpc_shortstr_delete');
  4678. write_system_parameter_lists('fpc_unicodestr_delete');
  4679. if tf_winlikewidestring in target_info.flags then
  4680. write_system_parameter_lists('fpc_widestr_delete');
  4681. write_system_parameter_lists('fpc_ansistr_delete');
  4682. MessagePos1(fileinfo,sym_e_param_list,'Delete(var Dynamic Array;'+sinttype.typename+';'+sinttype.typename+');');
  4683. end;
  4684. var
  4685. procname : String;
  4686. first : tdef;
  4687. firstn,
  4688. newn : tnode;
  4689. begin
  4690. if not assigned(left) or
  4691. not assigned(tcallparanode(left).right) or
  4692. not assigned(tcallparanode(tcallparanode(left).right).right) or
  4693. assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
  4694. begin
  4695. do_error;
  4696. exit(cerrornode.create);
  4697. end;
  4698. { determine the correct function based on the first parameter }
  4699. firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
  4700. first:=firstn.resultdef;
  4701. if is_shortstring(first) then
  4702. procname:='fpc_shortstr_delete'
  4703. else if is_unicodestring(first) then
  4704. procname:='fpc_unicodestr_delete'
  4705. else if is_widestring(first) then
  4706. procname:='fpc_widestr_delete'
  4707. else if is_ansistring(first) then
  4708. procname:='fpc_ansistr_delete'
  4709. else if is_dynamic_array(first) then
  4710. begin
  4711. procname:='fpc_dynarray_delete';
  4712. { recreate the parameters as array pointer, src, count, typeinfo }
  4713. newn:=ccallparanode.create(caddrnode.create_internal
  4714. (crttinode.create(tstoreddef(first),initrtti,rdt_normal)),
  4715. ccallparanode.create(tcallparanode(left).left,
  4716. ccallparanode.create(tcallparanode(tcallparanode(left).right).left,
  4717. ccallparanode.create(ctypeconvnode.create_internal(firstn,voidpointertype),nil))));
  4718. tcallparanode(tcallparanode(tcallparanode(left).right).right).left:=nil;
  4719. tcallparanode(tcallparanode(left).right).left:=nil;
  4720. tcallparanode(left).left:=nil;
  4721. left.free;
  4722. left:=newn;
  4723. end
  4724. else if first.typ=undefineddef then
  4725. { just pick one }
  4726. procname:='fpc_ansistr_delete'
  4727. else
  4728. begin
  4729. do_error;
  4730. exit(cerrornode.create);
  4731. end;
  4732. result:=ccallnode.createintern(procname,left);
  4733. left:=nil;
  4734. end;
  4735. function tinlinenode.handle_concat:tnode;
  4736. procedure do_error;
  4737. begin
  4738. CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Concat');
  4739. MessagePos1(fileinfo,sym_e_param_list,'Concat(String[;String;...])');
  4740. MessagePos1(fileinfo,sym_e_param_list,'Concat(Dynamic Array[;Dynamic Array;...])');
  4741. end;
  4742. var
  4743. cpn : tcallparanode;
  4744. list : tfpobjectlist;
  4745. n,
  4746. arrn,
  4747. firstn : tnode;
  4748. i : longint;
  4749. arrconstr : tarrayconstructornode;
  4750. newstatement : tstatementnode;
  4751. tempnode : ttempcreatenode;
  4752. lastchanged : boolean;
  4753. begin
  4754. if not assigned(left) then
  4755. begin
  4756. do_error;
  4757. exit(cerrornode.create);
  4758. end;
  4759. result:=nil;
  4760. { the arguments are right to left, but we need to work on them from
  4761. left to right, so insert them in a list and process that from back
  4762. to front }
  4763. list:=tfpobjectlist.create(false);
  4764. { remember the last (aka first) dynamic array parameter (important
  4765. in case of array constructors) }
  4766. arrn:=nil;
  4767. cpn:=tcallparanode(left);
  4768. while assigned(cpn) do
  4769. begin
  4770. list.add(cpn.left);
  4771. if is_dynamic_array(cpn.left.resultdef) then
  4772. arrn:=cpn.left;
  4773. cpn.left:=nil;
  4774. cpn:=tcallparanode(cpn.right);
  4775. end;
  4776. if list.count=0 then
  4777. internalerror(2017100901);
  4778. firstn:=tnode(list.last);
  4779. if not assigned(firstn) then
  4780. internalerror(2017100902);
  4781. { are we dealing with strings or dynamic arrays? }
  4782. if is_dynamic_array(firstn.resultdef) or is_array_constructor(firstn.resultdef) then
  4783. begin
  4784. { try to combine all consecutive array constructors }
  4785. lastchanged:=false;
  4786. i:=0;
  4787. repeat
  4788. if lastchanged or is_array_constructor(tnode(list[i]).resultdef) then
  4789. begin
  4790. if (i<list.count-1) and is_array_constructor(tnode(list[i+1]).resultdef) then
  4791. begin
  4792. arrconstr:=tarrayconstructornode(list[i+1]);
  4793. while assigned(arrconstr.right) do
  4794. arrconstr:=tarrayconstructornode(arrconstr.right);
  4795. arrconstr.right:=tnode(list[i]);
  4796. list[i]:=list[i+1];
  4797. list.delete(i+1);
  4798. lastchanged:=true;
  4799. tnode(list[i]).resultdef:=nil;
  4800. { don't increase index! }
  4801. continue;
  4802. end;
  4803. if lastchanged then
  4804. begin
  4805. { we concatted all consecutive ones, so typecheck the new one again }
  4806. n:=tnode(list[i]);
  4807. typecheckpass(n);
  4808. list[i]:=n;
  4809. end;
  4810. lastchanged:=false;
  4811. end;
  4812. inc(i);
  4813. until i=list.count;
  4814. if list.count=1 then
  4815. begin
  4816. { no need to call the concat helper }
  4817. result:=firstn;
  4818. end
  4819. else
  4820. begin
  4821. { if we reach this point then the concat list didn't consist
  4822. solely of array constructors }
  4823. if not assigned(arrn) then
  4824. internalerror(2017101001);
  4825. result:=internalstatements(newstatement);
  4826. { generate the open array constructor for the source arrays
  4827. note: the order needs to be swapped again here! }
  4828. arrconstr:=nil;
  4829. for i:=0 to list.count-1 do
  4830. begin
  4831. n:=tnode(list[i]);
  4832. { first convert to the target type }
  4833. if not is_array_constructor(n.resultdef) then
  4834. inserttypeconv(n,arrn.resultdef);
  4835. { we need to ensure that we get a reference counted
  4836. assignement for the temp array }
  4837. tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
  4838. addstatement(newstatement,tempnode);
  4839. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),n));
  4840. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  4841. n:=ctemprefnode.create(tempnode);
  4842. { then to a plain pointer for the helper }
  4843. inserttypeconv_internal(n,voidpointertype);
  4844. arrconstr:=carrayconstructornode.create(n,arrconstr);
  4845. end;
  4846. arrconstr.allow_array_constructor:=true;
  4847. { based on the code from nopt.genmultistringadd() }
  4848. tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
  4849. addstatement(newstatement,tempnode);
  4850. { initialize the temp, since it will be passed to a
  4851. var-parameter (and finalization, which is performed by the
  4852. ttempcreate node and which takes care of the initialization
  4853. on native targets, is a noop on managed VM targets) }
  4854. if (target_info.system in systems_managed_vm) and
  4855. is_managed_type(arrn.resultdef) then
  4856. addstatement(newstatement,cinlinenode.create(in_setlength_x,
  4857. false,
  4858. ccallparanode.create(genintconstnode(0),
  4859. ccallparanode.create(ctemprefnode.create(tempnode),nil))));
  4860. cpn:=ccallparanode.create(
  4861. arrconstr,
  4862. ccallparanode.create(
  4863. caddrnode.create_internal(crttinode.create(tstoreddef(arrn.resultdef),initrtti,rdt_normal)),
  4864. ccallparanode.create(ctypeconvnode.create_internal(ctemprefnode.create(tempnode),voidpointertype),nil))
  4865. );
  4866. addstatement(
  4867. newstatement,
  4868. ccallnode.createintern(
  4869. 'fpc_dynarray_concat_multi',
  4870. cpn
  4871. )
  4872. );
  4873. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  4874. addstatement(newstatement,ctemprefnode.create(tempnode));
  4875. end;
  4876. end
  4877. else
  4878. begin
  4879. { enforce strings }
  4880. for i:=list.count-1 downto 0 do
  4881. begin
  4882. if assigned(result) then
  4883. result:=caddnode.create(addn,result,tnode(list[i]))
  4884. else
  4885. begin
  4886. result:=tnode(list[i]);
  4887. { Force string type if it isn't yet }
  4888. if not(
  4889. (result.resultdef.typ=stringdef) or
  4890. is_chararray(result.resultdef) or
  4891. is_char(result.resultdef)
  4892. ) then
  4893. inserttypeconv(result,cshortstringtype);
  4894. end;
  4895. end;
  4896. end;
  4897. list.free;
  4898. end;
  4899. function tinlinenode.first_pack_unpack: tnode;
  4900. var
  4901. loopstatement : tstatementnode;
  4902. loop : tblocknode;
  4903. loopvar : ttempcreatenode;
  4904. tempnode,
  4905. source,
  4906. target,
  4907. index,
  4908. unpackednode,
  4909. packednode,
  4910. sourcevecindex,
  4911. targetvecindex,
  4912. loopbody : tnode;
  4913. temprangedef : tdef;
  4914. ulorange,
  4915. uhirange,
  4916. plorange,
  4917. phirange : TConstExprInt;
  4918. begin
  4919. { transform into a for loop which assigns the data of the (un)packed }
  4920. { array to the other one }
  4921. source := left;
  4922. if (inlinenumber = in_unpack_x_y_z) then
  4923. begin
  4924. target := tcallparanode(source).right;
  4925. index := tcallparanode(target).right;
  4926. packednode := tcallparanode(source).left;
  4927. unpackednode := tcallparanode(target).left;
  4928. end
  4929. else
  4930. begin
  4931. index := tcallparanode(source).right;
  4932. target := tcallparanode(index).right;
  4933. packednode := tcallparanode(target).left;
  4934. unpackednode := tcallparanode(source).left;
  4935. end;
  4936. source := tcallparanode(source).left;
  4937. target := tcallparanode(target).left;
  4938. index := tcallparanode(index).left;
  4939. loop := internalstatements(loopstatement);
  4940. loopvar := ctempcreatenode.create(
  4941. tarraydef(packednode.resultdef).rangedef,
  4942. tarraydef(packednode.resultdef).rangedef.size,
  4943. tt_persistent,true);
  4944. addstatement(loopstatement,loopvar);
  4945. { For range checking: we have to convert to an integer type (in case the index type }
  4946. { is an enum), add the index and loop variable together, convert the result }
  4947. { implicitly to an orddef with range equal to the rangedef to get range checking }
  4948. { and finally convert it explicitly back to the actual rangedef to avoid type }
  4949. { errors }
  4950. temprangedef:=nil;
  4951. getrange(unpackednode.resultdef,ulorange,uhirange);
  4952. getrange(packednode.resultdef,plorange,phirange);
  4953. { does not really need to be registered, but then we would have to
  4954. record it elsewhere so it still can be freed }
  4955. temprangedef:=corddef.create(torddef(sinttype).ordtype,ulorange,uhirange,true);
  4956. sourcevecindex := ctemprefnode.create(loopvar);
  4957. targetvecindex := ctypeconvnode.create_internal(index.getcopy,sinttype);
  4958. targetvecindex := caddnode.create(subn,targetvecindex,cordconstnode.create(plorange,sinttype,true));
  4959. targetvecindex := caddnode.create(addn,targetvecindex,ctemprefnode.create(loopvar));
  4960. targetvecindex := ctypeconvnode.create(targetvecindex,temprangedef);
  4961. targetvecindex := ctypeconvnode.create_explicit(targetvecindex,tarraydef(unpackednode.resultdef).rangedef);
  4962. if (inlinenumber = in_pack_x_y_z) then
  4963. begin
  4964. { swap source and target vec indices }
  4965. tempnode := sourcevecindex;
  4966. sourcevecindex := targetvecindex;
  4967. targetvecindex := tempnode;
  4968. end;
  4969. { create the assignment in the loop body }
  4970. loopbody :=
  4971. cassignmentnode.create(
  4972. cvecnode.create(target.getcopy,targetvecindex),
  4973. cvecnode.create(source.getcopy,sourcevecindex)
  4974. );
  4975. { create the actual for loop }
  4976. tempnode := cfornode.create(
  4977. ctemprefnode.create(loopvar),
  4978. cinlinenode.create(in_low_x,false,packednode.getcopy),
  4979. cinlinenode.create(in_high_x,false,packednode.getcopy),
  4980. loopbody,
  4981. false);
  4982. addstatement(loopstatement,tempnode);
  4983. { free the loop counter }
  4984. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  4985. result := loop;
  4986. end;
  4987. function tinlinenode.may_have_sideeffect_norecurse: boolean;
  4988. begin
  4989. result:=
  4990. (inlinenumber in [in_write_x,in_writeln_x,in_read_x,in_readln_x,in_str_x_string,
  4991. in_val_x,in_reset_x,in_rewrite_x,in_reset_typedfile,in_rewrite_typedfile,
  4992. in_reset_typedfile_name,in_rewrite_typedfile_name,in_settextbuf_file_x,
  4993. in_inc_x,in_dec_x,in_include_x_y,in_exclude_x_y,in_break,in_continue,in_setlength_x,
  4994. in_finalize_x,in_new_x,in_dispose_x,in_exit,in_copy_x,in_initialize_x,in_leave,in_cycle,
  4995. in_and_assign_x_y,in_or_assign_x_y,in_xor_assign_x_y,in_sar_assign_x_y,in_shl_assign_x_y,
  4996. in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y,in_neg_assign_x,in_not_assign_x]) or
  4997. ((inlinenumber = in_assert_x_y) and
  4998. (cs_do_assertion in localswitches));
  4999. end;
  5000. function tinlinenode.first_fma: tnode;
  5001. begin
  5002. CGMessage1(cg_e_function_not_support_by_selected_instruction_set,'FMA');
  5003. result:=nil;
  5004. end;
  5005. //
  5006. //||||||| .merge-left.r31134
  5007. //
  5008. //{$ifdef ARM}
  5009. // {$i armtype.inc}
  5010. //{$endif ARM}
  5011. //=======
  5012. //
  5013. //{$ifdef x86}
  5014. // {$i x86type.inc}
  5015. //{$endif x86}
  5016. //{$ifdef ARM}
  5017. // {$i armtype.inc}
  5018. //{$endif ARM}
  5019. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  5020. function tinlinenode.first_ShiftRot_assign_64bitint: tnode;
  5021. var
  5022. procname: string[31];
  5023. begin
  5024. {$ifdef cpucg64shiftsupport}
  5025. if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y] then
  5026. begin
  5027. result:=nil;
  5028. expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
  5029. exit;
  5030. end;
  5031. {$endif cpucg64shiftsupport}
  5032. result := nil;
  5033. if is_signed(tcallparanode(left).right.resultdef) then
  5034. procname:='int64'
  5035. else
  5036. procname:='qword';
  5037. case inlinenumber of
  5038. in_sar_assign_x_y:
  5039. procname := 'fpc_sar_assign_'+procname;
  5040. in_shl_assign_x_y:
  5041. procname := 'fpc_shl_assign_'+procname;
  5042. in_shr_assign_x_y:
  5043. procname := 'fpc_shr_assign_'+procname;
  5044. in_rol_assign_x_y:
  5045. procname := 'fpc_rol_assign_'+procname;
  5046. in_ror_assign_x_y:
  5047. procname := 'fpc_ror_assign_'+procname;
  5048. else
  5049. internalerror(2017041301);
  5050. end;
  5051. result := ccallnode.createintern(procname,ccallparanode.create(tcallparanode(left).left,
  5052. ccallparanode.create(tcallparanode(tcallparanode(left).right).left,nil)));
  5053. tcallparanode(tcallparanode(left).right).left := nil;
  5054. tcallparanode(left).left := nil;
  5055. firstpass(result);
  5056. end;
  5057. {$endif not cpu64bitalu and nto cpuhighleveltarget}
  5058. function tinlinenode.first_AndOrXorShiftRot_assign: tnode;
  5059. begin
  5060. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  5061. { 64 bit ints have their own shift handling }
  5062. if is_64bit(tcallparanode(left).right.resultdef) and
  5063. (inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y]) then
  5064. result := first_ShiftRot_assign_64bitint
  5065. else
  5066. {$endif not cpu64bitalu and not cpuhighleveltarget}
  5067. begin
  5068. result:=nil;
  5069. expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
  5070. end;
  5071. end;
  5072. function tinlinenode.first_NegNot_assign: tnode;
  5073. begin
  5074. result:=nil;
  5075. expectloc:=left.expectloc;
  5076. end;
  5077. function tinlinenode.first_cpu : tnode;
  5078. begin
  5079. Result:=nil;
  5080. internalerror(2017110101);
  5081. end;
  5082. procedure tinlinenode.CheckParameters(count: integer);
  5083. var
  5084. p: tnode;
  5085. begin
  5086. if count=1 then
  5087. begin
  5088. // Sometimes there are more callparanodes
  5089. if left is tcallparanode then
  5090. set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid])
  5091. else
  5092. set_varstate(left,vs_read,[vsf_must_be_valid])
  5093. end
  5094. else
  5095. begin
  5096. p:=left;
  5097. while count>0 do
  5098. begin
  5099. set_varstate(tcallparanode(p).left,vs_read,[vsf_must_be_valid]);
  5100. p:=tcallparanode(p).right;
  5101. dec(count);
  5102. end;
  5103. end;
  5104. end;
  5105. end.