1
0

c_compile.g 153 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114
  1. # This file is part of asmc, a bootstrapping OS with minimal seed
  2. # Copyright (C) 2018-2019 Giovanni Mascellani <gio@debian.org>
  3. # https://gitlab.com/giomasce/asmc
  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 3 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, see <https://www.gnu.org/licenses/>.
  14. ifun cctx_emit 2
  15. fun escape_char 2 {
  16. $from
  17. $to
  18. $ctx
  19. @from 2 param = ;
  20. @to 1 param = ;
  21. @ctx 0 param = ;
  22. $emit
  23. @emit to 0 == = ;
  24. $discard
  25. @discard to 1 == = ;
  26. $data
  27. @data 0 = ;
  28. $data_ptr
  29. @data_ptr @data = ;
  30. if emit discard || {
  31. @to @data_ptr = ;
  32. }
  33. from ** **c 0 != "escape_char: unexpected null" assert_msg ;
  34. if from ** **c '\\' == {
  35. from from ** 1 + = ;
  36. $c
  37. @c from ** **c = ;
  38. c 0 != "escape_char: unexpected null" assert_msg ;
  39. $processed
  40. @processed 0 = ;
  41. if c 'n' == {
  42. to ** '\n' =c ;
  43. @processed 1 = ;
  44. }
  45. if c 'r' == {
  46. to ** '\r' =c ;
  47. @processed 1 = ;
  48. }
  49. if c 't' == {
  50. to ** '\t' =c ;
  51. @processed 1 = ;
  52. }
  53. if c 'v' == {
  54. to ** '\v' =c ;
  55. @processed 1 = ;
  56. }
  57. if c 'f' == {
  58. to ** '\f' =c ;
  59. @processed 1 = ;
  60. }
  61. if c 'a' == {
  62. to ** 0x07 =c ;
  63. @processed 1 = ;
  64. }
  65. if c 'b' == {
  66. to ** 0x08 =c ;
  67. @processed 1 = ;
  68. }
  69. if c '\\' == {
  70. to ** '\\' =c ;
  71. @processed 1 = ;
  72. }
  73. if c '\'' == {
  74. to ** '\'' =c ;
  75. @processed 1 = ;
  76. }
  77. if c '\"' == {
  78. to ** '\"' =c ;
  79. @processed 1 = ;
  80. }
  81. if '0' c <= c '7' <= && {
  82. # An octal escape sequence
  83. $value
  84. @value c '0' - = ;
  85. @c from ** 1 + **c = ;
  86. if '0' c <= c '7' <= && {
  87. from from ** 1 + = ;
  88. @value value 8 * c '0' - + = ;
  89. @c from ** 1 + **c = ;
  90. if '0' c <= c '7' <= && {
  91. from from ** 1 + = ;
  92. @value value 8 * c '0' - + = ;
  93. }
  94. }
  95. to ** value =c ;
  96. @processed 1 = ;
  97. }
  98. processed "escape_char: unknown escape sequence" from ** assert_msg_str ;
  99. from from ** 1 + = ;
  100. to to ** 1 + = ;
  101. } else {
  102. to ** from ** **c =c ;
  103. from from ** 1 + = ;
  104. to to ** 1 + = ;
  105. }
  106. if emit {
  107. data_ptr @data 1 + == "escape_char: error 1" assert_msg ;
  108. ctx data cctx_emit ;
  109. }
  110. }
  111. const TYPE_KIND_BASE 0
  112. const TYPE_KIND_POINTER 1
  113. const TYPE_KIND_FUNCTION 2
  114. const TYPE_KIND_ARRAY 3
  115. const TYPE_KIND_STRUCT 4
  116. const TYPE_KIND_UNION 5
  117. const TYPE_KIND_ENUM 6
  118. const TYPE_KIND 0
  119. const TYPE_BASE 4
  120. const TYPE_SIZE 8
  121. const TYPE_LENGTH 12
  122. const TYPE_ARGS 16
  123. const TYPE_ELLIPSIS 20
  124. const TYPE_FIELDS_OFFS 24
  125. const TYPE_FIELDS_TYPE_IDXS 28
  126. const TYPE_FIELDS_NAMES 32
  127. const SIZEOF_TYPE 36
  128. fun type_init 0 {
  129. $type
  130. @type SIZEOF_TYPE malloc = ;
  131. type TYPE_ARGS take_addr 4 vector_init = ;
  132. type TYPE_FIELDS_OFFS take_addr 4 vector_init = ;
  133. type TYPE_FIELDS_TYPE_IDXS take_addr 4 vector_init = ;
  134. type TYPE_FIELDS_NAMES take_addr 4 vector_init = ;
  135. type ret ;
  136. }
  137. fun type_destroy 1 {
  138. $type
  139. @type 0 param = ;
  140. type TYPE_ARGS take vector_destroy ;
  141. type TYPE_FIELDS_OFFS take vector_destroy ;
  142. type TYPE_FIELDS_TYPE_IDXS take vector_destroy ;
  143. type TYPE_FIELDS_NAMES take free_vect_of_ptrs ;
  144. type free ;
  145. }
  146. fun type_dump 1 {
  147. $type
  148. @type 0 param = ;
  149. $kind
  150. @kind type TYPE_KIND take = ;
  151. $base
  152. @base type TYPE_BASE take = ;
  153. if kind TYPE_KIND_BASE == {
  154. "Base type #" log ;
  155. base itoa log ;
  156. }
  157. if kind TYPE_KIND_POINTER == {
  158. "Pointer type to #" log ;
  159. base itoa log ;
  160. }
  161. if kind TYPE_KIND_FUNCTION == {
  162. "Function type returning #" log ;
  163. base itoa log ;
  164. $args
  165. @args type TYPE_ARGS take = ;
  166. $ellipsis
  167. @ellipsis type TYPE_ELLIPSIS take = ;
  168. if args vector_size 0 == ellipsis ! && {
  169. " taking no argument" log ;
  170. } else {
  171. " taking arguments" log ;
  172. $i
  173. @i 0 = ;
  174. while i args vector_size < {
  175. " #" log ;
  176. args i vector_at itoa log ;
  177. @i i 1 + = ;
  178. }
  179. if ellipsis {
  180. " ..." log ;
  181. }
  182. }
  183. }
  184. if kind TYPE_KIND_ARRAY == {
  185. "Array type of #" log ;
  186. base itoa log ;
  187. $length
  188. @length type TYPE_LENGTH take = ;
  189. if length 0xffffffff == {
  190. " of unspecified length" log ;
  191. } else {
  192. " of length " log ;
  193. length itoa log ;
  194. }
  195. }
  196. if kind TYPE_KIND_STRUCT == {
  197. "Struct type with fields" log ;
  198. $i
  199. @i 0 = ;
  200. $names
  201. $type_idxs
  202. $offs
  203. @names type TYPE_FIELDS_NAMES take = ;
  204. @type_idxs type TYPE_FIELDS_TYPE_IDXS take = ;
  205. @offs type TYPE_FIELDS_OFFS take = ;
  206. while i names vector_size < {
  207. " " log ;
  208. $name
  209. @name names i vector_at = ;
  210. if name **c '\0' == {
  211. @name "<anonymous>" = ;
  212. }
  213. name log ;
  214. " (@" log ;
  215. offs i vector_at itoa log ;
  216. " #" log ;
  217. type_idxs i vector_at itoa log ;
  218. ")" log ;
  219. @i i 1 + = ;
  220. }
  221. }
  222. if kind TYPE_KIND_UNION == {
  223. "Union type with fields" log ;
  224. $i
  225. @i 0 = ;
  226. $names
  227. $type_idxs
  228. $offs
  229. @names type TYPE_FIELDS_NAMES take = ;
  230. @type_idxs type TYPE_FIELDS_TYPE_IDXS take = ;
  231. @offs type TYPE_FIELDS_OFFS take = ;
  232. while i names vector_size < {
  233. " " log ;
  234. $name
  235. @name names i vector_at = ;
  236. if name **c '\0' == {
  237. @name "<anonymous>" = ;
  238. }
  239. name log ;
  240. " (@" log ;
  241. offs i vector_at itoa log ;
  242. " #" log ;
  243. type_idxs i vector_at itoa log ;
  244. ")" log ;
  245. @i i 1 + = ;
  246. }
  247. }
  248. $size
  249. @size type TYPE_SIZE take = ;
  250. if size 0xffffffff == {
  251. ", of undertermined size" log ;
  252. } else {
  253. ", of size " log ;
  254. size itoa log ;
  255. }
  256. }
  257. fun type_get_idx 2 {
  258. $type
  259. $name
  260. @type 1 param = ;
  261. @name 0 param = ;
  262. type TYPE_KIND take TYPE_KIND_STRUCT == type TYPE_KIND take TYPE_KIND_UNION == || "type_get_idx: type is not a struct or a union" assert_msg ;
  263. $i
  264. @i 0 = ;
  265. $names
  266. @names type TYPE_FIELDS_NAMES take = ;
  267. while i names vector_size < {
  268. if name names i vector_at strcmp 0 == {
  269. i ret ;
  270. }
  271. @i i 1 + = ;
  272. }
  273. 0xffffffff ret ;
  274. }
  275. const GLOBAL_TYPE_IDX 0
  276. const GLOBAL_LOC 4
  277. const GLOBAL_INITIALIZED 8
  278. const GLOBAL_EMITTED 12
  279. const SIZEOF_GLOBAL 16
  280. fun global_init 0 {
  281. $global
  282. @global SIZEOF_GLOBAL malloc = ;
  283. global ret ;
  284. }
  285. fun global_destroy 1 {
  286. $global
  287. @global 0 param = ;
  288. global free ;
  289. }
  290. fun global_dump 1 {
  291. $global
  292. @global 0 param = ;
  293. "has type #" log ;
  294. global GLOBAL_TYPE_IDX take itoa log ;
  295. " and is stored at " log ;
  296. global GLOBAL_LOC take itoa log ;
  297. }
  298. const CCTX_ASTINT_GET_TOKEN 0
  299. const CCTX_ASTINT_GET_TOKEN_OR_FAIL 4
  300. const CCTX_ASTINT_GIVE_BACK_TOKEN 8
  301. const CCTX_ASTINT_PARSE_TYPE 12
  302. const CCTX_ASTINT_CTX 16
  303. const SIZEOF_CCTX_ASTINT 20
  304. ifun cctx_get_token 1
  305. ifun cctx_give_back_token 1
  306. ifun cctx_get_token_or_fail 1
  307. ifun cctx_parse_type 1
  308. ifun cctx_parse_declarator 6
  309. fun cctx_astint_get_token 1 {
  310. $int
  311. @int 0 param = ;
  312. int CCTX_ASTINT_CTX take cctx_get_token ret ;
  313. }
  314. fun cctx_astint_get_token_or_fail 1 {
  315. $int
  316. @int 0 param = ;
  317. int CCTX_ASTINT_CTX take cctx_get_token_or_fail ret ;
  318. }
  319. fun cctx_astint_give_back_token 1 {
  320. $int
  321. @int 0 param = ;
  322. int CCTX_ASTINT_CTX take cctx_give_back_token ;
  323. }
  324. fun cctx_astint_parse_type 1 {
  325. $int
  326. @int 0 param = ;
  327. # Parse base type
  328. $base_type_idx
  329. @base_type_idx int CCTX_ASTINT_CTX take cctx_parse_type = ;
  330. if base_type_idx 0xffffffff == {
  331. base_type_idx ret ;
  332. }
  333. # Parse declarator
  334. $type_idx
  335. $name
  336. if int CCTX_ASTINT_CTX take 0 base_type_idx @type_idx @name 0 cctx_parse_declarator {
  337. type_idx ret ;
  338. } else {
  339. base_type_idx ret ;
  340. }
  341. }
  342. fun cctx_astint_init 1 {
  343. $ctx
  344. @ctx 0 param = ;
  345. $int
  346. @int SIZEOF_CCTX_ASTINT malloc = ;
  347. int CCTX_ASTINT_GET_TOKEN take_addr @cctx_astint_get_token = ;
  348. int CCTX_ASTINT_GET_TOKEN_OR_FAIL take_addr @cctx_astint_get_token_or_fail = ;
  349. int CCTX_ASTINT_GIVE_BACK_TOKEN take_addr @cctx_astint_give_back_token = ;
  350. int CCTX_ASTINT_PARSE_TYPE take_addr @cctx_astint_parse_type = ;
  351. int CCTX_ASTINT_CTX take_addr ctx = ;
  352. int ret ;
  353. }
  354. fun cctx_astint_destroy 1 {
  355. $int
  356. @int 0 param = ;
  357. int free ;
  358. }
  359. const CCTX_TYPES 0
  360. const CCTX_TYPENAMES 4
  361. const CCTX_GLOBALS 8
  362. const CCTX_TOKENS 12
  363. const CCTX_TOKENS_POS 16
  364. const CCTX_STAGE 20
  365. const CCTX_CURRENT_LOC 24
  366. const CCTX_LABEL_POS 28
  367. const CCTX_LABEL_BUF 32
  368. const CCTX_LABEL_NUM 36
  369. const CCTX_STRUCTS 40
  370. const CCTX_UNIONS 44
  371. const CCTX_ENUM_CONSTS 48
  372. const CCTX_HANDLES 52
  373. const CCTX_VERBOSE 56
  374. const CCTX_RUNTIME 60
  375. const CCTX_ASTINT 64
  376. const CCTX_ARRAY_LENS 68
  377. const CCTX_DEBUG 72
  378. const CCTX_DOT_POS 76
  379. const CCTX_DEBUG_AFTER 80
  380. const SIZEOF_CCTX 84
  381. fun cctx_init_types 1 {
  382. $ctx
  383. @ctx 0 param = ;
  384. ctx CCTX_TYPES take_addr 4 vector_init = ;
  385. ctx CCTX_TYPENAMES take_addr map_init = ;
  386. ctx CCTX_STRUCTS take_addr map_init = ;
  387. ctx CCTX_UNIONS take_addr map_init = ;
  388. ctx CCTX_ENUM_CONSTS take_addr map_init = ;
  389. }
  390. fun cctx_setup_handles 1 {
  391. $ctx
  392. @ctx 0 param = ;
  393. $handles
  394. @handles ctx CCTX_HANDLES take = ;
  395. handles @write vector_push_back ;
  396. handles @platform_setjmp vector_push_back ;
  397. handles @platform_longjmp vector_push_back ;
  398. handles @malloc vector_push_back ;
  399. handles @calloc vector_push_back ;
  400. handles @free vector_push_back ;
  401. handles @realloc vector_push_back ;
  402. handles @itoa vector_push_back ;
  403. handles @dump_stacktrace vector_push_back ;
  404. handles @vfs_open vector_push_back ;
  405. handles @vfs_close vector_push_back ;
  406. handles @vfs_read vector_push_back ;
  407. handles @vfs_write vector_push_back ;
  408. handles @vfs_truncate vector_push_back ;
  409. handles @vfs_seek vector_push_back ;
  410. handles @input_getc vector_push_back ;
  411. }
  412. fun cctx_setup_runtime 1 {
  413. $ctx
  414. @ctx 0 param = ;
  415. $fd
  416. @fd "/disk1/stdlib/int64.asm" vfs_open = ;
  417. ctx CCTX_RUNTIME take ASMCTX_VERBOSE take_addr 0 = ;
  418. ctx CCTX_RUNTIME take ASMCTX_DEBUG take_addr 0 = ;
  419. ctx CCTX_RUNTIME take fd asmctx_set_fd ;
  420. ctx CCTX_RUNTIME take asmctx_compile ;
  421. fd vfs_close ;
  422. }
  423. fun cctx_init 1 {
  424. $tokens
  425. @tokens 0 param = ;
  426. $ctx
  427. @ctx SIZEOF_CCTX malloc = ;
  428. ctx cctx_init_types ;
  429. ctx CCTX_GLOBALS take_addr map_init = ;
  430. ctx CCTX_TOKENS take_addr tokens = ;
  431. ctx CCTX_TOKENS_POS take_addr 0 = ;
  432. ctx CCTX_LABEL_NUM take_addr 0 = ;
  433. ctx CCTX_LABEL_BUF take_addr 32 malloc = ;
  434. ctx CCTX_LABEL_POS take_addr 4 vector_init = ;
  435. ctx CCTX_HANDLES take_addr 4 vector_init = ;
  436. ctx CCTX_VERBOSE take_addr 1 = ;
  437. ctx CCTX_DEBUG take_addr 1 = ;
  438. ctx CCTX_DOT_POS take_addr 0 = ;
  439. ctx CCTX_DEBUG_AFTER take_addr 0 1 - = ;
  440. ctx CCTX_RUNTIME take_addr asmctx_init = ;
  441. ctx CCTX_ASTINT take_addr ctx cctx_astint_init = ;
  442. ctx CCTX_ARRAY_LENS take_addr map_init = ;
  443. ctx cctx_setup_handles ;
  444. #ctx cctx_setup_runtime ;
  445. ctx ret ;
  446. }
  447. fun cctx_destroy_types 1 {
  448. $ctx
  449. @ctx 0 param = ;
  450. $types
  451. @types ctx CCTX_TYPES take = ;
  452. $i
  453. @i 0 = ;
  454. while i types vector_size < {
  455. types i vector_at type_destroy ;
  456. @i i 1 + = ;
  457. }
  458. types vector_destroy ;
  459. $typenames
  460. @typenames ctx CCTX_TYPENAMES take = ;
  461. typenames map_destroy ;
  462. $structs
  463. @structs ctx CCTX_STRUCTS take = ;
  464. structs map_destroy ;
  465. $unions
  466. @unions ctx CCTX_UNIONS take = ;
  467. unions map_destroy ;
  468. ctx CCTX_ENUM_CONSTS take map_destroy ;
  469. }
  470. fun global_destroy_closure 3 {
  471. $ctx
  472. $key
  473. $value
  474. @ctx 2 param = ;
  475. @key 1 param = ;
  476. @value 0 param = ;
  477. value global_destroy ;
  478. }
  479. fun cctx_destroy 1 {
  480. $ctx
  481. @ctx 0 param = ;
  482. ctx cctx_destroy_types ;
  483. $globals
  484. @globals ctx CCTX_GLOBALS take = ;
  485. globals @global_destroy_closure 0 map_foreach ;
  486. globals map_destroy ;
  487. ctx CCTX_LABEL_POS take vector_destroy ;
  488. ctx CCTX_LABEL_BUF take free ;
  489. ctx CCTX_HANDLES take vector_destroy ;
  490. ctx CCTX_RUNTIME take asmctx_destroy ;
  491. ctx CCTX_ASTINT take cctx_astint_destroy ;
  492. ctx CCTX_ARRAY_LENS take map_destroy ;
  493. ctx free ;
  494. }
  495. fun cctx_reset_types 1 {
  496. $ctx
  497. @ctx 0 param = ;
  498. ctx cctx_destroy_types ;
  499. ctx cctx_init_types ;
  500. }
  501. fun cctx_clean_globals_closure 3 {
  502. $ctx
  503. $key
  504. $value
  505. @ctx 2 param = ;
  506. @key 1 param = ;
  507. @value 0 param = ;
  508. value GLOBAL_EMITTED take_addr 0 = ;
  509. }
  510. fun cctx_clean_globals 1 {
  511. $ctx
  512. @ctx 0 param = ;
  513. $globals
  514. @globals ctx CCTX_GLOBALS take = ;
  515. globals @cctx_clean_globals_closure ctx map_foreach ;
  516. }
  517. fun cctx_get_type 2 {
  518. $ctx
  519. $type_idx
  520. @ctx 1 param = ;
  521. @type_idx 0 param = ;
  522. ctx CCTX_TYPES take type_idx vector_at ret ;
  523. }
  524. fun cctx_dump_types 1 {
  525. $ctx
  526. @ctx 0 param = ;
  527. $i
  528. @i 0 = ;
  529. $types
  530. @types ctx CCTX_TYPES take = ;
  531. while i types vector_size < {
  532. "#" log ;
  533. i itoa log ;
  534. ": " log ;
  535. types i vector_at type_dump ;
  536. "\n" log ;
  537. @i i 1 + = ;
  538. }
  539. }
  540. fun dump_typename_closure 3 {
  541. $ctx
  542. $key
  543. $value
  544. @ctx 2 param = ;
  545. @key 1 param = ;
  546. @value 0 param = ;
  547. "Typename " log ;
  548. key log ;
  549. ": #" log ;
  550. value itoa log ;
  551. "\n" log ;
  552. }
  553. fun cctx_dump_typenames 1 {
  554. $ctx
  555. @ctx 0 param = ;
  556. $typenames
  557. @typenames ctx CCTX_TYPENAMES take = ;
  558. typenames @dump_typename_closure 0 map_foreach ;
  559. }
  560. fun dump_global_closure 3 {
  561. $ctx
  562. $key
  563. $value
  564. @ctx 2 param = ;
  565. @key 1 param = ;
  566. @value 0 param = ;
  567. # Ignore globals starting with a dot, which are internal labels and
  568. # unlikely to give useful insights
  569. if key **c '.' == {
  570. ret ;
  571. }
  572. "Global " log ;
  573. key log ;
  574. ": " log ;
  575. value global_dump ;
  576. "\n" log ;
  577. }
  578. fun cctx_dump_globals 1 {
  579. $ctx
  580. @ctx 0 param = ;
  581. $globals
  582. @globals ctx CCTX_GLOBALS take = ;
  583. globals @dump_global_closure 0 map_foreach ;
  584. }
  585. fun cctx_print_stats 1 {
  586. $ctx
  587. @ctx 0 param = ;
  588. ctx CCTX_GLOBALS take map_size itoa log ;
  589. " globals were generated (including internal labels)\n" log ;
  590. ctx CCTX_TYPENAMES take map_size itoa log ;
  591. " type names were generated\n" log ;
  592. ctx CCTX_TYPES take vector_size itoa log ;
  593. " types were generated\n" log ;
  594. }
  595. ifun cctx_type_compare 3
  596. fun _cctx_type_compare 3 {
  597. $ctx
  598. $t1
  599. $t2
  600. @ctx 2 param = ;
  601. @t1 1 param = ;
  602. @t2 0 param = ;
  603. if t1 TYPE_KIND take t2 TYPE_KIND take != { 0 ret ; }
  604. if t1 TYPE_KIND take TYPE_KIND_BASE == {
  605. if t1 TYPE_BASE take t2 TYPE_BASE take != { 0 ret ; }
  606. 1 ret ;
  607. }
  608. if t1 TYPE_KIND take TYPE_KIND_POINTER == {
  609. if ctx t1 TYPE_BASE take t2 TYPE_BASE take cctx_type_compare ! { 0 ret ; }
  610. 1 ret ;
  611. }
  612. if t1 TYPE_KIND take TYPE_KIND_FUNCTION == {
  613. if ctx t1 TYPE_BASE take t2 TYPE_BASE take cctx_type_compare ! { 0 ret ; }
  614. if t1 TYPE_ELLIPSIS take t2 TYPE_ELLIPSIS take != { 0 ret ; }
  615. $args1
  616. $args2
  617. @args1 t1 TYPE_ARGS take = ;
  618. @args2 t2 TYPE_ARGS take = ;
  619. if args1 vector_size args2 vector_size != { 0 ret ; }
  620. $i
  621. @i 0 = ;
  622. while i args1 vector_size < {
  623. if ctx args1 i vector_at args2 i vector_at cctx_type_compare ! { 0 ret ; }
  624. @i i 1 + = ;
  625. }
  626. 1 ret ;
  627. }
  628. if t1 TYPE_KIND take TYPE_KIND_ARRAY == {
  629. if ctx t1 TYPE_BASE take t2 TYPE_BASE take cctx_type_compare ! { 0 ret ; }
  630. if t1 TYPE_LENGTH take t2 TYPE_LENGTH take != { 0 ret ; }
  631. 1 ret ;
  632. }
  633. # structs and unions are always different unless they have the same
  634. # type index, which has already been checked
  635. if t1 TYPE_KIND take TYPE_KIND_STRUCT == {
  636. 0 ret ;
  637. }
  638. if t1 TYPE_KIND take TYPE_KIND_UNION == {
  639. 0 ret ;
  640. }
  641. 0 "_type_compare: not yet implemented" assert_msg ;
  642. }
  643. fun cctx_type_compare 3 {
  644. $ctx
  645. $ti1
  646. $ti2
  647. @ctx 2 param = ;
  648. @ti1 1 param = ;
  649. @ti2 0 param = ;
  650. if ti1 ti2 == { 1 ret ; }
  651. $t1
  652. $t2
  653. @t1 ctx CCTX_TYPES take ti1 vector_at = ;
  654. @t2 ctx CCTX_TYPES take ti2 vector_at = ;
  655. $res
  656. @res ctx t1 t2 _cctx_type_compare = ;
  657. if res {
  658. t1 TYPE_SIZE take t2 TYPE_SIZE take == "type_compare: type are equal, but have different size" assert_msg ;
  659. }
  660. res ret ;
  661. }
  662. fun cctx_add_type 2 {
  663. $ctx
  664. $type
  665. @ctx 1 param = ;
  666. @type 0 param = ;
  667. # Add the type to the list
  668. $types
  669. $idx
  670. @types ctx CCTX_TYPES take = ;
  671. @idx types vector_size = ;
  672. types type vector_push_back ;
  673. # Check if the new type already matches with another
  674. $i
  675. @i 0 = ;
  676. while i idx < {
  677. if ctx i idx cctx_type_compare {
  678. # Found a match, remove the new one and return the old one
  679. types vector_pop_back type_destroy ;
  680. i ret ;
  681. }
  682. @i i 1 + = ;
  683. }
  684. idx ret ;
  685. }
  686. fun cctx_get_pointer_type 2 {
  687. $ctx
  688. $type_idx
  689. @ctx 1 param = ;
  690. @type_idx 0 param = ;
  691. $type
  692. @type type_init = ;
  693. type TYPE_KIND take_addr TYPE_KIND_POINTER = ;
  694. type TYPE_BASE take_addr type_idx = ;
  695. type TYPE_SIZE take_addr 4 = ;
  696. ctx type cctx_add_type ret ;
  697. }
  698. fun cctx_get_array_type 3 {
  699. $ctx
  700. $type_idx
  701. $length
  702. @ctx 2 param = ;
  703. @type_idx 1 param = ;
  704. @length 0 param = ;
  705. $base_type
  706. @base_type ctx CCTX_TYPES take type_idx vector_at = ;
  707. base_type TYPE_SIZE take 0xffffffff != "cctx_get_array_type: base type is invalid size" assert_msg ;
  708. $type
  709. @type type_init = ;
  710. type TYPE_KIND take_addr TYPE_KIND_ARRAY = ;
  711. type TYPE_BASE take_addr type_idx = ;
  712. type TYPE_LENGTH take_addr length = ;
  713. type TYPE_SIZE take_addr length base_type TYPE_SIZE take * = ;
  714. # -1 is used when length is not specified
  715. if length 0xffffffff == {
  716. type TYPE_SIZE take_addr 0xffffffff = ;
  717. }
  718. ctx type cctx_add_type ret ;
  719. }
  720. fun cctx_get_function_type 4 {
  721. $ctx
  722. $type_idx
  723. $args
  724. $ellipsis
  725. @ctx 3 param = ;
  726. @type_idx 2 param = ;
  727. @args 1 param = ;
  728. @ellipsis 0 param = ;
  729. $type
  730. @type type_init = ;
  731. type TYPE_KIND take_addr TYPE_KIND_FUNCTION = ;
  732. type TYPE_BASE take_addr type_idx = ;
  733. type TYPE_SIZE take_addr 0xffffffff = ;
  734. type TYPE_ARGS take vector_destroy ;
  735. type TYPE_ARGS take_addr args = ;
  736. type TYPE_ELLIPSIS take_addr ellipsis = ;
  737. ctx type cctx_add_type ret ;
  738. }
  739. ifun cctx_type_footprint 2
  740. fun cctx_construct_struct_type 3 {
  741. $ctx
  742. $type_idxs
  743. $names
  744. @ctx 2 param = ;
  745. @type_idxs 1 param = ;
  746. @names 0 param = ;
  747. type_idxs vector_size names vector_size == "cctx_construct_struct_type: inputs have different lengths" assert_msg ;
  748. $type
  749. @type type_init = ;
  750. type TYPE_KIND take_addr TYPE_KIND_STRUCT = ;
  751. type TYPE_FIELDS_TYPE_IDXS take vector_destroy ;
  752. type TYPE_FIELDS_NAMES take vector_destroy ;
  753. type TYPE_FIELDS_TYPE_IDXS take_addr type_idxs = ;
  754. type TYPE_FIELDS_NAMES take_addr names = ;
  755. # Compute offsets and size
  756. $off
  757. @off 0 = ;
  758. $i
  759. @i 0 = ;
  760. $offs
  761. @offs type TYPE_FIELDS_OFFS take = ;
  762. while i names vector_size < {
  763. offs off vector_push_back ;
  764. $fp
  765. @fp ctx type_idxs i vector_at cctx_type_footprint = ;
  766. @off off fp + = ;
  767. @i i 1 + = ;
  768. }
  769. type TYPE_SIZE take_addr off = ;
  770. # Inherit labels from anonymous subtypes
  771. @i 0 = ;
  772. $orig_len
  773. @orig_len names vector_size = ;
  774. while i orig_len < {
  775. if names i vector_at **c '\0' == {
  776. $base_off
  777. @base_off offs i vector_at = ;
  778. $type_idx
  779. $type
  780. @type_idx type_idxs i vector_at = ;
  781. @type ctx type_idx cctx_get_type = ;
  782. type TYPE_KIND take TYPE_KIND_STRUCT == type TYPE_KIND take TYPE_KIND_UNION == || "cctx_construct_struct_type: anonymous field is not union or strucr" assert_msg ;
  783. $sub_type_idxs
  784. $sub_names
  785. $sub_offs
  786. @sub_type_idxs type TYPE_FIELDS_TYPE_IDXS take = ;
  787. @sub_names type TYPE_FIELDS_NAMES take = ;
  788. @sub_offs type TYPE_FIELDS_OFFS take = ;
  789. $j
  790. @j 0 = ;
  791. while j sub_names vector_size < {
  792. $sub_name
  793. @sub_name sub_names j vector_at = ;
  794. if sub_name **c '\0' != {
  795. names sub_name strdup vector_push_back ;
  796. type_idxs sub_type_idxs j vector_at vector_push_back ;
  797. offs sub_offs j vector_at base_off + vector_push_back ;
  798. }
  799. @j j 1 + = ;
  800. }
  801. }
  802. @i i 1 + = ;
  803. }
  804. type ret ;
  805. }
  806. fun cctx_get_incomplete_struct_type 1 {
  807. $ctx
  808. @ctx 0 param = ;
  809. $type
  810. @type type_init = ;
  811. type TYPE_KIND take_addr TYPE_KIND_STRUCT = ;
  812. type TYPE_SIZE take_addr 0xffffffff = ;
  813. $r
  814. @r ctx type cctx_add_type = ;
  815. # To work around some deficiencies in the implementation,
  816. # immediately add the pointer type too
  817. ctx r cctx_get_pointer_type ;
  818. r ret ;
  819. }
  820. fun cctx_construct_union_type 3 {
  821. $ctx
  822. $type_idxs
  823. $names
  824. @ctx 2 param = ;
  825. @type_idxs 1 param = ;
  826. @names 0 param = ;
  827. type_idxs vector_size names vector_size == "cctx_construct_union_type: inputs have different lengths" assert_msg ;
  828. $type
  829. @type type_init = ;
  830. type TYPE_KIND take_addr TYPE_KIND_UNION = ;
  831. type TYPE_FIELDS_TYPE_IDXS take vector_destroy ;
  832. type TYPE_FIELDS_NAMES take vector_destroy ;
  833. type TYPE_FIELDS_TYPE_IDXS take_addr type_idxs = ;
  834. type TYPE_FIELDS_NAMES take_addr names = ;
  835. # Compute size
  836. $size
  837. @size 0 = ;
  838. $i
  839. @i 0 = ;
  840. $offs
  841. @offs type TYPE_FIELDS_OFFS take = ;
  842. while i names vector_size < {
  843. offs 0 vector_push_back ;
  844. @size size ctx type_idxs i vector_at cctx_type_footprint max = ;
  845. @i i 1 + = ;
  846. }
  847. type TYPE_SIZE take_addr size = ;
  848. # Inherit labels from anonymous subtypes
  849. @i 0 = ;
  850. $orig_len
  851. @orig_len names vector_size = ;
  852. while i orig_len < {
  853. if names i vector_at **c '\0' == {
  854. $base_off
  855. @base_off offs i vector_at = ;
  856. $type_idx
  857. $type
  858. @type_idx type_idxs i vector_at = ;
  859. @type ctx type_idx cctx_get_type = ;
  860. type TYPE_KIND take TYPE_KIND_STRUCT == type TYPE_KIND take TYPE_KIND_UNION == || "cctx_construct_struct_type: anonymous field is not union or strucr" assert_msg ;
  861. $sub_type_idxs
  862. $sub_names
  863. $sub_offs
  864. @sub_type_idxs type TYPE_FIELDS_TYPE_IDXS take = ;
  865. @sub_names type TYPE_FIELDS_NAMES take = ;
  866. @sub_offs type TYPE_FIELDS_OFFS take = ;
  867. $j
  868. @j 0 = ;
  869. while j sub_names vector_size < {
  870. $sub_name
  871. @sub_name sub_names j vector_at = ;
  872. if sub_name **c '\0' != {
  873. names sub_name strdup vector_push_back ;
  874. type_idxs sub_type_idxs j vector_at vector_push_back ;
  875. offs sub_offs j vector_at base_off + vector_push_back ;
  876. }
  877. @j j 1 + = ;
  878. }
  879. }
  880. @i i 1 + = ;
  881. }
  882. type ret ;
  883. }
  884. fun cctx_get_incomplete_union_type 1 {
  885. $ctx
  886. @ctx 0 param = ;
  887. $type
  888. @type type_init = ;
  889. type TYPE_KIND take_addr TYPE_KIND_UNION = ;
  890. type TYPE_SIZE take_addr 0xffffffff = ;
  891. ctx type cctx_add_type ret ;
  892. }
  893. const TYPE_VOID 0
  894. const TYPE_FIRST_INTEGER 1
  895. const TYPE_CHAR 1
  896. const TYPE_SCHAR 2
  897. const TYPE_UCHAR 3
  898. const TYPE_SHORT 4
  899. const TYPE_INT 5
  900. const TYPE_LONG 6
  901. const TYPE_USHORT 7
  902. const TYPE_UINT 8
  903. const TYPE_ULONG 9
  904. const TYPE_BOOL 10
  905. const TYPE_LAST_INTEGER 10
  906. # Floating point numbers are not supported, but at least the compiler
  907. # is able to tell their sizes
  908. const TYPE_FLOAT 11
  909. const TYPE_DOUBLE 12
  910. const TYPE_LDOUBLE 13
  911. # Other useful types
  912. const TYPE_CHAR_ARRAY 14
  913. const TYPE_VOID_PTR 15
  914. fun is_integer_type 1 {
  915. $idx
  916. @idx 0 param = ;
  917. TYPE_FIRST_INTEGER idx <= TYPE_LAST_INTEGER idx >= && ret ;
  918. }
  919. fun cctx_create_basic_type 3 {
  920. $ctx
  921. $idx
  922. $size
  923. @ctx 2 param = ;
  924. @idx 1 param = ;
  925. @size 0 param = ;
  926. $types
  927. @types ctx CCTX_TYPES take = ;
  928. idx types vector_size == "cctx_create_basic_type: error 1" assert_msg ;
  929. $type
  930. @type type_init = ;
  931. type TYPE_KIND take_addr TYPE_KIND_BASE = ;
  932. type TYPE_BASE take_addr idx = ;
  933. type TYPE_SIZE take_addr size = ;
  934. types type vector_push_back ;
  935. }
  936. fun cctx_create_basic_types 1 {
  937. $ctx
  938. @ctx 0 param = ;
  939. ctx TYPE_VOID 0xffffffff cctx_create_basic_type ;
  940. ctx TYPE_CHAR 1 cctx_create_basic_type ;
  941. ctx TYPE_SCHAR 1 cctx_create_basic_type ;
  942. ctx TYPE_UCHAR 1 cctx_create_basic_type ;
  943. ctx TYPE_SHORT 2 cctx_create_basic_type ;
  944. ctx TYPE_INT 4 cctx_create_basic_type ;
  945. ctx TYPE_LONG 8 cctx_create_basic_type ;
  946. ctx TYPE_USHORT 2 cctx_create_basic_type ;
  947. ctx TYPE_UINT 4 cctx_create_basic_type ;
  948. ctx TYPE_ULONG 8 cctx_create_basic_type ;
  949. ctx TYPE_BOOL 4 cctx_create_basic_type ;
  950. ctx TYPE_FLOAT 4 cctx_create_basic_type ;
  951. ctx TYPE_DOUBLE 8 cctx_create_basic_type ;
  952. ctx TYPE_LDOUBLE 12 cctx_create_basic_type ;
  953. ctx TYPE_CHAR 0xffffffff cctx_get_array_type TYPE_CHAR_ARRAY == "cctx_create_basic_types: error 1" assert_msg ;
  954. ctx TYPE_VOID cctx_get_pointer_type TYPE_VOID_PTR == "cctx_create_basic_types: error 2" assert_msg ;
  955. }
  956. fun cctx_has_global 2 {
  957. $ctx
  958. $name
  959. @ctx 1 param = ;
  960. @name 0 param = ;
  961. $globals
  962. @globals ctx CCTX_GLOBALS take = ;
  963. globals name map_has ret ;
  964. }
  965. fun cctx_get_global 2 {
  966. $ctx
  967. $name
  968. @ctx 1 param = ;
  969. @name 0 param = ;
  970. $globals
  971. @globals ctx CCTX_GLOBALS take = ;
  972. globals name map_has "cctx_get_global: global does not exist" name assert_msg_str ;
  973. $global
  974. @global globals name map_at = ;
  975. global ret ;
  976. }
  977. fun cctx_add_global 4 {
  978. $ctx
  979. $name
  980. $loc
  981. $type_idx
  982. @ctx 3 param = ;
  983. @name 2 param = ;
  984. @loc 1 param = ;
  985. @type_idx 0 param = ;
  986. $globals
  987. @globals ctx CCTX_GLOBALS take = ;
  988. $present
  989. @present globals name map_has = ;
  990. $global
  991. if present {
  992. @global globals name map_at = ;
  993. ctx global GLOBAL_TYPE_IDX take type_idx cctx_type_compare "cctx_add_global: types do not match" name assert_msg_str ;
  994. } else {
  995. ctx CCTX_STAGE take 0 == "cctx_add_global: error 1" assert_msg ;
  996. @global global_init = ;
  997. global GLOBAL_TYPE_IDX take_addr type_idx = ;
  998. global GLOBAL_LOC take_addr loc = ;
  999. global GLOBAL_INITIALIZED take_addr 0 = ;
  1000. global GLOBAL_EMITTED take_addr 0 = ;
  1001. globals name global map_set ;
  1002. }
  1003. if ctx CCTX_STAGE take 0 == {
  1004. global GLOBAL_LOC take_addr 0xffffffff = ;
  1005. } else {
  1006. present "cctx_add_global: error 2" assert_msg ;
  1007. }
  1008. if ctx CCTX_STAGE take 1 == {
  1009. if loc 0xffffffff != {
  1010. global GLOBAL_LOC take 0xffffffff == "cctx_add_global: global is defined more than once" name assert_msg_str ;
  1011. global GLOBAL_LOC take_addr loc = ;
  1012. }
  1013. }
  1014. if ctx CCTX_STAGE take 2 == {
  1015. if loc 0xffffffff != {
  1016. global GLOBAL_LOC take loc == "cctx_add_global: error 3" name assert_msg_str ;
  1017. if name **c '.' != {
  1018. name loc resolve_symbol_add ;
  1019. }
  1020. }
  1021. }
  1022. type_idx ret ;
  1023. }
  1024. fun cctx_emit 2 {
  1025. $ctx
  1026. $byte
  1027. @ctx 1 param = ;
  1028. @byte 0 param = ;
  1029. if ctx CCTX_STAGE take 2 == {
  1030. ctx CCTX_CURRENT_LOC take byte =c ;
  1031. }
  1032. ctx CCTX_CURRENT_LOC take_addr ctx CCTX_CURRENT_LOC take 1 + = ;
  1033. }
  1034. fun cctx_emit16 2 {
  1035. $ctx
  1036. $word
  1037. @ctx 1 param = ;
  1038. @word 0 param = ;
  1039. ctx word cctx_emit ;
  1040. ctx word 8 >> cctx_emit ;
  1041. }
  1042. fun cctx_emit32 2 {
  1043. $ctx
  1044. $dword
  1045. @ctx 1 param = ;
  1046. @dword 0 param = ;
  1047. ctx dword cctx_emit16 ;
  1048. ctx dword 16 >> cctx_emit16 ;
  1049. }
  1050. fun cctx_emit_zeros 2 {
  1051. $ctx
  1052. $num
  1053. @ctx 1 param = ;
  1054. @num 0 param = ;
  1055. $i
  1056. @i 0 = ;
  1057. while i num < {
  1058. ctx 0 cctx_emit ;
  1059. @i i 1 + = ;
  1060. }
  1061. }
  1062. ifun cctx_gen_label 3
  1063. ifun cctx_fix_label 4
  1064. ifun cctx_gen_jump 3
  1065. ifun cctx_gen_label_jump 5
  1066. fun cctx_is_eof 1 {
  1067. $ctx
  1068. @ctx 0 param = ;
  1069. ctx CCTX_TOKENS_POS take ctx CCTX_TOKENS take vector_size == ret ;
  1070. }
  1071. fun cctx_get_token 1 {
  1072. $ctx
  1073. @ctx 0 param = ;
  1074. if ctx CCTX_TOKENS_POS take ctx CCTX_TOKENS take vector_size == {
  1075. 0 ret ;
  1076. } else {
  1077. $tok
  1078. @tok ctx CCTX_TOKENS take ctx CCTX_TOKENS_POS take vector_at = ;
  1079. if ctx CCTX_DEBUG take {
  1080. " " log ;
  1081. tok log ;
  1082. } else {
  1083. if ctx CCTX_VERBOSE take {
  1084. if ctx CCTX_TOKENS_POS take ctx CCTX_DEBUG_AFTER take == {
  1085. ctx CCTX_DEBUG take_addr 1 = ;
  1086. }
  1087. if ctx CCTX_TOKENS_POS take ctx CCTX_DOT_POS take == {
  1088. "." log ;
  1089. ctx CCTX_DOT_POS take_addr ctx CCTX_DOT_POS take 1000 + = ;
  1090. }
  1091. }
  1092. }
  1093. ctx CCTX_TOKENS_POS take_addr ctx CCTX_TOKENS_POS take 1 + = ;
  1094. tok ret ;
  1095. }
  1096. }
  1097. fun cctx_give_back_token 1 {
  1098. $ctx
  1099. @ctx 0 param = ;
  1100. if ctx CCTX_DEBUG take {
  1101. " <gb>" log ;
  1102. }
  1103. ctx CCTX_TOKENS_POS take 0 > "cctx_give_back_token: error 1" assert_msg ;
  1104. ctx CCTX_TOKENS_POS take_addr ctx CCTX_TOKENS_POS take 1 - = ;
  1105. }
  1106. fun cctx_save_token_pos 1 {
  1107. $ctx
  1108. @ctx 0 param = ;
  1109. ctx CCTX_TOKENS_POS take ret ;
  1110. }
  1111. fun cctx_restore_token_pos 2 {
  1112. $ctx
  1113. $pos
  1114. @ctx 1 param = ;
  1115. @pos 0 param = ;
  1116. ctx CCTX_TOKENS_POS take_addr pos = ;
  1117. }
  1118. fun cctx_get_token_or_fail 1 {
  1119. $ctx
  1120. @ctx 0 param = ;
  1121. $tok
  1122. @tok ctx cctx_get_token = ;
  1123. tok 0 != "cctx_get_token_or_fail: unexpected end-of-file" assert_msg ;
  1124. tok ret ;
  1125. }
  1126. fun cctx_go_to_matching 3 {
  1127. $ctx
  1128. $open
  1129. $close
  1130. @ctx 2 param = ;
  1131. @open 1 param = ;
  1132. @close 0 param = ;
  1133. $level
  1134. @level 1 = ;
  1135. while level 0 > {
  1136. $tok
  1137. @tok ctx cctx_get_token_or_fail = ;
  1138. if tok open strcmp 0 == {
  1139. @level level 1 + = ;
  1140. }
  1141. if tok close strcmp 0 == {
  1142. @level level 1 - = ;
  1143. }
  1144. }
  1145. }
  1146. fun cctx_print_token_pos 1 {
  1147. $ctx
  1148. @ctx 0 param = ;
  1149. "Token pos: " log ;
  1150. ctx CCTX_TOKENS_POS take itoa log ;
  1151. "\n" log ;
  1152. }
  1153. ifun cctx_parse_type 1
  1154. fun cctx_parse_struct 3 {
  1155. $ctx
  1156. $type_idxs_ptr
  1157. $names_ptr
  1158. @ctx 2 param = ;
  1159. @type_idxs_ptr 1 param = ;
  1160. @names_ptr 0 param = ;
  1161. $type_idxs
  1162. $names
  1163. @type_idxs 4 vector_init = ;
  1164. @names 4 vector_init = ;
  1165. $cont
  1166. @cont 1 = ;
  1167. while cont {
  1168. $tok
  1169. @tok ctx cctx_get_token_or_fail = ;
  1170. if tok "}" strcmp 0 == {
  1171. @cont 0 = ;
  1172. } else {
  1173. ctx cctx_give_back_token ;
  1174. $type_idx
  1175. @type_idx ctx cctx_parse_type = ;
  1176. type_idx 0xffffffff != "cctx_parse_struct: type expected" tok assert_msg_str ;
  1177. $cont2
  1178. @cont2 1 = ;
  1179. while cont2 {
  1180. $actual_type_idx
  1181. $name
  1182. if ctx 0 type_idx @actual_type_idx @name 0 cctx_parse_declarator ! {
  1183. # If the declarator parsing fails, then we assume that this
  1184. # is an annonymous struct or union, which for the moment we
  1185. # just represent as having an empty name; names will be
  1186. # fixed later, when the type is actually created
  1187. @name "" = ;
  1188. @actual_type_idx type_idx = ;
  1189. }
  1190. type_idxs actual_type_idx vector_push_back ;
  1191. names name strdup vector_push_back ;
  1192. @tok ctx cctx_get_token_or_fail = ;
  1193. if tok ":" strcmp 0 == {
  1194. @tok ctx cctx_get_token_or_fail = ;
  1195. @tok ctx cctx_get_token_or_fail = ;
  1196. }
  1197. if tok ";" strcmp 0 == {
  1198. @cont2 0 = ;
  1199. } else {
  1200. tok "," strcmp 0 == "cctx_parse_struct: comma expected" assert_msg ;
  1201. }
  1202. }
  1203. }
  1204. }
  1205. type_idxs_ptr type_idxs = ;
  1206. names_ptr names = ;
  1207. }
  1208. ifun ast_eval_compile 3
  1209. fun cctx_parse_ast1 2 {
  1210. $ctx
  1211. $term
  1212. @ctx 1 param = ;
  1213. @term 0 param = ;
  1214. if ctx CCTX_DEBUG take {
  1215. " <pa1>" log ;
  1216. }
  1217. $res
  1218. @res ctx CCTX_ASTINT take term ast_parse1 = ;
  1219. if ctx CCTX_DEBUG take {
  1220. " </pa1>" log ;
  1221. }
  1222. res ret ;
  1223. }
  1224. fun cctx_parse_ast2 3 {
  1225. $ctx
  1226. $term1
  1227. $term2
  1228. @ctx 2 param = ;
  1229. @term1 1 param = ;
  1230. @term2 0 param = ;
  1231. if ctx CCTX_DEBUG take {
  1232. " <pa2>" log ;
  1233. }
  1234. $res
  1235. @res ctx CCTX_ASTINT take term1 term2 ast_parse2 = ;
  1236. if ctx CCTX_DEBUG take {
  1237. " </pa2>" log ;
  1238. }
  1239. res ret ;
  1240. }
  1241. fun cctx_parse_ast3 4 {
  1242. $ctx
  1243. $term1
  1244. $term2
  1245. $term3
  1246. @ctx 3 param = ;
  1247. @term1 2 param = ;
  1248. @term2 1 param = ;
  1249. @term3 0 param = ;
  1250. if ctx CCTX_DEBUG take {
  1251. " <pa3>" log ;
  1252. }
  1253. $res
  1254. @res ctx CCTX_ASTINT take term1 term2 term3 ast_parse3 = ;
  1255. if ctx CCTX_DEBUG take {
  1256. " </pa3>" log ;
  1257. }
  1258. res ret ;
  1259. }
  1260. fun cctx_parse_enum 1 {
  1261. $ctx
  1262. @ctx 0 param = ;
  1263. $enum_consts
  1264. @enum_consts ctx CCTX_ENUM_CONSTS take = ;
  1265. $cont
  1266. @cont 1 = ;
  1267. $val
  1268. @val 0 = ;
  1269. while cont {
  1270. $tok
  1271. @tok ctx cctx_get_token_or_fail = ;
  1272. if tok "}" strcmp 0 == {
  1273. @cont 0 = ;
  1274. } else {
  1275. $ident
  1276. @ident tok = ;
  1277. @tok ctx cctx_get_token_or_fail = ;
  1278. if tok "=" strcmp 0 == {
  1279. $ast
  1280. @ast ctx "}" "," cctx_parse_ast2 = ;
  1281. @val ctx 0 ast ast_eval_compile = ;
  1282. ast ast_destroy ;
  1283. @tok ctx cctx_get_token_or_fail = ;
  1284. }
  1285. enum_consts ident map_has ! "cctx_parse_enum: constant is already defined" assert_msg ;
  1286. enum_consts ident val map_set ;
  1287. @val val 1 + = ;
  1288. if tok "}" strcmp 0 == {
  1289. @cont 0 = ;
  1290. } else {
  1291. tok "," strcmp 0 == "cctx_parse_enum: comma expected" assert_msg ;
  1292. }
  1293. }
  1294. }
  1295. }
  1296. fun cctx_parse_type 1 {
  1297. $ctx
  1298. @ctx 0 param = ;
  1299. $tok
  1300. @tok ctx cctx_get_token_or_fail = ;
  1301. # Ignore constness
  1302. if tok "const" strcmp 0 == {
  1303. @tok ctx cctx_get_token_or_fail = ;
  1304. }
  1305. if tok "void" strcmp 0 == { TYPE_VOID ret ; }
  1306. if tok "_Bool" strcmp 0 == { TYPE_BOOL ret ; }
  1307. if tok "char" strcmp 0 == { TYPE_CHAR ret ; }
  1308. if tok "short" strcmp 0 == { TYPE_SHORT ret ; }
  1309. if tok "int" strcmp 0 == { TYPE_INT ret ; }
  1310. if tok "float" strcmp 0 == { TYPE_FLOAT ret ; }
  1311. if tok "double" strcmp 0 == { TYPE_DOUBLE ret ; }
  1312. if tok "signed" strcmp 0 == {
  1313. @tok ctx cctx_get_token_or_fail = ;
  1314. if tok "char" strcmp 0 == { TYPE_SCHAR ret ; }
  1315. if tok "short" strcmp 0 == { TYPE_SHORT ret ; }
  1316. if tok "int" strcmp 0 == { TYPE_INT ret ; }
  1317. if tok "long" strcmp 0 == {
  1318. @tok ctx cctx_get_token_or_fail = ;
  1319. if tok "int" strcmp 0 == { TYPE_INT ret ; }
  1320. if tok "long" strcmp 0 == {
  1321. @tok ctx cctx_get_token_or_fail = ;
  1322. if tok "int" strcmp 0 == { TYPE_LONG ret ; }
  1323. ctx cctx_give_back_token ;
  1324. TYPE_LONG ret ;
  1325. }
  1326. ctx cctx_give_back_token ;
  1327. TYPE_INT ret ;
  1328. }
  1329. ctx cctx_give_back_token ;
  1330. TYPE_INT ret ;
  1331. }
  1332. if tok "unsigned" strcmp 0 == {
  1333. @tok ctx cctx_get_token_or_fail = ;
  1334. if tok "char" strcmp 0 == { TYPE_UCHAR ret ; }
  1335. if tok "short" strcmp 0 == { TYPE_USHORT ret ; }
  1336. if tok "int" strcmp 0 == { TYPE_UINT ret ; }
  1337. if tok "long" strcmp 0 == {
  1338. @tok ctx cctx_get_token_or_fail = ;
  1339. if tok "int" strcmp 0 == { TYPE_UINT ret ; }
  1340. if tok "long" strcmp 0 == {
  1341. @tok ctx cctx_get_token_or_fail = ;
  1342. if tok "int" strcmp 0 == { TYPE_ULONG ret ; }
  1343. ctx cctx_give_back_token ;
  1344. TYPE_ULONG ret ;
  1345. }
  1346. ctx cctx_give_back_token ;
  1347. TYPE_UINT ret ;
  1348. }
  1349. ctx cctx_give_back_token ;
  1350. TYPE_UINT ret ;
  1351. }
  1352. if tok "long" strcmp 0 == {
  1353. @tok ctx cctx_get_token_or_fail = ;
  1354. if tok "int" strcmp 0 == { TYPE_INT ret ; }
  1355. if tok "double" strcmp 0 == { TYPE_LDOUBLE ret ; }
  1356. if tok "long" strcmp 0 == {
  1357. @tok ctx cctx_get_token_or_fail = ;
  1358. if tok "int" strcmp 0 == { TYPE_LONG ret ; }
  1359. ctx cctx_give_back_token ;
  1360. TYPE_LONG ret ;
  1361. }
  1362. ctx cctx_give_back_token ;
  1363. TYPE_INT ret ;
  1364. }
  1365. if tok "struct" strcmp 0 == {
  1366. $tag
  1367. $type_idxs
  1368. $names
  1369. @tag 0 = ;
  1370. @type_idxs 0 = ;
  1371. @tok ctx cctx_get_token_or_fail = ;
  1372. $structs
  1373. @structs ctx CCTX_STRUCTS take = ;
  1374. $type_idx
  1375. if tok "{" strcmp 0 != {
  1376. @tag tok = ;
  1377. @tok ctx cctx_get_token_or_fail = ;
  1378. if structs tag map_has {
  1379. @type_idx structs tag map_at = ;
  1380. } else {
  1381. @type_idx ctx cctx_get_incomplete_struct_type = ;
  1382. structs tag type_idx map_set ;
  1383. }
  1384. } else {
  1385. @type_idx ctx cctx_get_incomplete_struct_type = ;
  1386. }
  1387. if tok "{" strcmp 0 == {
  1388. ctx @type_idxs @names cctx_parse_struct ;
  1389. $type
  1390. @type ctx type_idx cctx_get_type = ;
  1391. type TYPE_SIZE take 0xffffffff == "cctx_parse_type: cannot define a struct twice" assert_msg ;
  1392. $newtype
  1393. @newtype ctx type_idxs names cctx_construct_struct_type = ;
  1394. type type_destroy ;
  1395. ctx CCTX_TYPES take type_idx vector_at_addr newtype = ;
  1396. } else {
  1397. ctx cctx_give_back_token ;
  1398. tag 0 != "cctx_parse_type: struct without neither tag nor definition" assert_msg ;
  1399. }
  1400. type_idx ret ;
  1401. }
  1402. if tok "union" strcmp 0 == {
  1403. $tag
  1404. $type_idxs
  1405. $names
  1406. @tag 0 = ;
  1407. @type_idxs 0 = ;
  1408. @tok ctx cctx_get_token_or_fail = ;
  1409. $unions
  1410. @unions ctx CCTX_UNIONS take = ;
  1411. $type_idx
  1412. if tok "{" strcmp 0 != {
  1413. @tag tok = ;
  1414. @tok ctx cctx_get_token_or_fail = ;
  1415. if unions tag map_has {
  1416. @type_idx unions tag map_at = ;
  1417. } else {
  1418. @type_idx ctx cctx_get_incomplete_union_type = ;
  1419. unions tag type_idx map_set ;
  1420. }
  1421. } else {
  1422. @type_idx ctx cctx_get_incomplete_union_type = ;
  1423. }
  1424. if tok "{" strcmp 0 == {
  1425. ctx @type_idxs @names cctx_parse_struct ;
  1426. $type
  1427. @type ctx type_idx cctx_get_type = ;
  1428. type TYPE_SIZE take 0xffffffff == "cctx_parse_type: cannot define a union twice" assert_msg ;
  1429. $newtype
  1430. @newtype ctx type_idxs names cctx_construct_union_type = ;
  1431. type type_destroy ;
  1432. ctx CCTX_TYPES take type_idx vector_at_addr newtype = ;
  1433. } else {
  1434. ctx cctx_give_back_token ;
  1435. tag 0 != "cctx_parse_type: union without neither tag nor definition" assert_msg ;
  1436. }
  1437. type_idx ret ;
  1438. }
  1439. if tok "enum" strcmp 0 == {
  1440. $tag
  1441. @tok ctx cctx_get_token_or_fail = ;
  1442. if tok "{" strcmp 0 != {
  1443. @tag tok = ;
  1444. @tok ctx cctx_get_token_or_fail = ;
  1445. }
  1446. if tok "{" strcmp 0 == {
  1447. ctx cctx_parse_enum ;
  1448. } else {
  1449. ctx cctx_give_back_token ;
  1450. tag 0 != "cctx_parse_type: enum without neither tag nor definition" assert_msg ;
  1451. }
  1452. TYPE_UINT ret ;
  1453. }
  1454. $typenames
  1455. @typenames ctx CCTX_TYPENAMES take = ;
  1456. if typenames tok map_has {
  1457. $idx
  1458. @idx typenames tok map_at = ;
  1459. idx ret ;
  1460. } else {
  1461. ctx cctx_give_back_token ;
  1462. 0xffffffff ret ;
  1463. }
  1464. }
  1465. fun _cctx_parse_function_arguments 3 {
  1466. $ctx
  1467. $ret_arg_names
  1468. $ret_ellipsis
  1469. @ctx 2 param = ;
  1470. @ret_arg_names 1 param = ;
  1471. @ret_ellipsis 0 param = ;
  1472. ret_ellipsis 0 = ;
  1473. $args
  1474. @args 4 vector_init = ;
  1475. while 1 {
  1476. $tok
  1477. @tok ctx cctx_get_token_or_fail = ;
  1478. if tok "void" strcmp 0 == {
  1479. @tok ctx cctx_get_token_or_fail = ;
  1480. if tok ")" strcmp 0 == {
  1481. args vector_size 0 == "_cctx_parse_function_arguments: void only valid in first position" assert_msg ;
  1482. args ret ;
  1483. } else {
  1484. ctx cctx_give_back_token ;
  1485. ctx cctx_give_back_token ;
  1486. }
  1487. } else {
  1488. ctx cctx_give_back_token ;
  1489. }
  1490. $type_idx
  1491. @type_idx ctx cctx_parse_type = ;
  1492. if type_idx 0xffffffff == {
  1493. @tok ctx cctx_get_token_or_fail = ;
  1494. if tok "..." strcmp 0 == {
  1495. ret_ellipsis 1 = ;
  1496. @tok ctx cctx_get_token_or_fail = ;
  1497. }
  1498. tok ")" strcmp 0 == "_cctx_parse_function_arguments: ) or type expected" assert_msg ;
  1499. if args vector_size 0 == {
  1500. ret_ellipsis 1 = ;
  1501. }
  1502. args vector_size 0 == ret_ellipsis ** || "_cctx_parse_function_arguments: unexpected )" assert_msg ;
  1503. args ret ;
  1504. }
  1505. $name
  1506. $actual_type_idx
  1507. if ctx 0 type_idx @actual_type_idx @name 0 cctx_parse_declarator ! {
  1508. @actual_type_idx type_idx = ;
  1509. }
  1510. args actual_type_idx vector_push_back ;
  1511. if ret_arg_names 0 != {
  1512. ret_arg_names name vector_push_back ;
  1513. }
  1514. @tok ctx cctx_get_token_or_fail = ;
  1515. if tok ")" strcmp 0 == {
  1516. args ret ;
  1517. }
  1518. tok "," strcmp 0 == "_cctx_parse_function_arguments: ) or , expected" assert_msg ;
  1519. }
  1520. }
  1521. fun _cctx_parse_declarator 6 {
  1522. $ctx
  1523. $lctx
  1524. $type_idx
  1525. $ret_type_idx
  1526. $ret_name
  1527. $ret_arg_names
  1528. @ctx 5 param = ;
  1529. @lctx 4 param = ;
  1530. @type_idx 3 param = ;
  1531. @ret_type_idx 2 param = ;
  1532. @ret_name 1 param = ;
  1533. @ret_arg_names 0 param = ;
  1534. #"_cctx_parse_declarator: entering\n" log ;
  1535. #ctx cctx_print_token_pos ;
  1536. $tok
  1537. @tok ctx cctx_get_token_or_fail = ;
  1538. $processed
  1539. @processed 0 = ;
  1540. #"_cctx_parse_declarator: token is " log ;
  1541. #tok log ;
  1542. #"\n" log ;
  1543. # Parse pointer declaration
  1544. if tok "*" strcmp 0 == {
  1545. @type_idx ctx type_idx cctx_get_pointer_type = ;
  1546. if ctx lctx type_idx ret_type_idx ret_name ret_arg_names _cctx_parse_declarator ! {
  1547. ret_type_idx type_idx = ;
  1548. }
  1549. @processed 1 = ;
  1550. }
  1551. # Parse function declaration and grouping parantheses
  1552. if tok "(" strcmp 0 == {
  1553. # Here the first problem is decide whether this is a function or
  1554. # grouping parenthesis; if immediately after there is a type or a
  1555. # closing parenthesis, we are in the first case; otherwise, we are
  1556. # in the second case.
  1557. $pos
  1558. @pos ctx cctx_save_token_pos = ;
  1559. $type
  1560. @type ctx cctx_parse_type = ;
  1561. ctx pos cctx_restore_token_pos ;
  1562. $is_funct
  1563. @is_funct 0 = ;
  1564. if type 0xffffffff != {
  1565. @is_funct 1 = ;
  1566. }
  1567. @tok ctx cctx_get_token_or_fail = ;
  1568. if tok ")" strcmp 0 == {
  1569. @is_funct 1 = ;
  1570. }
  1571. # Restore the content of tok, so that the program does not get
  1572. # captured in later branches
  1573. @tok "(" = ;
  1574. ctx cctx_give_back_token ;
  1575. if is_funct {
  1576. # Function parenthesis
  1577. $args
  1578. $ellipsis
  1579. @args ctx ret_arg_names @ellipsis _cctx_parse_function_arguments = ;
  1580. if ctx lctx type_idx ret_type_idx ret_name 0 _cctx_parse_declarator {
  1581. @type_idx ret_type_idx ** = ;
  1582. }
  1583. ret_type_idx ctx type_idx args ellipsis cctx_get_function_type = ;
  1584. } else {
  1585. # Grouping parenthesis
  1586. $inside_pos
  1587. $outside_pos
  1588. $end_pos
  1589. @inside_pos ctx cctx_save_token_pos = ;
  1590. ctx "(" ")" cctx_go_to_matching ;
  1591. @outside_pos ctx cctx_save_token_pos = ;
  1592. if ctx lctx type_idx ret_type_idx ret_name 0 _cctx_parse_declarator {
  1593. @type_idx ret_type_idx ** = ;
  1594. }
  1595. @end_pos ctx cctx_save_token_pos = ;
  1596. ctx inside_pos cctx_restore_token_pos ;
  1597. ctx lctx type_idx ret_type_idx ret_name ret_arg_names _cctx_parse_declarator "_cctx_parse_declarator: invalid syntax 1" assert_msg ;
  1598. @tok ctx cctx_get_token_or_fail = ;
  1599. tok ")" strcmp 0 == "_cctx_parse_declarator: error 1" assert_msg ;
  1600. outside_pos ctx cctx_save_token_pos == "_cctx_parse_declarator: invalid syntax 2" assert_msg ;
  1601. ctx end_pos cctx_restore_token_pos ;
  1602. }
  1603. @processed 1 = ;
  1604. }
  1605. # Parse array declaration
  1606. if tok "[" strcmp 0 == {
  1607. @tok ctx cctx_get_token_or_fail = ;
  1608. $length
  1609. if tok "]" strcmp 0 == {
  1610. @length 0xffffffff = ;
  1611. } else {
  1612. ctx cctx_give_back_token ;
  1613. $ast
  1614. @ast ctx "]" cctx_parse_ast1 = ;
  1615. @length ctx lctx ast ast_eval_compile = ;
  1616. ast ast_destroy ;
  1617. @tok ctx cctx_get_token_or_fail = ;
  1618. }
  1619. tok "]" strcmp 0 == "_cctx_parse_declarator: expected ] after array subscript" assert_msg ;
  1620. if ctx lctx type_idx ret_type_idx ret_name 0 _cctx_parse_declarator {
  1621. @type_idx ret_type_idx ** = ;
  1622. }
  1623. ret_type_idx ctx type_idx length cctx_get_array_type = ;
  1624. @processed 1 = ;
  1625. }
  1626. # Parse the actual declarator identifier
  1627. if tok is_valid_identifier {
  1628. if ctx lctx type_idx ret_type_idx ret_name ret_arg_names _cctx_parse_declarator ! {
  1629. ret_type_idx type_idx = ;
  1630. }
  1631. ret_name ** 0 == "_cctx_parse_declarator: more than one identifier found" assert_msg ;
  1632. ret_name tok = ;
  1633. @processed 1 = ;
  1634. }
  1635. if processed ! {
  1636. ctx cctx_give_back_token ;
  1637. #"_cctx_parse_declarator: failed\n" log ;
  1638. 0 ret ;
  1639. }
  1640. #"_cctx_parse_declarator: success\n" log ;
  1641. 1 ret ;
  1642. }
  1643. fun cctx_parse_declarator 6 {
  1644. $ctx
  1645. $lctx
  1646. $type_idx
  1647. $ret_type_idx
  1648. $ret_name
  1649. $ret_arg_names
  1650. @ctx 5 param = ;
  1651. @lctx 4 param = ;
  1652. @type_idx 3 param = ;
  1653. @ret_type_idx 2 param = ;
  1654. @ret_name 1 param = ;
  1655. @ret_arg_names 0 param = ;
  1656. ret_name 0 = ;
  1657. ctx lctx type_idx ret_type_idx ret_name ret_arg_names _cctx_parse_declarator ret ;
  1658. }
  1659. fun cctx_type_footprint 2 {
  1660. $ctx
  1661. $type_idx
  1662. @ctx 1 param = ;
  1663. @type_idx 0 param = ;
  1664. $type
  1665. @type ctx CCTX_TYPES take type_idx vector_at = ;
  1666. $size
  1667. @size type TYPE_SIZE take = ;
  1668. size 0xffffffff != "cctx_type_footprint: type cannot be instantiated" assert_msg ;
  1669. size 1 - 3 | 1 + ret ;
  1670. }
  1671. fun cctx_type_size 2 {
  1672. $ctx
  1673. $type_idx
  1674. @ctx 1 param = ;
  1675. @type_idx 0 param = ;
  1676. $type
  1677. @type ctx CCTX_TYPES take type_idx vector_at = ;
  1678. $size
  1679. @size type TYPE_SIZE take = ;
  1680. size 0xffffffff != "cctx_type_size: type cannot be instantiated" assert_msg ;
  1681. size ret ;
  1682. }
  1683. const STACK_ELEM_NAME 0
  1684. const STACK_ELEM_TYPE_IDX 4
  1685. const STACK_ELEM_LOC 8
  1686. const SIZEOF_STACK_ELEM 12
  1687. fun stack_elem_init 0 {
  1688. $elem
  1689. @elem SIZEOF_STACK_ELEM malloc = ;
  1690. elem ret ;
  1691. }
  1692. fun stack_elem_destroy 1 {
  1693. $elem
  1694. @elem 0 param = ;
  1695. elem free ;
  1696. }
  1697. const LCTX_STACK 0
  1698. const LCTX_RETURN_TYPE_IDX 4
  1699. const LCTX_RETURN_LABEL 8
  1700. const LCTX_BREAK_LABEL 12
  1701. const LCTX_CONTINUE_LABEL 16
  1702. const LCTX_RETURNS_OBJ 20
  1703. const LCTX_GOTO_LABELS 24
  1704. const LCTX_DEFAULT_LABEL 28
  1705. const LCTX_CASE_LABELS 32
  1706. const SIZEOF_LCTX 36
  1707. fun lctx_init 0 {
  1708. $lctx
  1709. @lctx SIZEOF_LCTX malloc = ;
  1710. lctx LCTX_STACK take_addr 4 vector_init = ;
  1711. lctx LCTX_GOTO_LABELS take_addr map_init = ;
  1712. lctx LCTX_DEFAULT_LABEL take_addr 0xffffffff = ;
  1713. lctx LCTX_CASE_LABELS take_addr 0 = ;
  1714. lctx ret ;
  1715. }
  1716. fun lctx_destroy 1 {
  1717. $lctx
  1718. @lctx 0 param = ;
  1719. $stack
  1720. @stack lctx LCTX_STACK take = ;
  1721. $i
  1722. @i 0 = ;
  1723. while i stack vector_size < {
  1724. stack i vector_at stack_elem_destroy ;
  1725. @i i 1 + = ;
  1726. }
  1727. lctx LCTX_STACK take vector_destroy ;
  1728. lctx LCTX_GOTO_LABELS take map_destroy ;
  1729. lctx free ;
  1730. }
  1731. fun lctx_stack_pos 1 {
  1732. $lctx
  1733. @lctx 0 param = ;
  1734. $stack
  1735. @stack lctx LCTX_STACK take = ;
  1736. stack stack vector_size 1 - vector_at STACK_ELEM_LOC take ret ;
  1737. }
  1738. fun lctx_gen_label 2 {
  1739. $lctx
  1740. $ctx
  1741. @lctx 1 param = ;
  1742. @ctx 0 param = ;
  1743. ctx 0xffffffff 0xffffffff cctx_gen_label ret ;
  1744. }
  1745. fun lctx_fix_label 3 {
  1746. $lctx
  1747. $ctx
  1748. $idx
  1749. @lctx 2 param = ;
  1750. @ctx 1 param = ;
  1751. @idx 0 param = ;
  1752. $loc
  1753. $pos
  1754. @loc ctx CCTX_CURRENT_LOC take = ;
  1755. if lctx 0 != {
  1756. @pos lctx lctx_stack_pos = ;
  1757. } else {
  1758. @pos 0 = ;
  1759. }
  1760. ctx idx loc pos cctx_fix_label ;
  1761. }
  1762. fun lctx_get_variable 2 {
  1763. $lctx
  1764. $name
  1765. @lctx 1 param = ;
  1766. @name 0 param = ;
  1767. # Begin scanning the stack from the end, so that inner variables
  1768. # mask outer ones
  1769. $stack
  1770. @stack lctx LCTX_STACK take = ;
  1771. $i
  1772. @i stack vector_size 1 - = ;
  1773. while i 0 >= {
  1774. $elem
  1775. @elem stack i vector_at = ;
  1776. if elem STACK_ELEM_NAME take name strcmp 0 == {
  1777. elem ret ;
  1778. }
  1779. @i i 1 - = ;
  1780. }
  1781. 0 ret ;
  1782. }
  1783. fun lctx_save_status 2 {
  1784. $lctx
  1785. $ctx
  1786. @lctx 1 param = ;
  1787. @ctx 0 param = ;
  1788. lctx LCTX_STACK take vector_size ret ;
  1789. }
  1790. fun lctx_restore_status 3 {
  1791. $lctx
  1792. $ctx
  1793. $status
  1794. @lctx 2 param = ;
  1795. @ctx 1 param = ;
  1796. @status 0 param = ;
  1797. $current_pos
  1798. @current_pos lctx lctx_stack_pos = ;
  1799. $stack
  1800. @stack lctx LCTX_STACK take = ;
  1801. status stack vector_size <= "lctx_restore_status: error 1" assert_msg ;
  1802. $new_pos
  1803. @new_pos stack status 1 - vector_at STACK_ELEM_LOC take = ;
  1804. $rewind
  1805. @rewind new_pos current_pos - = ;
  1806. rewind 0 >= "lctx_restore_status: error 2" assert_msg ;
  1807. # add esp, rewind
  1808. ctx 0x81 cctx_emit ;
  1809. ctx 0xc4 cctx_emit ;
  1810. ctx rewind cctx_emit32 ;
  1811. # Drop enough stack elements in excess
  1812. while stack vector_size status > {
  1813. $elem
  1814. @elem stack vector_pop_back = ;
  1815. elem stack_elem_destroy ;
  1816. }
  1817. }
  1818. fun lctx_push_var 3 {
  1819. $lctx
  1820. $ctx
  1821. $type_idx
  1822. $name
  1823. @lctx 3 param = ;
  1824. @ctx 2 param = ;
  1825. @type_idx 1 param = ;
  1826. @name 0 param = ;
  1827. $footprint
  1828. @footprint ctx type_idx cctx_type_footprint = ;
  1829. $new_pos
  1830. @new_pos lctx lctx_stack_pos footprint - = ;
  1831. $elem
  1832. @elem stack_elem_init = ;
  1833. elem STACK_ELEM_NAME take_addr name = ;
  1834. elem STACK_ELEM_TYPE_IDX take_addr type_idx = ;
  1835. elem STACK_ELEM_LOC take_addr new_pos = ;
  1836. lctx LCTX_STACK take elem vector_push_back ;
  1837. # sub esp, footprint
  1838. ctx 0x81 cctx_emit ;
  1839. ctx 0xec cctx_emit ;
  1840. ctx footprint cctx_emit32 ;
  1841. }
  1842. fun lctx_prime_stack 3 {
  1843. $lctx
  1844. $ctx
  1845. $type_idx
  1846. $arg_names
  1847. @lctx 3 param = ;
  1848. @ctx 2 param = ;
  1849. @type_idx 1 param = ;
  1850. @arg_names 0 param = ;
  1851. $type
  1852. @type ctx type_idx cctx_get_type = ;
  1853. type TYPE_KIND take TYPE_KIND_FUNCTION == "lctx_prime_stack: type is not a function" assert_msg ;
  1854. $args
  1855. @args type TYPE_ARGS take = ;
  1856. args vector_size arg_names vector_size == "lctx_prime_stack: error 1" assert_msg ;
  1857. $stack
  1858. @stack lctx LCTX_STACK take = ;
  1859. $return_type_idx
  1860. @return_type_idx type TYPE_BASE take = ;
  1861. $return_type
  1862. @return_type ctx return_type_idx cctx_get_type = ;
  1863. lctx LCTX_RETURNS_OBJ take_addr return_type TYPE_KIND take TYPE_KIND_STRUCT == return_type TYPE_KIND take TYPE_KIND_UNION == || = ;
  1864. return_type_idx TYPE_VOID == return_type_idx is_integer_type || return_type TYPE_KIND take TYPE_KIND_POINTER == || return_type TYPE_KIND take TYPE_KIND_STRUCT == || return_type TYPE_KIND take TYPE_KIND_UNION == || "cctx_compile_function: return type must be void, integer, pointer, struct or union" assert_msg ;
  1865. # Base footprint contains the saved EBP and return value; if the
  1866. # function returns an object, it contains also the returned value
  1867. # address
  1868. $base_footprint
  1869. @base_footprint 8 = ;
  1870. if return_type TYPE_KIND take TYPE_KIND_UNION == return_type TYPE_KIND take TYPE_KIND_STRUCT == || {
  1871. @base_footprint base_footprint 4 + = ;
  1872. }
  1873. $i
  1874. @i 0 = ;
  1875. $total_footprint
  1876. @total_footprint 0 = ;
  1877. while i args vector_size < {
  1878. @total_footprint total_footprint ctx args i vector_at cctx_type_footprint + = ;
  1879. @i i 1 + = ;
  1880. }
  1881. $loc
  1882. @loc total_footprint base_footprint + = ;
  1883. @i args vector_size 1 - = ;
  1884. while i 0 >= {
  1885. $this_type_idx
  1886. @this_type_idx args i vector_at = ;
  1887. $name
  1888. @name arg_names i vector_at = ;
  1889. name 0 != "lctx_prime_stack: name cannot be empty" assert_msg ;
  1890. @loc loc ctx this_type_idx cctx_type_footprint - = ;
  1891. $elem
  1892. @elem stack_elem_init = ;
  1893. elem STACK_ELEM_NAME take_addr name = ;
  1894. elem STACK_ELEM_TYPE_IDX take_addr this_type_idx = ;
  1895. elem STACK_ELEM_LOC take_addr loc = ;
  1896. stack elem vector_push_back ;
  1897. @i i 1 - = ;
  1898. }
  1899. loc base_footprint == "lctx_prime_stack: error 2" assert_msg ;
  1900. # Add a fictious element to mark the beginning of local variables
  1901. $elem
  1902. @elem stack_elem_init = ;
  1903. elem STACK_ELEM_NAME take_addr "" = ;
  1904. elem STACK_ELEM_TYPE_IDX take_addr 0 = ;
  1905. elem STACK_ELEM_LOC take_addr 0 = ;
  1906. stack elem vector_push_back ;
  1907. }
  1908. fun lctx_gen_prologue 2 {
  1909. $lctx
  1910. $ctx
  1911. @lctx 1 param = ;
  1912. @ctx 0 param = ;
  1913. # push ebp; mov ebp, esp
  1914. ctx 0x55 cctx_emit ;
  1915. ctx 0x89 cctx_emit ;
  1916. ctx 0xe5 cctx_emit ;
  1917. }
  1918. fun lctx_gen_epilogue 2 {
  1919. $lctx
  1920. $ctx
  1921. @lctx 1 param = ;
  1922. @ctx 0 param = ;
  1923. if lctx LCTX_RETURNS_OBJ take {
  1924. # mov eax, [ebp+8]; pop ebp; ret 4
  1925. ctx 0x8b cctx_emit ;
  1926. ctx 0x45 cctx_emit ;
  1927. ctx 0x08 cctx_emit ;
  1928. ctx 0x5d cctx_emit ;
  1929. ctx 0xc2 cctx_emit ;
  1930. ctx 0x04 cctx_emit ;
  1931. ctx 0x00 cctx_emit ;
  1932. } else {
  1933. # pop ebp; ret
  1934. ctx 0x5d cctx_emit ;
  1935. ctx 0xc3 cctx_emit ;
  1936. }
  1937. }
  1938. fun cctx_write_label 2 {
  1939. $ctx
  1940. $idx
  1941. @ctx 1 param = ;
  1942. @idx 0 param = ;
  1943. $buf
  1944. @buf ctx CCTX_LABEL_BUF take = ;
  1945. buf '.' =c ;
  1946. buf 1 + 'L' =c ;
  1947. idx itoa buf 2 + strcpy ;
  1948. buf ret ;
  1949. }
  1950. fun cctx_gen_label 3 {
  1951. $ctx
  1952. $loc
  1953. $pos
  1954. @ctx 2 param = ;
  1955. @loc 1 param = ;
  1956. @pos 0 param = ;
  1957. $label_pos
  1958. @label_pos ctx CCTX_LABEL_POS take = ;
  1959. $idx
  1960. @idx ctx CCTX_LABEL_NUM take = ;
  1961. $name
  1962. @name ctx idx cctx_write_label = ;
  1963. if ctx CCTX_STAGE take 0 == {
  1964. idx label_pos vector_size == "cctx_gen_label: error 2" assert_msg ;
  1965. label_pos pos vector_push_back ;
  1966. ctx name loc TYPE_VOID cctx_add_global ;
  1967. } else {
  1968. idx label_pos vector_size < "cctx_gen_label: error 1" assert_msg ;
  1969. if pos 0xffffffff != {
  1970. label_pos idx vector_at pos == "cctx_gen_label: error 3" assert_msg ;
  1971. }
  1972. if ctx CCTX_STAGE take 2 == {
  1973. # Check that in the end the label position has been set
  1974. # (otherwise the label was never actually defined)
  1975. label_pos idx vector_at 0xffffffff != "cctx_gen_label: label never defined" assert_msg ;
  1976. }
  1977. ctx name loc TYPE_VOID cctx_add_global ;
  1978. }
  1979. ctx CCTX_LABEL_NUM take_addr idx 1 + = ;
  1980. idx ret ;
  1981. }
  1982. fun cctx_fix_label 4 {
  1983. $ctx
  1984. $idx
  1985. $loc
  1986. $pos
  1987. @ctx 3 param = ;
  1988. @idx 2 param = ;
  1989. @loc 1 param = ;
  1990. @pos 0 param = ;
  1991. $label_pos
  1992. @label_pos ctx CCTX_LABEL_POS take = ;
  1993. $name
  1994. @name ctx idx cctx_write_label = ;
  1995. ctx name loc TYPE_VOID cctx_add_global ;
  1996. if ctx CCTX_STAGE take 0 == {
  1997. label_pos idx vector_at_addr pos = ;
  1998. } else {
  1999. label_pos idx vector_at pos == "cctx_fix_label: error 1" assert_msg ;
  2000. }
  2001. }
  2002. const JUMP_TYPE_JMP 0
  2003. const JUMP_TYPE_CALL 1
  2004. const JUMP_TYPE_JZ 2
  2005. const JUMP_TYPE_JNZ 3
  2006. fun cctx_gen_jump_loc 3 {
  2007. $ctx
  2008. $target_loc
  2009. $type
  2010. @ctx 2 param = ;
  2011. @target_loc 1 param = ;
  2012. @type 0 param = ;
  2013. if type JUMP_TYPE_JMP == {
  2014. # jmp rel
  2015. ctx 0xe9 cctx_emit ;
  2016. } else {
  2017. if type JUMP_TYPE_CALL == {
  2018. # call rel
  2019. ctx 0xe8 cctx_emit ;
  2020. } else {
  2021. if type JUMP_TYPE_JZ == {
  2022. # jz rel
  2023. ctx 0x0f cctx_emit ;
  2024. ctx 0x84 cctx_emit ;
  2025. } else {
  2026. if type JUMP_TYPE_JNZ == {
  2027. # jnz rel
  2028. ctx 0x0f cctx_emit ;
  2029. ctx 0x85 cctx_emit ;
  2030. } else {
  2031. 0 "cctx_gen_dump: error 1" assert_msg ;
  2032. }
  2033. }
  2034. }
  2035. }
  2036. $current_loc
  2037. @current_loc ctx CCTX_CURRENT_LOC take 4 + = ;
  2038. $rel
  2039. @rel target_loc current_loc - = ;
  2040. ctx rel cctx_emit32 ;
  2041. }
  2042. fun cctx_gen_jump 3 {
  2043. $ctx
  2044. $name
  2045. $type
  2046. @ctx 2 param = ;
  2047. @name 1 param = ;
  2048. @type 0 param = ;
  2049. $global
  2050. @global ctx name cctx_get_global = ;
  2051. $target_loc
  2052. @target_loc global GLOBAL_LOC take = ;
  2053. ctx target_loc type cctx_gen_jump_loc ;
  2054. }
  2055. fun cctx_gen_label_jump 5 {
  2056. $ctx
  2057. $lctx
  2058. $idx
  2059. $type
  2060. $rewind
  2061. @ctx 4 param = ;
  2062. @lctx 3 param = ;
  2063. @idx 2 param = ;
  2064. @type 1 param = ;
  2065. @rewind 0 param = ;
  2066. $current_pos
  2067. if lctx 0 != {
  2068. @current_pos lctx lctx_stack_pos = ;
  2069. } else {
  2070. @current_pos 0 = ;
  2071. }
  2072. $new_pos
  2073. @new_pos ctx CCTX_LABEL_POS take idx vector_at = ;
  2074. $pos_diff
  2075. @pos_diff new_pos current_pos - = ;
  2076. $name
  2077. @name ctx idx cctx_write_label = ;
  2078. # When rewinding on a conditional jump, the add will modify the
  2079. # flags, so we have to back them up
  2080. if rewind {
  2081. if type JUMP_TYPE_JZ == type JUMP_TYPE_JNZ == || {
  2082. # lahf
  2083. ctx 0x9f cctx_emit ;
  2084. }
  2085. # add esp, pos_diff; cctx_gen_jump
  2086. ctx 0x81 cctx_emit ;
  2087. ctx 0xc4 cctx_emit ;
  2088. ctx pos_diff cctx_emit32 ;
  2089. if type JUMP_TYPE_JZ == type JUMP_TYPE_JNZ == || {
  2090. # sahf
  2091. ctx 0x9e cctx_emit ;
  2092. }
  2093. }
  2094. ctx name type cctx_gen_jump ;
  2095. }
  2096. fun cctx_get_label_addr 3 {
  2097. $ctx
  2098. $lctx
  2099. $idx
  2100. @ctx 2 param = ;
  2101. @lctx 1 param = ;
  2102. @idx 0 param = ;
  2103. $name
  2104. @name ctx idx cctx_write_label = ;
  2105. $global
  2106. @global ctx name cctx_get_global = ;
  2107. global GLOBAL_LOC take ret ;
  2108. }
  2109. fun string_unescaped_len 1 {
  2110. $s
  2111. @s 0 param = ;
  2112. $i
  2113. @i 0 = ;
  2114. s **c '\"' == "string_unescaped_len: not a string literal" assert_msg ;
  2115. @s s 1 + = ;
  2116. while s **c '\"' != {
  2117. @s 1 0 escape_char ;
  2118. @i i 1 + = ;
  2119. }
  2120. @s s 1 + = ;
  2121. s **c '\0' == "string_unescaped_len: illegal string literal" assert_msg ;
  2122. i ret ;
  2123. }
  2124. fun cctx_gen_string 3 {
  2125. $ctx
  2126. $lctx
  2127. $name
  2128. @ctx 2 param = ;
  2129. @lctx 1 param = ;
  2130. @name 0 param = ;
  2131. $str_label
  2132. $label
  2133. @str_label lctx ctx lctx_gen_label = ;
  2134. @label lctx ctx lctx_gen_label = ;
  2135. ctx lctx label JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  2136. lctx ctx str_label lctx_fix_label ;
  2137. $from
  2138. @from name 1 + = ;
  2139. while from **c '\"' != {
  2140. @from 0 ctx escape_char ;
  2141. }
  2142. from 1 + **c 0 == "cctx_gen_string: illegal string literal" assert_msg ;
  2143. ctx 0 cctx_emit ;
  2144. lctx ctx label lctx_fix_label ;
  2145. str_label ret ;
  2146. }
  2147. ifun ast_eval_compile_ext 2
  2148. fun ast_eval_compile 3 {
  2149. $ctx
  2150. $lctx
  2151. $ast
  2152. @ctx 2 param = ;
  2153. @lctx 1 param = ;
  2154. @ast 0 param = ;
  2155. $extctx
  2156. @extctx 8 malloc = ;
  2157. extctx ctx = ;
  2158. extctx 4 + lctx = ;
  2159. $value
  2160. @value ast @ast_eval_compile_ext extctx ast_eval = ;
  2161. value "ast_eval_compile: failed" assert_msg ;
  2162. extctx free ;
  2163. value ** ret ;
  2164. }
  2165. ifun ast_strtoll 1
  2166. ifun ast_eval_type 3
  2167. fun ast_eval_compile_ext 2 {
  2168. $extctx
  2169. $ast
  2170. @extctx 1 param = ;
  2171. @ast 0 param = ;
  2172. $ctx
  2173. $lctx
  2174. @ctx extctx ** = ;
  2175. @lctx extctx 4 + ** = ;
  2176. $name
  2177. @name ast AST_NAME take = ;
  2178. # "ast_eval_compile_ext: " log ;
  2179. # name log ;
  2180. # "\n" log ;
  2181. if ast AST_TYPE take 0 == {
  2182. $value
  2183. @value i64_init = ;
  2184. # Operand
  2185. if name is_valid_identifier {
  2186. $enum_consts
  2187. @enum_consts ctx CCTX_ENUM_CONSTS take = ;
  2188. if enum_consts name map_has {
  2189. value enum_consts name map_at i64_from_32 ;
  2190. } else {
  2191. $global
  2192. @global ctx name cctx_get_global = ;
  2193. $loc
  2194. @loc global GLOBAL_LOC take = ;
  2195. $type_idx
  2196. @type_idx global GLOBAL_TYPE_IDX take = ;
  2197. $type
  2198. @type ctx type_idx cctx_get_type = ;
  2199. if type TYPE_KIND take TYPE_KIND_ARRAY == type TYPE_KIND take TYPE_KIND_FUNCTION == || {
  2200. value loc i64_from_u32 ;
  2201. } else {
  2202. ctx type_idx cctx_type_footprint 4 == "ast_eval_compile_ext: unsupported global" assert_msg ;
  2203. value loc ** i64_from_u32 ;
  2204. }
  2205. }
  2206. } else {
  2207. if name **c '\"' == {
  2208. $str_label
  2209. @str_label ctx 0 name cctx_gen_string = ;
  2210. value ctx 0 str_label cctx_get_label_addr i64_from_u32 ;
  2211. } else {
  2212. value i64_destroy ;
  2213. ast ast_strtoll ;
  2214. @value ast AST_VALUE take = ;
  2215. }
  2216. }
  2217. value ret ;
  2218. } else {
  2219. # Operator
  2220. if name "sizeof_PRE" strcmp 0 == {
  2221. $value
  2222. @value i64_init = ;
  2223. $sub_type_idx
  2224. @sub_type_idx ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2225. if ast AST_RIGHT take AST_ORIG_TYPE_IDX take 0xffffffff != {
  2226. @sub_type_idx ast AST_RIGHT take AST_ORIG_TYPE_IDX take = ;
  2227. }
  2228. value ctx sub_type_idx cctx_type_size i64_from_u32 ;
  2229. value ret ;
  2230. }
  2231. if name "(_PRE" strcmp 0 == {
  2232. $type_idx
  2233. @type_idx ast AST_CAST_TYPE_IDX take = ;
  2234. $type
  2235. @type ctx type_idx cctx_get_type = ;
  2236. if type TYPE_KIND take TYPE_KIND_POINTER == {
  2237. @type_idx TYPE_UINT = ;
  2238. }
  2239. type_idx is_integer_type "ast_eval_compile_ext: invalid cast to non-integer type" assert_msg ;
  2240. $value
  2241. @value i64_init = ;
  2242. value ast AST_RIGHT take @ast_eval_compile_ext extctx ast_eval i64_copy ;
  2243. $size
  2244. @size ctx type_idx cctx_type_size = ;
  2245. if size 1 == {
  2246. value i64_cast_to_u8 ;
  2247. } else {
  2248. if size 2 == {
  2249. value i64_cast_to_u16 ;
  2250. } else {
  2251. if size 4 == {
  2252. value i64_cast_to_u32 ;
  2253. } else {
  2254. if size 8 == {
  2255. # Nothing to do here...
  2256. } else {
  2257. 0 "ast_eval_compile_ext: error 1" assert_msg ;
  2258. }
  2259. }
  2260. }
  2261. }
  2262. value ret ;
  2263. }
  2264. # Implement the special case &(((type*)x)->y) which is used in macro
  2265. # offsetof()
  2266. if name "&_PRE" strcmp 0 == {
  2267. $ast2
  2268. @ast2 ast AST_RIGHT take = ;
  2269. $name2
  2270. @name2 ast2 AST_NAME take = ;
  2271. name2 "->" strcmp 0 == "ast_eval_compile_ext: & not taken on ->" name2 assert_msg_str ;
  2272. $field
  2273. @field ast2 AST_RIGHT take AST_NAME take = ;
  2274. $ast3
  2275. @ast3 ast2 AST_LEFT take = ;
  2276. $name3
  2277. @name3 ast3 AST_NAME take = ;
  2278. name3 "(_PRE" strcmp 0 == "ast_eval_compile_ext: & not taken on cast" name3 assert_msg_str ;
  2279. $type_idx
  2280. @type_idx ast3 AST_CAST_TYPE_IDX take = ;
  2281. $type
  2282. @type ctx type_idx cctx_get_type = ;
  2283. type TYPE_KIND take TYPE_KIND_POINTER == "ast_eval_compile_ext: & not taken on cast to pointer" assert_msg ;
  2284. $base_type
  2285. @base_type ctx type TYPE_BASE take cctx_get_type = ;
  2286. base_type TYPE_KIND take TYPE_KIND_STRUCT == base_type TYPE_KIND take TYPE_KIND_UNION == || "ast_eval_compile_ext: & not taken on cast to pointer to struct" assert_msg ;
  2287. $idx
  2288. @idx base_type field type_get_idx = ;
  2289. $value2
  2290. @value2 i64_init = ;
  2291. value2 base_type TYPE_FIELDS_OFFS take idx vector_at i64_from_u32 ;
  2292. $value
  2293. @value i64_init = ;
  2294. value ast3 @ast_eval_compile_ext extctx ast_eval i64_copy ;
  2295. value value2 i64_add ;
  2296. value2 i64_destroy ;
  2297. value ret ;
  2298. }
  2299. 0 ret ;
  2300. }
  2301. 0 "ast_eval_compile_ext: should not arrive here" assert_msg ;
  2302. }
  2303. fun promote_integer_type 1 {
  2304. $type
  2305. @type 0 param = ;
  2306. if type TYPE_BOOL ==
  2307. type TYPE_CHAR == ||
  2308. type TYPE_SCHAR == ||
  2309. type TYPE_UCHAR == ||
  2310. type TYPE_SHORT == ||
  2311. type TYPE_INT == ||
  2312. type TYPE_USHORT == || {
  2313. TYPE_INT ret ;
  2314. }
  2315. if type TYPE_UINT == {
  2316. TYPE_UINT ret ;
  2317. }
  2318. if type TYPE_LONG == {
  2319. TYPE_LONG ret ;
  2320. }
  2321. if type TYPE_ULONG == {
  2322. TYPE_ULONG ret ;
  2323. }
  2324. 0 "promote_integer_type: not an integer type" assert_msg ;
  2325. }
  2326. fun ast_arith_conv 4 {
  2327. $ast1
  2328. $ast2
  2329. $ctx
  2330. $lctx
  2331. @ast1 3 param = ;
  2332. @ast2 2 param = ;
  2333. @ctx 1 param = ;
  2334. @lctx 0 param = ;
  2335. $type1
  2336. $type2
  2337. @type1 ast1 ctx lctx ast_eval_type = ;
  2338. @type2 ast2 ctx lctx ast_eval_type = ;
  2339. # As an exception to the standard, automatically convert every
  2340. # pointer to an unsigned int
  2341. if ctx type1 cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == {
  2342. @type1 TYPE_UINT = ;
  2343. }
  2344. if ctx type2 cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == {
  2345. @type2 TYPE_UINT = ;
  2346. }
  2347. @type1 type1 promote_integer_type = ;
  2348. @type2 type2 promote_integer_type = ;
  2349. if type1 type2 == {
  2350. type1 ret ;
  2351. }
  2352. if type1 TYPE_UINT == type2 TYPE_INT == &&
  2353. type2 TYPE_UINT == type1 TYPE_INT == && || {
  2354. TYPE_UINT ret ;
  2355. }
  2356. if type1 TYPE_ULONG == type2 TYPE_LONG == &&
  2357. type2 TYPE_ULONG == type1 TYPE_LONG == && || {
  2358. TYPE_ULONG ret ;
  2359. }
  2360. if type1 TYPE_UINT == type2 TYPE_ULONG == &&
  2361. type2 TYPE_UINT == type1 TYPE_ULONG == && || {
  2362. TYPE_ULONG ret ;
  2363. }
  2364. if type1 TYPE_INT == type2 TYPE_LONG == &&
  2365. type2 TYPE_INT == type1 TYPE_LONG == && || {
  2366. TYPE_LONG ret ;
  2367. }
  2368. if type1 TYPE_INT == type2 TYPE_ULONG == &&
  2369. type2 TYPE_INT == type1 TYPE_ULONG == && || {
  2370. TYPE_ULONG ret ;
  2371. }
  2372. if type1 TYPE_UINT == type2 TYPE_LONG == &&
  2373. type2 TYPE_UINT == type1 TYPE_LONG == && || {
  2374. TYPE_LONG ret ;
  2375. }
  2376. 0 "ast_arith_conv: error 1" type1 type2 assert_msg_int_int ;
  2377. }
  2378. fun i64_fits_in 2 {
  2379. $i
  2380. $type_idx
  2381. @i 1 param = ;
  2382. @type_idx 0 param = ;
  2383. if type_idx TYPE_ULONG == { 1 ret ; }
  2384. if type_idx TYPE_LONG == { i i64_to_upper32 0x80000000 & 0 == ret ; }
  2385. if type_idx TYPE_UINT == { i i64_to_upper32 0 == ret ; }
  2386. if type_idx TYPE_INT == { i i64_to_upper32 0 == i i64_to_32 0x80000000 & 0 == && ret ; }
  2387. 0 "i64_fits_in: unsupported type" assert_msg ;
  2388. }
  2389. fun ast_strtoll 1 {
  2390. $ast
  2391. @ast 0 param = ;
  2392. $name
  2393. @name ast AST_NAME take = ;
  2394. if name **c '\'' == {
  2395. $data
  2396. $from
  2397. $to
  2398. @data 0 = ;
  2399. @from name 1 + = ;
  2400. @to @data = ;
  2401. @from @to 0 escape_char ;
  2402. to @data 1 + == "ast_push_value: invalid character literal 1" assert_msg ;
  2403. from **c '\'' == "ast_push_value: invalid character literal 2" assert_msg ;
  2404. from 1 + **c 0 == "ast_push_value: invalid character literal 3" assert_msg ;
  2405. $value
  2406. @value i64_init = ;
  2407. value data i64_from_32 ;
  2408. ast AST_VALUE take_addr value = ;
  2409. ast AST_TYPE_IDX take_addr TYPE_INT = ;
  2410. ret ;
  2411. }
  2412. $suffix
  2413. $value
  2414. @value name @suffix c_strtoll = ;
  2415. # FIXME Why is it called twice on the same AST?
  2416. if ast AST_VALUE take 0 != {
  2417. ast AST_VALUE take i64_destroy ;
  2418. }
  2419. ast AST_VALUE take_addr value = ;
  2420. # Decode suffix
  2421. $u_num
  2422. $l_num
  2423. @u_num 0 = ;
  2424. @l_num 0 = ;
  2425. while suffix **c '\0' != {
  2426. $c
  2427. @c suffix **c = ;
  2428. if c 'u' == c 'U' == || {
  2429. @u_num u_num 1 + = ;
  2430. } else {
  2431. if c 'l' == c 'L' == || {
  2432. @l_num l_num 1 + = ;
  2433. } else {
  2434. 0 "ast_strtoll: invalid suffix letter" name assert_msg_str ;
  2435. }
  2436. }
  2437. @suffix suffix 1 + = ;
  2438. }
  2439. 0 u_num <= u_num 1 <= && "ast_strtoll: too many U suffixes" assert_msg ;
  2440. 0 l_num <= l_num 2 <= && "ast_strtoll: too many L suffixes" assert_msg ;
  2441. # (Re)decode prefix
  2442. $dec
  2443. @dec ast AST_NAME take **c '0' != = ;
  2444. # Ok, now we are ready to assign a type to the expression
  2445. $type_idx
  2446. if u_num 1 == {
  2447. if l_num 2 == {
  2448. @type_idx TYPE_ULONG = ;
  2449. } else {
  2450. if value TYPE_UINT i64_fits_in {
  2451. @type_idx TYPE_UINT = ;
  2452. } else {
  2453. @type_idx TYPE_ULONG = ;
  2454. }
  2455. }
  2456. } else {
  2457. if l_num 2 == {
  2458. if dec {
  2459. @type_idx TYPE_LONG = ;
  2460. } else {
  2461. if value TYPE_LONG i64_fits_in {
  2462. @type_idx TYPE_LONG = ;
  2463. } else {
  2464. @type_idx TYPE_ULONG = ;
  2465. }
  2466. }
  2467. } else {
  2468. if dec {
  2469. if value TYPE_INT i64_fits_in {
  2470. @type_idx TYPE_INT = ;
  2471. } else {
  2472. if value TYPE_LONG i64_fits_in {
  2473. @type_idx TYPE_LONG = ;
  2474. } else {
  2475. @type_idx TYPE_ULONG = ;
  2476. }
  2477. }
  2478. } else {
  2479. if value TYPE_INT i64_fits_in {
  2480. @type_idx TYPE_INT = ;
  2481. } else {
  2482. if value TYPE_UINT i64_fits_in {
  2483. @type_idx TYPE_UINT = ;
  2484. } else {
  2485. if value TYPE_LONG i64_fits_in {
  2486. @type_idx TYPE_LONG = ;
  2487. } else {
  2488. @type_idx TYPE_ULONG = ;
  2489. }
  2490. }
  2491. }
  2492. }
  2493. }
  2494. }
  2495. ast AST_TYPE_IDX take_addr type_idx = ;
  2496. }
  2497. fun ast_eval_type 3 {
  2498. $ast
  2499. $ctx
  2500. $lctx
  2501. @ast 2 param = ;
  2502. @ctx 1 param = ;
  2503. @lctx 0 param = ;
  2504. if ast AST_TYPE_IDX take 0xffffffff != {
  2505. ast AST_TYPE_IDX take ret ;
  2506. }
  2507. $name
  2508. @name ast AST_NAME take = ;
  2509. $type_idx
  2510. $common_type_idx
  2511. @common_type_idx 0xffffffff = ;
  2512. if ast AST_TYPE take 0 == {
  2513. # Operand
  2514. if name is_valid_identifier {
  2515. # Search among enum constants
  2516. $enum_consts
  2517. @enum_consts ctx CCTX_ENUM_CONSTS take = ;
  2518. if enum_consts name map_has name "sizeof" strcmp 0 == || {
  2519. @type_idx TYPE_INT = ;
  2520. } else {
  2521. # Search in local stack and among globals
  2522. $elem
  2523. if lctx 0 != {
  2524. @elem lctx name lctx_get_variable = ;
  2525. } else {
  2526. @elem 0 = ;
  2527. }
  2528. if elem {
  2529. @type_idx elem STACK_ELEM_TYPE_IDX take = ;
  2530. } else {
  2531. $global
  2532. @global ctx name cctx_get_global = ;
  2533. @type_idx global GLOBAL_TYPE_IDX take = ;
  2534. }
  2535. }
  2536. } else {
  2537. if name **c '\"' == {
  2538. @type_idx ctx TYPE_CHAR name string_unescaped_len 1 + cctx_get_array_type = ;
  2539. } else {
  2540. ast ast_strtoll ;
  2541. @type_idx ast AST_TYPE_IDX take = ;
  2542. }
  2543. }
  2544. } else {
  2545. # Operator
  2546. $processed
  2547. @processed 0 = ;
  2548. $sum
  2549. $subtract
  2550. $assign
  2551. @sum name "+" strcmp 0 == name "+=" strcmp 0 == || = ;
  2552. @subtract name "-" strcmp 0 == name "-=" strcmp 0 == || = ;
  2553. @assign name "+=" strcmp 0 == name "-=" strcmp 0 == || = ;
  2554. if sum subtract ||
  2555. processed ! && {
  2556. $left_idx
  2557. $right_idx
  2558. @left_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2559. @right_idx ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2560. $left_ptr
  2561. $right_ptr
  2562. @left_ptr ctx left_idx cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == = ;
  2563. @right_ptr ctx right_idx cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == = ;
  2564. $left_size
  2565. $right_size
  2566. if left_ptr {
  2567. # Allow void to be considered of size 1
  2568. if ctx left_idx cctx_get_type TYPE_BASE take TYPE_VOID == {
  2569. @left_size 1 = ;
  2570. } else {
  2571. @left_size ctx ctx left_idx cctx_get_type TYPE_BASE take cctx_type_size = ;
  2572. }
  2573. }
  2574. if right_ptr {
  2575. if ctx right_idx cctx_get_type TYPE_BASE take TYPE_VOID == {
  2576. @right_size 1 = ;
  2577. } else {
  2578. @right_size ctx ctx right_idx cctx_get_type TYPE_BASE take cctx_type_size = ;
  2579. }
  2580. }
  2581. if sum {
  2582. left_ptr right_ptr && ! "ast_eval_type: cannot take sum of two pointers" assert_msg ;
  2583. if left_ptr {
  2584. right_idx is_integer_type "ast_eval_type: cannot add pointer and non-integer" assert_msg ;
  2585. @type_idx left_idx = ;
  2586. @processed 1 = ;
  2587. }
  2588. if right_ptr {
  2589. assign ! "ast_eval_type: right of sum-assign must be integer" assert_msg ;
  2590. left_idx is_integer_type "ast_eval_type: cannot add pointer and non-integer" assert_msg ;
  2591. @type_idx right_idx = ;
  2592. @processed 1 = ;
  2593. }
  2594. } else {
  2595. left_ptr ! right_ptr && ! "ast_eval_type: cannot take different of a non-pointer and a pointer" assert_msg ;
  2596. if left_ptr {
  2597. if right_ptr {
  2598. assign ! "ast_eval_type: right of subtract-assign must be integer" assert_msg ;
  2599. left_size right_size == "ast_eval_type: cannot take difference of pointers to types of different size" assert_msg ;
  2600. @type_idx TYPE_INT = ;
  2601. } else {
  2602. right_idx is_integer_type "ast_eval_type: cannot subtract pointer and non-integer" assert_msg ;
  2603. @type_idx left_idx = ;
  2604. }
  2605. @processed 1 = ;
  2606. }
  2607. }
  2608. }
  2609. if name "*" strcmp 0 ==
  2610. name "/" strcmp 0 == ||
  2611. name "%" strcmp 0 == ||
  2612. name "+" strcmp 0 == ||
  2613. name "-" strcmp 0 == ||
  2614. name "&" strcmp 0 == ||
  2615. name "^" strcmp 0 == ||
  2616. name "|" strcmp 0 == ||
  2617. name "*=" strcmp 0 == ||
  2618. name "/=" strcmp 0 == ||
  2619. name "%=" strcmp 0 == ||
  2620. name "+=" strcmp 0 == ||
  2621. name "-=" strcmp 0 == ||
  2622. name "&=" strcmp 0 == ||
  2623. name "^=" strcmp 0 == ||
  2624. name "|=" strcmp 0 == ||
  2625. processed ! && {
  2626. @type_idx ast AST_LEFT take ast AST_RIGHT take ctx lctx ast_arith_conv = ;
  2627. @common_type_idx type_idx = ;
  2628. @processed 1 = ;
  2629. }
  2630. if name "<<" strcmp 0 ==
  2631. name ">>" strcmp 0 == ||
  2632. name "<<=" strcmp 0 == ||
  2633. name ">>=" strcmp 0 == ||
  2634. processed ! && {
  2635. $type1
  2636. $type2
  2637. @type1 ast AST_LEFT take ctx lctx ast_eval_type = ;
  2638. @type2 ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2639. @type1 type1 promote_integer_type = ;
  2640. @type2 type2 promote_integer_type = ;
  2641. @type_idx type1 = ;
  2642. @common_type_idx type_idx = ;
  2643. @processed 1 = ;
  2644. }
  2645. if name "+_PRE" strcmp 0 ==
  2646. name "-_PRE" strcmp 0 == ||
  2647. name "~_PRE" strcmp 0 == ||
  2648. processed ! && {
  2649. @type_idx ast AST_RIGHT take ctx lctx ast_eval_type promote_integer_type = ;
  2650. @common_type_idx type_idx = ;
  2651. @processed 1 = ;
  2652. }
  2653. if name "++_PRE" strcmp 0 ==
  2654. name "++_POST" strcmp 0 == ||
  2655. name "--_PRE" strcmp 0 == ||
  2656. name "--_POST" strcmp 0 == ||
  2657. processed ! && {
  2658. $sub_type_idx
  2659. if name "++_PRE" strcmp 0 == name "--_PRE" strcmp 0 == || {
  2660. @sub_type_idx ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2661. } else {
  2662. @sub_type_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2663. }
  2664. if sub_type_idx is_integer_type {
  2665. @type_idx sub_type_idx promote_integer_type = ;
  2666. } else {
  2667. ctx sub_type_idx cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == "ast_eval_type: argument must be integer or pointer" assert_msg ;
  2668. @type_idx sub_type_idx = ;
  2669. }
  2670. @common_type_idx type_idx = ;
  2671. @processed 1 = ;
  2672. }
  2673. if name "<" strcmp 0 ==
  2674. name ">" strcmp 0 == ||
  2675. name "<=" strcmp 0 == ||
  2676. name ">=" strcmp 0 == ||
  2677. name "==" strcmp 0 == ||
  2678. name "!=" strcmp 0 == ||
  2679. name "&&" strcmp 0 == ||
  2680. name "||" strcmp 0 == ||
  2681. processed ! && {
  2682. $type1
  2683. $type2
  2684. @type1 ast AST_LEFT take ctx lctx ast_eval_type = ;
  2685. @type2 ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2686. type1 is_integer_type ctx type1 cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == || "ast_eval_type: left is neither integer nor pointer" assert_msg ;
  2687. type2 is_integer_type ctx type2 cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == || "ast_eval_type: left is neither integer nor pointer" assert_msg ;
  2688. @type_idx TYPE_INT = ;
  2689. @common_type_idx ast AST_LEFT take ast AST_RIGHT take ctx lctx ast_arith_conv = ;
  2690. @processed 1 = ;
  2691. }
  2692. if name "!_PRE" strcmp 0 ==
  2693. processed ! && {
  2694. $type
  2695. @type ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2696. type is_integer_type ctx type cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == || "ast_eval_type: operand is neither integer nor pointer" assert_msg ;
  2697. @type_idx TYPE_INT = ;
  2698. @common_type_idx type = ;
  2699. if ctx type cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == {
  2700. @common_type_idx TYPE_UINT = ;
  2701. }
  2702. @processed 1 = ;
  2703. }
  2704. if name "=" strcmp 0 == {
  2705. @type_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2706. $orig_type_idx
  2707. @orig_type_idx ast AST_LEFT take AST_ORIG_TYPE_IDX take = ;
  2708. if orig_type_idx 0xffffffff != {
  2709. ctx orig_type_idx cctx_get_type TYPE_KIND take TYPE_KIND_ARRAY != "ast_eval_type: cannot assign to array" assert_msg ;
  2710. }
  2711. @processed 1 = ;
  2712. }
  2713. if name "(" strcmp 0 == {
  2714. $fun_ptr_idx
  2715. $fun_ptr_type
  2716. $fun_idx
  2717. $fun_type
  2718. @fun_ptr_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2719. @fun_ptr_type ctx fun_ptr_idx cctx_get_type = ;
  2720. fun_ptr_type TYPE_KIND take TYPE_KIND_POINTER == "ast_eval_type: left is not a pointer" assert_msg ;
  2721. @fun_idx fun_ptr_type TYPE_BASE take = ;
  2722. @fun_type ctx fun_idx cctx_get_type = ;
  2723. fun_type TYPE_KIND take TYPE_KIND_FUNCTION == "ast_eval_type: left is not a pointer to function" assert_msg ;
  2724. @type_idx fun_type TYPE_BASE take = ;
  2725. @processed 1 = ;
  2726. }
  2727. if name "*_PRE" strcmp 0 == name "[" strcmp 0 == || {
  2728. $ptr_idx
  2729. $ptr_type
  2730. $ptr_ast
  2731. @ptr_ast ast AST_RIGHT take = ;
  2732. if name "[" strcmp 0 == {
  2733. @ptr_idx ptr_ast ctx lctx ast_eval_type = ;
  2734. @ptr_type ctx ptr_idx cctx_get_type = ;
  2735. if ptr_type TYPE_KIND take TYPE_KIND_POINTER != {
  2736. @ptr_ast ast AST_LEFT take = ;
  2737. }
  2738. }
  2739. @ptr_idx ptr_ast ctx lctx ast_eval_type = ;
  2740. @ptr_type ctx ptr_idx cctx_get_type = ;
  2741. ptr_type TYPE_KIND take TYPE_KIND_POINTER == "ast_eval_type: arg not a pointer" assert_msg ;
  2742. @type_idx ptr_type TYPE_BASE take = ;
  2743. @processed 1 = ;
  2744. }
  2745. if name "&_PRE" strcmp 0 == {
  2746. $orig_idx
  2747. @orig_idx ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2748. @type_idx ctx orig_idx cctx_get_pointer_type = ;
  2749. @processed 1 = ;
  2750. }
  2751. if name "." strcmp 0 == {
  2752. $struct_idx
  2753. $struct_type
  2754. @struct_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2755. @struct_type ctx struct_idx cctx_get_type = ;
  2756. ast AST_RIGHT take AST_TYPE take 0 == "ast_eval_type: right is not a plain name" assert_msg ;
  2757. $name
  2758. @name ast AST_RIGHT take AST_NAME take = ;
  2759. $field
  2760. @field struct_type name type_get_idx = ;
  2761. field 0xffffffff != "ast_eval_type: specified field does not exist" assert_msg ;
  2762. @type_idx struct_type TYPE_FIELDS_TYPE_IDXS take field vector_at = ;
  2763. @processed 1 = ;
  2764. }
  2765. if name "->" strcmp 0 == {
  2766. $ptr_idx
  2767. $ptr_type
  2768. $struct_idx
  2769. $struct_type
  2770. @ptr_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2771. @ptr_type ctx ptr_idx cctx_get_type = ;
  2772. ptr_type TYPE_KIND take TYPE_KIND_POINTER == "ast_eval_type: right is not a pointer" assert_msg ;
  2773. @struct_idx ptr_type TYPE_BASE take = ;
  2774. @struct_type ctx struct_idx cctx_get_type = ;
  2775. ast AST_RIGHT take AST_TYPE take 0 == "ast_eval_type: right is not a plain name" assert_msg ;
  2776. $name
  2777. @name ast AST_RIGHT take AST_NAME take = ;
  2778. $field
  2779. @field struct_type name type_get_idx = ;
  2780. field 0xffffffff != "ast_eval_type: specified field does not exist" assert_msg ;
  2781. @type_idx struct_type TYPE_FIELDS_TYPE_IDXS take field vector_at = ;
  2782. @processed 1 = ;
  2783. }
  2784. if name "?" strcmp 0 == {
  2785. $processed2
  2786. @processed2 0 = ;
  2787. $type1
  2788. $type2
  2789. @type1 ast AST_CENTER take ctx lctx ast_eval_type = ;
  2790. @type2 ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2791. # Always allow ternary operator between two things of the same type
  2792. if type1 type2 == {
  2793. @type_idx type1 = ;
  2794. @processed2 1 = ;
  2795. }
  2796. if type1 is_integer_type type2 is_integer_type && {
  2797. @type_idx ast AST_CENTER take ast AST_RIGHT take ctx lctx ast_arith_conv = ;
  2798. @processed2 1 = ;
  2799. }
  2800. $t1
  2801. $t2
  2802. @t1 ctx type1 cctx_get_type = ;
  2803. @t2 ctx type2 cctx_get_type = ;
  2804. if t1 TYPE_KIND take TYPE_KIND_POINTER == t2 TYPE_KIND take TYPE_KIND_POINTER == && {
  2805. if ctx t1 TYPE_BASE take t2 TYPE_BASE take cctx_type_compare {
  2806. @type_idx type1 = ;
  2807. } else {
  2808. # If the pointed types are different, do not bother too much
  2809. # and just return void*
  2810. @type_idx TYPE_VOID_PTR = ;
  2811. }
  2812. @processed2 1 = ;
  2813. }
  2814. processed2 "ast_eval_type: not implemented form of ternary operator" type1 type2 assert_msg_int_int ;
  2815. @processed 1 = ;
  2816. }
  2817. if name "(_PRE" strcmp 0 == {
  2818. @type_idx ast AST_CAST_TYPE_IDX take = ;
  2819. @processed 1 = ;
  2820. }
  2821. if name "sizeof_PRE" strcmp 0 == {
  2822. @type_idx TYPE_INT = ;
  2823. @processed 1 = ;
  2824. }
  2825. if name "," strcmp 0 == {
  2826. $type1
  2827. $type2
  2828. @type1 ast AST_LEFT take ctx lctx ast_eval_type = ;
  2829. @type2 ast AST_RIGHT take ctx lctx ast_eval_type = ;
  2830. @type_idx type2 = ;
  2831. @processed 1 = ;
  2832. }
  2833. processed "ast_eval_type: not implemented" name assert_msg_str ;
  2834. }
  2835. # Process decaying
  2836. $type
  2837. @type ctx type_idx cctx_get_type = ;
  2838. $orig_type_idx
  2839. @orig_type_idx 0xffffffff = ;
  2840. if type TYPE_KIND take TYPE_KIND_ARRAY == {
  2841. @orig_type_idx type_idx = ;
  2842. $base_idx
  2843. @base_idx type TYPE_BASE take = ;
  2844. @type_idx ctx base_idx cctx_get_pointer_type = ;
  2845. }
  2846. if type TYPE_KIND take TYPE_KIND_FUNCTION == {
  2847. @orig_type_idx type_idx = ;
  2848. @type_idx ctx type_idx cctx_get_pointer_type = ;
  2849. }
  2850. @type ctx type_idx cctx_get_type = ;
  2851. # Sanity check
  2852. type_idx TYPE_VOID == type TYPE_SIZE take 0xffffffff != || "ast_eval_type: invalid expression type" assert_msg ;
  2853. ast AST_TYPE_IDX take_addr type_idx = ;
  2854. ast AST_ORIG_TYPE_IDX take_addr orig_type_idx = ;
  2855. ast AST_COMMON_TYPE_IDX take_addr common_type_idx = ;
  2856. type_idx ret ;
  2857. }
  2858. ifun ast_push_value 3
  2859. ifun ast_push_value_ptr 3
  2860. fun ast_push_addr 3 {
  2861. $ast
  2862. $ctx
  2863. $lctx
  2864. @ast 2 param = ;
  2865. @ctx 1 param = ;
  2866. @lctx 0 param = ;
  2867. $name
  2868. @name ast AST_NAME take = ;
  2869. $type_idx
  2870. @type_idx ast ctx lctx ast_eval_type = ;
  2871. if ast AST_TYPE take 0 == {
  2872. # Operand
  2873. if name is_valid_identifier {
  2874. # Search in local stack and among globals
  2875. $elem
  2876. @elem lctx name lctx_get_variable = ;
  2877. if elem {
  2878. # lea eax, [ebp+loc]; push eax
  2879. ctx 0x8d cctx_emit ;
  2880. ctx 0x85 cctx_emit ;
  2881. ctx elem STACK_ELEM_LOC take cctx_emit32 ;
  2882. ctx 0x50 cctx_emit ;
  2883. } else {
  2884. $global
  2885. @global ctx name cctx_get_global = ;
  2886. # push loc
  2887. ctx 0x68 cctx_emit ;
  2888. ctx global GLOBAL_LOC take cctx_emit32 ;
  2889. }
  2890. } else {
  2891. if name **c '\"' == {
  2892. $str_label
  2893. @str_label ctx lctx name cctx_gen_string = ;
  2894. # push str_label
  2895. ctx 0x68 cctx_emit ;
  2896. ctx ctx lctx str_label cctx_get_label_addr cctx_emit32 ;
  2897. } else {
  2898. 0 "ast_push_addr: cannot take the address of an immediate" assert_msg ;
  2899. }
  2900. }
  2901. } else {
  2902. # Operator
  2903. $processed
  2904. @processed 0 = ;
  2905. if name "*_PRE" strcmp 0 == {
  2906. ast AST_RIGHT take ctx lctx ast_push_value ;
  2907. @processed 1 = ;
  2908. }
  2909. if name "." strcmp 0 == {
  2910. $struct_idx
  2911. $struct_type
  2912. @struct_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2913. @struct_type ctx struct_idx cctx_get_type = ;
  2914. ast AST_RIGHT take AST_TYPE take 0 == "ast_push_addr: right is not a plain name" assert_msg ;
  2915. $name
  2916. @name ast AST_RIGHT take AST_NAME take = ;
  2917. $field
  2918. @field struct_type name type_get_idx = ;
  2919. field 0xffffffff != "ast_push_addr: specified field does not exist" assert_msg ;
  2920. $off
  2921. @off struct_type TYPE_FIELDS_OFFS take field vector_at = ;
  2922. # ast_push_addr; pop eax; add eax, off; push eax
  2923. ast AST_LEFT take ctx lctx ast_push_addr ;
  2924. ctx 0x58 cctx_emit ;
  2925. ctx 0x05 cctx_emit ;
  2926. ctx off cctx_emit32 ;
  2927. ctx 0x50 cctx_emit ;
  2928. @processed 1 = ;
  2929. }
  2930. if name "->" strcmp 0 == {
  2931. $ptr_idx
  2932. $ptr_type
  2933. $struct_idx
  2934. $struct_type
  2935. @ptr_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  2936. @ptr_type ctx ptr_idx cctx_get_type = ;
  2937. ptr_type TYPE_KIND take TYPE_KIND_POINTER == "ast_push_addr: right is not a pointer" assert_msg ;
  2938. @struct_idx ptr_type TYPE_BASE take = ;
  2939. @struct_type ctx struct_idx cctx_get_type = ;
  2940. ast AST_RIGHT take AST_TYPE take 0 == "ast_push_addr: right is not a plain name" assert_msg ;
  2941. $name
  2942. @name ast AST_RIGHT take AST_NAME take = ;
  2943. $field
  2944. @field struct_type name type_get_idx = ;
  2945. field 0xffffffff != "ast_push_addr: specified field does not exist" assert_msg ;
  2946. $off
  2947. @off struct_type TYPE_FIELDS_OFFS take field vector_at = ;
  2948. # ast_push_value; pop eax; add eax, off; push eax
  2949. ast AST_LEFT take ctx lctx ast_push_value ;
  2950. ctx 0x58 cctx_emit ;
  2951. ctx 0x05 cctx_emit ;
  2952. ctx off cctx_emit32 ;
  2953. ctx 0x50 cctx_emit ;
  2954. @processed 1 = ;
  2955. }
  2956. if name "[" strcmp 0 == {
  2957. @processed ast ctx lctx ast_push_value_ptr = ;
  2958. }
  2959. processed "ast_push_addr: not implemented" assert_msg ;
  2960. }
  2961. }
  2962. fun lctx_int_convert 4 {
  2963. $lctx
  2964. $ctx
  2965. $from_idx
  2966. $to_idx
  2967. @lctx 3 param = ;
  2968. @ctx 2 param = ;
  2969. @from_idx 1 param = ;
  2970. @to_idx 0 param = ;
  2971. # Treat pointers as integers
  2972. if ctx from_idx cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == {
  2973. @from_idx TYPE_INT = ;
  2974. }
  2975. from_idx is_integer_type "lctx_int_convert: source is not an integer type" from_idx to_idx assert_msg_int_int ;
  2976. to_idx is_integer_type "lctx_int_convert: target is not an integer type" from_idx to_idx assert_msg_int_int ;
  2977. if ctx from_idx cctx_type_footprint 4 == {
  2978. # pop eax
  2979. ctx 0x58 cctx_emit ;
  2980. } else {
  2981. if ctx from_idx cctx_type_footprint 8 == {
  2982. # pop eax; pop edx
  2983. ctx 0x58 cctx_emit ;
  2984. ctx 0x5a cctx_emit ;
  2985. } else {
  2986. 0 "lctx_int_convert: error 1" assert_msg ;
  2987. }
  2988. }
  2989. if from_idx TYPE_CHAR == from_idx TYPE_SCHAR == || {
  2990. # movsx eax, al; cdq
  2991. ctx 0x0f cctx_emit ;
  2992. ctx 0xbe cctx_emit ;
  2993. ctx 0xc0 cctx_emit ;
  2994. ctx 0x99 cctx_emit ;
  2995. } else {
  2996. if from_idx TYPE_UCHAR == {
  2997. # movzx eax, al; xor edx, edx
  2998. ctx 0x0f cctx_emit ;
  2999. ctx 0xb6 cctx_emit ;
  3000. ctx 0xc0 cctx_emit ;
  3001. ctx 0x31 cctx_emit ;
  3002. ctx 0xd2 cctx_emit ;
  3003. } else {
  3004. if from_idx TYPE_SHORT == {
  3005. # movsx eax, ax; cdq
  3006. ctx 0x0f cctx_emit ;
  3007. ctx 0xbf cctx_emit ;
  3008. ctx 0xc0 cctx_emit ;
  3009. ctx 0x99 cctx_emit ;
  3010. } else {
  3011. if from_idx TYPE_USHORT == {
  3012. # movzx eax, ax; xor edx, edx
  3013. ctx 0x0f cctx_emit ;
  3014. ctx 0xb7 cctx_emit ;
  3015. ctx 0xc0 cctx_emit ;
  3016. ctx 0x31 cctx_emit ;
  3017. ctx 0xd2 cctx_emit ;
  3018. } else {
  3019. if from_idx TYPE_INT == {
  3020. # cdq
  3021. ctx 0x99 cctx_emit ;
  3022. } else {
  3023. if from_idx TYPE_UINT == from_idx TYPE_BOOL == || {
  3024. # xor edx, edx
  3025. ctx 0x31 cctx_emit ;
  3026. ctx 0xd2 cctx_emit ;
  3027. } else {
  3028. from_idx TYPE_LONG == from_idx TYPE_ULONG == || "lctx_int_convert: error 2" assert_msg ;
  3029. }
  3030. }
  3031. }
  3032. }
  3033. }
  3034. }
  3035. if to_idx TYPE_BOOL == {
  3036. # or eax, edx; setne al; movzx eax, al
  3037. ctx 0x09 cctx_emit ;
  3038. ctx 0xd0 cctx_emit ;
  3039. ctx 0x0f cctx_emit ;
  3040. ctx 0x95 cctx_emit ;
  3041. ctx 0xc0 cctx_emit ;
  3042. ctx 0x0f cctx_emit ;
  3043. ctx 0xb6 cctx_emit ;
  3044. ctx 0xc0 cctx_emit ;
  3045. }
  3046. if ctx to_idx cctx_type_footprint 4 == {
  3047. # push eax
  3048. ctx 0x50 cctx_emit ;
  3049. } else {
  3050. if ctx to_idx cctx_type_footprint 8 == {
  3051. # push edx; push eax
  3052. ctx 0x52 cctx_emit ;
  3053. ctx 0x50 cctx_emit ;
  3054. } else {
  3055. 0 "lctx_int_convert: error 3" assert_msg ;
  3056. }
  3057. }
  3058. }
  3059. fun lctx_convert_stack 4 {
  3060. $lctx
  3061. $ctx
  3062. $from_idx
  3063. $to_idx
  3064. @lctx 3 param = ;
  3065. @ctx 2 param = ;
  3066. @from_idx 1 param = ;
  3067. @to_idx 0 param = ;
  3068. if ctx from_idx to_idx cctx_type_compare {
  3069. ret ;
  3070. }
  3071. $from_type
  3072. $to_type
  3073. @from_type ctx from_idx cctx_get_type = ;
  3074. @to_type ctx to_idx cctx_get_type = ;
  3075. # Permit all conversions between integers and pointers, just to make
  3076. # it easy
  3077. if from_type TYPE_KIND take TYPE_KIND_POINTER == {
  3078. @from_idx TYPE_UINT = ;
  3079. }
  3080. if to_type TYPE_KIND take TYPE_KIND_POINTER == {
  3081. @to_idx TYPE_UINT = ;
  3082. }
  3083. if from_idx is_integer_type to_idx is_integer_type && {
  3084. lctx ctx from_idx to_idx lctx_int_convert ;
  3085. ret ;
  3086. }
  3087. 0 "lctx_convert_stack: not implemented" from_idx to_idx assert_msg_int_int ;
  3088. }
  3089. fun ast_push_value_logic 3 {
  3090. $ast
  3091. $ctx
  3092. $lctx
  3093. @ast 2 param = ;
  3094. @ctx 1 param = ;
  3095. @lctx 0 param = ;
  3096. $name
  3097. @name ast AST_NAME take = ;
  3098. $and
  3099. @and name "&&" strcmp 0 == = ;
  3100. and name "||" strcmp 0 == ^ "ast_push_value_logic: not a binary logic operator" assert_msg ;
  3101. $type1
  3102. $type2
  3103. $type_idx
  3104. @type1 ast AST_LEFT take ctx lctx ast_eval_type = ;
  3105. @type2 ast AST_RIGHT take ctx lctx ast_eval_type = ;
  3106. @type_idx ast ctx lctx ast_eval_type = ;
  3107. # Evaluate first operand
  3108. ast AST_LEFT take ctx lctx ast_push_value ;
  3109. # Try short-circuit evaluation
  3110. $end_lab
  3111. @end_lab lctx ctx lctx_gen_label = ;
  3112. # pop eax; test eax, eax; mov eax, ?; cctx_gen_label_jump
  3113. ctx 0x58 cctx_emit ;
  3114. ctx 0x85 cctx_emit ;
  3115. ctx 0xc0 cctx_emit ;
  3116. ctx 0xb8 cctx_emit ;
  3117. if and {
  3118. ctx 0 cctx_emit32 ;
  3119. ctx lctx end_lab JUMP_TYPE_JZ 0 cctx_gen_label_jump ;
  3120. } else {
  3121. ctx 1 cctx_emit32 ;
  3122. ctx lctx end_lab JUMP_TYPE_JNZ 0 cctx_gen_label_jump ;
  3123. }
  3124. # Evaluate second operand
  3125. ast AST_RIGHT take ctx lctx ast_push_value ;
  3126. # Reduce result to 0 or 1
  3127. # pop eax; test eax, eax; mov eax, 0; setnz al
  3128. ctx 0x58 cctx_emit ;
  3129. ctx 0x85 cctx_emit ;
  3130. ctx 0xc0 cctx_emit ;
  3131. ctx 0xb8 cctx_emit ;
  3132. ctx 0 cctx_emit32 ;
  3133. ctx 0x0f cctx_emit ;
  3134. ctx 0x95 cctx_emit ;
  3135. ctx 0xc0 cctx_emit ;
  3136. # Push result
  3137. lctx ctx end_lab lctx_fix_label ;
  3138. # push eax
  3139. ctx 0x50 cctx_emit ;
  3140. }
  3141. fun ast_push_value_arith32 4 {
  3142. $ctx
  3143. $name
  3144. $type_idx
  3145. $is_prefix
  3146. @ctx 3 param = ;
  3147. @name 2 param = ;
  3148. @type_idx 1 param = ;
  3149. @is_prefix 0 param = ;
  3150. # Pop right result and store in ECX
  3151. # pop ecx
  3152. ctx 0x59 cctx_emit ;
  3153. # Pop left result and store in EAX
  3154. if is_prefix ! {
  3155. # pop eax
  3156. ctx 0x58 cctx_emit ;
  3157. }
  3158. # Invoke the specific operation code
  3159. $processed
  3160. @processed 0 = ;
  3161. if name "+" strcmp 0 == {
  3162. # add eax, ecx
  3163. ctx 0x01 cctx_emit ;
  3164. ctx 0xc8 cctx_emit ;
  3165. @processed 1 = ;
  3166. }
  3167. if name "-" strcmp 0 == {
  3168. # sub eax, ecx
  3169. ctx 0x29 cctx_emit ;
  3170. ctx 0xc8 cctx_emit ;
  3171. @processed 1 = ;
  3172. }
  3173. if name "&" strcmp 0 == {
  3174. # and eax, ecx
  3175. ctx 0x21 cctx_emit ;
  3176. ctx 0xc8 cctx_emit ;
  3177. @processed 1 = ;
  3178. }
  3179. if name "|" strcmp 0 == {
  3180. # or eax, ecx
  3181. ctx 0x09 cctx_emit ;
  3182. ctx 0xc8 cctx_emit ;
  3183. @processed 1 = ;
  3184. }
  3185. if name "^" strcmp 0 == {
  3186. # xor eax, ecx
  3187. ctx 0x31 cctx_emit ;
  3188. ctx 0xc8 cctx_emit ;
  3189. @processed 1 = ;
  3190. }
  3191. if name "<<" strcmp 0 == {
  3192. # shl eax, cl
  3193. ctx 0xd3 cctx_emit ;
  3194. ctx 0xe0 cctx_emit ;
  3195. @processed 1 = ;
  3196. }
  3197. if name ">>" strcmp 0 == type_idx TYPE_UINT == && {
  3198. # shr eax, cl
  3199. ctx 0xd3 cctx_emit ;
  3200. ctx 0xe8 cctx_emit ;
  3201. @processed 1 = ;
  3202. }
  3203. if name ">>" strcmp 0 == type_idx TYPE_INT == && {
  3204. # sar eax, cl
  3205. ctx 0xd3 cctx_emit ;
  3206. ctx 0xf8 cctx_emit ;
  3207. @processed 1 = ;
  3208. }
  3209. if name "+_PRE" strcmp 0 == {
  3210. # mov eax, ecx
  3211. ctx 0x89 cctx_emit ;
  3212. ctx 0xc8 cctx_emit ;
  3213. @processed 1 = ;
  3214. }
  3215. if name "-_PRE" strcmp 0 == {
  3216. # mov eax, ecx; neg eax
  3217. ctx 0x89 cctx_emit ;
  3218. ctx 0xc8 cctx_emit ;
  3219. ctx 0xf7 cctx_emit ;
  3220. ctx 0xd8 cctx_emit ;
  3221. @processed 1 = ;
  3222. }
  3223. if name "~_PRE" strcmp 0 == {
  3224. # mov eax, ecx; not eax
  3225. ctx 0x89 cctx_emit ;
  3226. ctx 0xc8 cctx_emit ;
  3227. ctx 0xf7 cctx_emit ;
  3228. ctx 0xd0 cctx_emit ;
  3229. @processed 1 = ;
  3230. }
  3231. if name "!_PRE" strcmp 0 == {
  3232. # test ecx, ecx; mov eax, 0; sete al
  3233. ctx 0x85 cctx_emit ;
  3234. ctx 0xc9 cctx_emit ;
  3235. ctx 0xb8 cctx_emit ;
  3236. ctx 0 cctx_emit32 ;
  3237. ctx 0x0f cctx_emit ;
  3238. ctx 0x94 cctx_emit ;
  3239. ctx 0xc0 cctx_emit ;
  3240. @processed 1 = ;
  3241. }
  3242. if name "*" strcmp 0 == {
  3243. # imul ecx
  3244. ctx 0xf7 cctx_emit ;
  3245. ctx 0xe9 cctx_emit ;
  3246. @processed 1 = ;
  3247. }
  3248. if name "/" strcmp 0 == type_idx TYPE_UINT == && {
  3249. # xor edx, edx; div ecx
  3250. ctx 0x31 cctx_emit ;
  3251. ctx 0xd2 cctx_emit ;
  3252. ctx 0xf7 cctx_emit ;
  3253. ctx 0xf1 cctx_emit ;
  3254. @processed 1 = ;
  3255. }
  3256. if name "/" strcmp 0 == type_idx TYPE_INT == && {
  3257. # cdq; idiv ecx
  3258. ctx 0x99 cctx_emit ;
  3259. ctx 0xf7 cctx_emit ;
  3260. ctx 0xf9 cctx_emit ;
  3261. @processed 1 = ;
  3262. }
  3263. if name "%" strcmp 0 == type_idx TYPE_UINT == && {
  3264. # xor edx, edx; div ecx; mov eax, edx
  3265. ctx 0x31 cctx_emit ;
  3266. ctx 0xd2 cctx_emit ;
  3267. ctx 0xf7 cctx_emit ;
  3268. ctx 0xf1 cctx_emit ;
  3269. ctx 0x89 cctx_emit ;
  3270. ctx 0xd0 cctx_emit ;
  3271. @processed 1 = ;
  3272. }
  3273. if name "%" strcmp 0 == type_idx TYPE_INT == && {
  3274. # cdq; idiv ecx; mov eax, edx
  3275. ctx 0x99 cctx_emit ;
  3276. ctx 0xf7 cctx_emit ;
  3277. ctx 0xf9 cctx_emit ;
  3278. ctx 0x89 cctx_emit ;
  3279. ctx 0xd0 cctx_emit ;
  3280. @processed 1 = ;
  3281. }
  3282. if name "==" strcmp 0 == {
  3283. # cmp eax, ecx; mov eax, 0; sete al
  3284. ctx 0x39 cctx_emit ;
  3285. ctx 0xc8 cctx_emit ;
  3286. ctx 0xb8 cctx_emit ;
  3287. ctx 0 cctx_emit32 ;
  3288. ctx 0x0f cctx_emit ;
  3289. ctx 0x94 cctx_emit ;
  3290. ctx 0xc0 cctx_emit ;
  3291. @processed 1 = ;
  3292. }
  3293. if name "!=" strcmp 0 == {
  3294. # cmp eax, ecx; mov eax, 0; setne al
  3295. ctx 0x39 cctx_emit ;
  3296. ctx 0xc8 cctx_emit ;
  3297. ctx 0xb8 cctx_emit ;
  3298. ctx 0 cctx_emit32 ;
  3299. ctx 0x0f cctx_emit ;
  3300. ctx 0x95 cctx_emit ;
  3301. ctx 0xc0 cctx_emit ;
  3302. @processed 1 = ;
  3303. }
  3304. if name "<" strcmp 0 == type_idx TYPE_UINT == && {
  3305. # cmp eax, ecx; mov eax, 0; setb al
  3306. ctx 0x39 cctx_emit ;
  3307. ctx 0xc8 cctx_emit ;
  3308. ctx 0xb8 cctx_emit ;
  3309. ctx 0 cctx_emit32 ;
  3310. ctx 0x0f cctx_emit ;
  3311. ctx 0x92 cctx_emit ;
  3312. ctx 0xc0 cctx_emit ;
  3313. @processed 1 = ;
  3314. }
  3315. if name "<=" strcmp 0 == type_idx TYPE_UINT == && {
  3316. # cmp eax, ecx; mov eax, 0; setbe al
  3317. ctx 0x39 cctx_emit ;
  3318. ctx 0xc8 cctx_emit ;
  3319. ctx 0xb8 cctx_emit ;
  3320. ctx 0 cctx_emit32 ;
  3321. ctx 0x0f cctx_emit ;
  3322. ctx 0x96 cctx_emit ;
  3323. ctx 0xc0 cctx_emit ;
  3324. @processed 1 = ;
  3325. }
  3326. if name ">" strcmp 0 == type_idx TYPE_UINT == && {
  3327. # cmp eax, ecx; mov eax, 0; seta al
  3328. ctx 0x39 cctx_emit ;
  3329. ctx 0xc8 cctx_emit ;
  3330. ctx 0xb8 cctx_emit ;
  3331. ctx 0 cctx_emit32 ;
  3332. ctx 0x0f cctx_emit ;
  3333. ctx 0x97 cctx_emit ;
  3334. ctx 0xc0 cctx_emit ;
  3335. @processed 1 = ;
  3336. }
  3337. if name ">=" strcmp 0 == type_idx TYPE_UINT == && {
  3338. # cmp eax, ecx; mov eax, 0; setae al
  3339. ctx 0x39 cctx_emit ;
  3340. ctx 0xc8 cctx_emit ;
  3341. ctx 0xb8 cctx_emit ;
  3342. ctx 0 cctx_emit32 ;
  3343. ctx 0x0f cctx_emit ;
  3344. ctx 0x93 cctx_emit ;
  3345. ctx 0xc0 cctx_emit ;
  3346. @processed 1 = ;
  3347. }
  3348. if name "<" strcmp 0 == type_idx TYPE_INT == && {
  3349. # cmp eax, ecx; mov eax, 0; setl al
  3350. ctx 0x39 cctx_emit ;
  3351. ctx 0xc8 cctx_emit ;
  3352. ctx 0xb8 cctx_emit ;
  3353. ctx 0 cctx_emit32 ;
  3354. ctx 0x0f cctx_emit ;
  3355. ctx 0x9c cctx_emit ;
  3356. ctx 0xc0 cctx_emit ;
  3357. @processed 1 = ;
  3358. }
  3359. if name "<=" strcmp 0 == type_idx TYPE_INT == && {
  3360. # cmp eax, ecx; mov eax, 0; setle al
  3361. ctx 0x39 cctx_emit ;
  3362. ctx 0xc8 cctx_emit ;
  3363. ctx 0xb8 cctx_emit ;
  3364. ctx 0 cctx_emit32 ;
  3365. ctx 0x0f cctx_emit ;
  3366. ctx 0x9e cctx_emit ;
  3367. ctx 0xc0 cctx_emit ;
  3368. @processed 1 = ;
  3369. }
  3370. if name ">" strcmp 0 == type_idx TYPE_INT == && {
  3371. # cmp eax, ecx; mov eax, 0; setg al
  3372. ctx 0x39 cctx_emit ;
  3373. ctx 0xc8 cctx_emit ;
  3374. ctx 0xb8 cctx_emit ;
  3375. ctx 0 cctx_emit32 ;
  3376. ctx 0x0f cctx_emit ;
  3377. ctx 0x9f cctx_emit ;
  3378. ctx 0xc0 cctx_emit ;
  3379. @processed 1 = ;
  3380. }
  3381. if name ">=" strcmp 0 == type_idx TYPE_INT == && {
  3382. # cmp eax, ecx; mov eax, 0; setge al
  3383. ctx 0x39 cctx_emit ;
  3384. ctx 0xc8 cctx_emit ;
  3385. ctx 0xb8 cctx_emit ;
  3386. ctx 0 cctx_emit32 ;
  3387. ctx 0x0f cctx_emit ;
  3388. ctx 0x9d cctx_emit ;
  3389. ctx 0xc0 cctx_emit ;
  3390. @processed 1 = ;
  3391. }
  3392. processed "ast_push_value_arith32: not implemented" name assert_msg_str ;
  3393. # push eax
  3394. ctx 0x50 cctx_emit ;
  3395. }
  3396. fun ast_push_value_arith64 4 {
  3397. $ctx
  3398. $name
  3399. $type_idx
  3400. $is_prefix
  3401. @ctx 3 param = ;
  3402. @name 2 param = ;
  3403. @type_idx 1 param = ;
  3404. @is_prefix 0 param = ;
  3405. # Push arguments addresses on the stack, so that we can call i64_* routines
  3406. if is_prefix {
  3407. # lea edx, [esp]; push edx
  3408. ctx 0x8d cctx_emit ;
  3409. ctx 0x14 cctx_emit ;
  3410. ctx 0x24 cctx_emit ;
  3411. ctx 0x52 cctx_emit ;
  3412. } else {
  3413. # lea eax, [esp+8]; lea edx, [esp]; push eax; push edx
  3414. ctx 0x8d cctx_emit ;
  3415. ctx 0x44 cctx_emit ;
  3416. ctx 0x24 cctx_emit ;
  3417. ctx 0x08 cctx_emit ;
  3418. ctx 0x8d cctx_emit ;
  3419. ctx 0x14 cctx_emit ;
  3420. ctx 0x24 cctx_emit ;
  3421. ctx 0x50 cctx_emit ;
  3422. ctx 0x52 cctx_emit ;
  3423. }
  3424. # Invoke the specific operation code
  3425. $processed
  3426. @processed 0 = ;
  3427. if name "+" strcmp 0 == {
  3428. ctx _i64_add JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3429. @processed 1 = ;
  3430. }
  3431. if name "-" strcmp 0 == {
  3432. ctx _i64_sub JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3433. @processed 1 = ;
  3434. }
  3435. if name "&" strcmp 0 == {
  3436. ctx _i64_and JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3437. @processed 1 = ;
  3438. }
  3439. if name "|" strcmp 0 == {
  3440. ctx _i64_or JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3441. @processed 1 = ;
  3442. }
  3443. if name "^" strcmp 0 == {
  3444. ctx _i64_xor JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3445. @processed 1 = ;
  3446. }
  3447. if name "<<" strcmp 0 == {
  3448. ctx _i64_shl JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3449. @processed 1 = ;
  3450. }
  3451. if name ">>" strcmp 0 == type_idx TYPE_ULONG == && {
  3452. ctx _i64_shr JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3453. @processed 1 = ;
  3454. }
  3455. if name ">>" strcmp 0 == type_idx TYPE_LONG == && {
  3456. ctx _i64_sar JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3457. @processed 1 = ;
  3458. }
  3459. if name "+_PRE" strcmp 0 == {
  3460. @processed 1 = ;
  3461. }
  3462. if name "-_PRE" strcmp 0 == {
  3463. ctx _i64_neg JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3464. @processed 1 = ;
  3465. }
  3466. if name "~_PRE" strcmp 0 == {
  3467. ctx _i64_not JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3468. @processed 1 = ;
  3469. }
  3470. if name "!_PRE" strcmp 0 == {
  3471. ctx _i64_lnot JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3472. @processed 1 = ;
  3473. }
  3474. if name "*" strcmp 0 == {
  3475. ctx _i64_mul JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3476. @processed 1 = ;
  3477. }
  3478. if name "/" strcmp 0 == type_idx TYPE_ULONG == && {
  3479. ctx @i64_udiv JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3480. @processed 1 = ;
  3481. }
  3482. if name "/" strcmp 0 == type_idx TYPE_LONG == && {
  3483. ctx @i64_sdiv JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3484. @processed 1 = ;
  3485. }
  3486. if name "%" strcmp 0 == type_idx TYPE_ULONG == && {
  3487. ctx @i64_umod JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3488. @processed 1 = ;
  3489. }
  3490. if name "%" strcmp 0 == type_idx TYPE_LONG == && {
  3491. ctx @i64_smod JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3492. @processed 1 = ;
  3493. }
  3494. if name "==" strcmp 0 == {
  3495. ctx _i64_eq JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3496. @processed 1 = ;
  3497. }
  3498. if name "!=" strcmp 0 == {
  3499. ctx _i64_neq JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3500. @processed 1 = ;
  3501. }
  3502. if name "<" strcmp 0 == type_idx TYPE_ULONG == && {
  3503. ctx _i64_ul JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3504. @processed 1 = ;
  3505. }
  3506. if name "<=" strcmp 0 == type_idx TYPE_ULONG == && {
  3507. ctx _i64_ule JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3508. @processed 1 = ;
  3509. }
  3510. if name ">" strcmp 0 == type_idx TYPE_ULONG == && {
  3511. ctx _i64_ug JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3512. @processed 1 = ;
  3513. }
  3514. if name ">=" strcmp 0 == type_idx TYPE_ULONG == && {
  3515. ctx _i64_uge JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3516. @processed 1 = ;
  3517. }
  3518. if name "<" strcmp 0 == type_idx TYPE_LONG == && {
  3519. ctx _i64_l JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3520. @processed 1 = ;
  3521. }
  3522. if name "<=" strcmp 0 == type_idx TYPE_LONG == && {
  3523. ctx _i64_le JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3524. @processed 1 = ;
  3525. }
  3526. if name ">" strcmp 0 == type_idx TYPE_LONG == && {
  3527. ctx _i64_g JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3528. @processed 1 = ;
  3529. }
  3530. if name ">=" strcmp 0 == type_idx TYPE_LONG == && {
  3531. ctx _i64_ge JUMP_TYPE_CALL cctx_gen_jump_loc ;
  3532. @processed 1 = ;
  3533. }
  3534. processed "ast_push_value_arith64: not implemented" name assert_msg_str ;
  3535. # Discard the addresses and possibly the second operand
  3536. if is_prefix {
  3537. # add esp, 4
  3538. ctx 0x83 cctx_emit ;
  3539. ctx 0xc4 cctx_emit ;
  3540. ctx 0x04 cctx_emit ;
  3541. } else {
  3542. # add esp, 16
  3543. ctx 0x83 cctx_emit ;
  3544. ctx 0xc4 cctx_emit ;
  3545. ctx 0x10 cctx_emit ;
  3546. }
  3547. }
  3548. ifun cctx_gen_push_data 2
  3549. ifun cctx_gen_move_data 2
  3550. fun ast_push_value_arith 3 {
  3551. $ast
  3552. $ctx
  3553. $lctx
  3554. @ast 2 param = ;
  3555. @ctx 1 param = ;
  3556. @lctx 0 param = ;
  3557. $name
  3558. @name ast AST_NAME take = ;
  3559. $is_prefix
  3560. $is_postfix
  3561. @is_prefix name "+_PRE" strcmp 0 ==
  3562. name "-_PRE" strcmp 0 == ||
  3563. name "~_PRE" strcmp 0 == ||
  3564. name "!_PRE" strcmp 0 == ||
  3565. name "++_PRE" strcmp 0 == ||
  3566. name "--_PRE" strcmp 0 == || = ;
  3567. @is_postfix name "++_POST" strcmp 0 ==
  3568. name "--_POST" strcmp 0 == || = ;
  3569. $assign
  3570. $incdec
  3571. @assign name "*=" strcmp 0 ==
  3572. name "/=" strcmp 0 == ||
  3573. name "%=" strcmp 0 == ||
  3574. name "+=" strcmp 0 == ||
  3575. name "-=" strcmp 0 == ||
  3576. name "&=" strcmp 0 == ||
  3577. name "^=" strcmp 0 == ||
  3578. name "|=" strcmp 0 == ||
  3579. name "<<=" strcmp 0 == ||
  3580. name ">>=" strcmp 0 == || = ;
  3581. @incdec name "++_PRE" strcmp 0 ==
  3582. name "--_PRE" strcmp 0 == ||
  3583. name "++_POST" strcmp 0 == ||
  3584. name "--_POST" strcmp 0 == || = ;
  3585. @name name strdup = ;
  3586. if assign {
  3587. is_prefix ! "ast_push_value_arith: error 2" assert_msg ;
  3588. name name strlen + 1 - '\0' =c ;
  3589. }
  3590. if incdec {
  3591. name 1 + '\0' =c ;
  3592. is_prefix is_postfix || "ast_push_value_arith: error 6" assert_msg ;
  3593. is_prefix ! is_postfix ! || "ast_push_value_arith: error 7" assert_msg ;
  3594. assign ! "ast_push_value_arith: error 8" assert_msg ;
  3595. }
  3596. if is_postfix {
  3597. incdec "ast_push_value_arith: error 9" assert_msg ;
  3598. assign ! "ast_push_value_arith: error 10" assert_msg ;
  3599. }
  3600. $type1
  3601. $type2
  3602. $type_idx
  3603. $common_type_idx
  3604. if is_prefix ! {
  3605. @type1 ast AST_LEFT take ctx lctx ast_eval_type = ;
  3606. }
  3607. if is_postfix ! {
  3608. @type2 ast AST_RIGHT take ctx lctx ast_eval_type = ;
  3609. }
  3610. if incdec {
  3611. if is_prefix {
  3612. @type1 type2 = ;
  3613. } else {
  3614. @type2 type1 = ;
  3615. }
  3616. }
  3617. @type_idx ast ctx lctx ast_eval_type = ;
  3618. @common_type_idx ast AST_COMMON_TYPE_IDX take = ;
  3619. # Recursively evalute both operands
  3620. if is_prefix ! {
  3621. if assign incdec || {
  3622. # See the comment for sum-assigning
  3623. # ast_push_addr; mov eax, [esp], cctx_gen_push_data
  3624. ast AST_LEFT take ctx lctx ast_push_addr ;
  3625. ctx 0x8b cctx_emit ;
  3626. ctx 0x04 cctx_emit ;
  3627. ctx 0x24 cctx_emit ;
  3628. ctx ctx type1 cctx_type_footprint cctx_gen_push_data ;
  3629. } else {
  3630. ast AST_LEFT take ctx lctx ast_push_value ;
  3631. }
  3632. lctx ctx type1 common_type_idx lctx_int_convert ;
  3633. }
  3634. if is_postfix ! {
  3635. if incdec {
  3636. # See the comment for sum-assigning
  3637. # ast_push_addr; mov eax, [esp], cctx_gen_push_data
  3638. ast AST_RIGHT take ctx lctx ast_push_addr ;
  3639. ctx 0x8b cctx_emit ;
  3640. ctx 0x04 cctx_emit ;
  3641. ctx 0x24 cctx_emit ;
  3642. ctx ctx type2 cctx_type_footprint cctx_gen_push_data ;
  3643. } else {
  3644. ast AST_RIGHT take ctx lctx ast_push_value ;
  3645. }
  3646. lctx ctx type2 common_type_idx lctx_int_convert ;
  3647. }
  3648. # If postincrement or postdecrement, put a further copy of the
  3649. # operand on the stack, which will be returned in the end; so the
  3650. # stack is: value to be returned, address to be assigned, operand
  3651. if incdec is_postfix && {
  3652. if ctx common_type_idx cctx_type_footprint 4 == {
  3653. # pop eax; pop ecx; push eax; push ecx; push eax
  3654. ctx 0x58 cctx_emit ;
  3655. ctx 0x59 cctx_emit ;
  3656. ctx 0x50 cctx_emit ;
  3657. ctx 0x51 cctx_emit ;
  3658. ctx 0x50 cctx_emit ;
  3659. } else {
  3660. # pop eax; pop edx; pop ecx; push edx; push eax; push ecx; push edx; push eax
  3661. ctx 0x58 cctx_emit ;
  3662. ctx 0x5a cctx_emit ;
  3663. ctx 0x59 cctx_emit ;
  3664. ctx 0x52 cctx_emit ;
  3665. ctx 0x50 cctx_emit ;
  3666. ctx 0x51 cctx_emit ;
  3667. ctx 0x52 cctx_emit ;
  3668. ctx 0x50 cctx_emit ;
  3669. }
  3670. }
  3671. # If increment or decrement, then push 1 of the appropriate type
  3672. if incdec {
  3673. type1 type2 == "ast_push_value_arith: error 11" assert_msg ;
  3674. # push 1
  3675. ctx 0x6a cctx_emit ;
  3676. ctx 0x01 cctx_emit ;
  3677. lctx ctx TYPE_INT common_type_idx lctx_int_convert ;
  3678. }
  3679. # Incdec operators must not be considered as prefix, because we have
  3680. # pushed a second operand on the stack
  3681. if ctx common_type_idx cctx_type_footprint 4 == {
  3682. ctx name common_type_idx is_prefix incdec ! && ast_push_value_arith32 ;
  3683. } else {
  3684. ctx common_type_idx cctx_type_footprint 8 == "ast_push_value_arith: error 1" assert_msg ;
  3685. ctx name common_type_idx is_prefix incdec ! && ast_push_value_arith64 ;
  3686. }
  3687. if type_idx common_type_idx != {
  3688. assign ! "ast_push_value_arith: error 3" assert_msg ;
  3689. lctx ctx common_type_idx type_idx lctx_int_convert ;
  3690. }
  3691. # Do the assignment if needed
  3692. if assign incdec || {
  3693. ctx type1 cctx_type_size ctx type_idx cctx_type_size <= "ast_push_value_arith: error 5" assert_msg ;
  3694. type_idx common_type_idx == "ast_push_value_arith: error 4" assert_msg ;
  3695. # First remove the address from the stack (it is not on the top of
  3696. # the stack, though)
  3697. # pop eax
  3698. ctx 0x58 cctx_emit ;
  3699. if ctx type_idx cctx_type_footprint 8 == {
  3700. # pop edx
  3701. ctx 0x5a cctx_emit ;
  3702. }
  3703. # pop ecx
  3704. ctx 0x59 cctx_emit ;
  3705. if ctx type_idx cctx_type_footprint 8 == {
  3706. # push edx
  3707. ctx 0x52 cctx_emit ;
  3708. }
  3709. # push eax
  3710. ctx 0x50 cctx_emit ;
  3711. # Then do the assignment
  3712. # mov eax, ecx; cctx_gen_move_data
  3713. ctx 0x89 cctx_emit ;
  3714. ctx 0xc8 cctx_emit ;
  3715. ctx ctx type1 cctx_type_size cctx_gen_move_data ;
  3716. }
  3717. # If postincrement or postdecrement, remove the result of the
  3718. # operation, because the copy of the operand already pushed on the
  3719. # stack will be returned
  3720. if incdec is_postfix && {
  3721. # add esp, footprint
  3722. ctx 0x81 cctx_emit ;
  3723. ctx 0xc4 cctx_emit ;
  3724. ctx ctx common_type_idx cctx_type_footprint cctx_emit32 ;
  3725. }
  3726. name free ;
  3727. }
  3728. fun cctx_gen_push_data 2 {
  3729. $ctx
  3730. $size
  3731. @ctx 1 param = ;
  3732. @size 0 param = ;
  3733. size 4 % 0 == "cctx_gen_push_data: size is not multiple of 4" assert_msg ;
  3734. $i
  3735. @i size 4 - = ;
  3736. while i 0 >= {
  3737. # push [eax+off]
  3738. ctx 0xff cctx_emit ;
  3739. ctx 0xb0 cctx_emit ;
  3740. ctx i cctx_emit32 ;
  3741. @i i 4 - = ;
  3742. }
  3743. }
  3744. fun cctx_gen_pop_data 2 {
  3745. $ctx
  3746. $size
  3747. @ctx 1 param = ;
  3748. @size 0 param = ;
  3749. size 4 % 0 == "cctx_gen_pop_data: size is not multiple of 4" assert_msg ;
  3750. $i
  3751. @i 0 = ;
  3752. while i size < {
  3753. # pop [eax+off]
  3754. ctx 0x8f cctx_emit ;
  3755. ctx 0x80 cctx_emit ;
  3756. ctx i cctx_emit32 ;
  3757. @i i 4 + = ;
  3758. }
  3759. }
  3760. fun cctx_gen_move_data 2 {
  3761. $ctx
  3762. $size
  3763. @ctx 1 param = ;
  3764. @size 0 param = ;
  3765. if size 1 == {
  3766. # mov dl, [esp]; mov [eax], dl
  3767. ctx 0x8a cctx_emit ;
  3768. ctx 0x14 cctx_emit ;
  3769. ctx 0x24 cctx_emit ;
  3770. ctx 0x88 cctx_emit ;
  3771. ctx 0x10 cctx_emit ;
  3772. ret ;
  3773. }
  3774. if size 2 == {
  3775. # mov dx, [esp]; mov [eax], dx
  3776. ctx 0x66 cctx_emit ;
  3777. ctx 0x8b cctx_emit ;
  3778. ctx 0x14 cctx_emit ;
  3779. ctx 0x24 cctx_emit ;
  3780. ctx 0x66 cctx_emit ;
  3781. ctx 0x89 cctx_emit ;
  3782. ctx 0x10 cctx_emit ;
  3783. ret ;
  3784. }
  3785. size 4 % 0 == "cctx_gen_move_data: size is not multiple of 4" assert_msg ;
  3786. $i
  3787. @i 0 = ;
  3788. while i size < {
  3789. # mov edx, [esp+off]; mov [eax+off], edx
  3790. ctx 0x8b cctx_emit ;
  3791. ctx 0x94 cctx_emit ;
  3792. ctx 0x24 cctx_emit ;
  3793. ctx i cctx_emit32 ;
  3794. ctx 0x89 cctx_emit ;
  3795. ctx 0x90 cctx_emit ;
  3796. ctx i cctx_emit32 ;
  3797. @i i 4 + = ;
  3798. }
  3799. }
  3800. fun cctx_gen_move_data_backward 2 {
  3801. $ctx
  3802. $size
  3803. @ctx 1 param = ;
  3804. @size 0 param = ;
  3805. size 4 % 0 == "cctx_gen_move_data: size is not multiple of 4" assert_msg ;
  3806. $i
  3807. @i size 4 - = ;
  3808. while i 0 >= {
  3809. # mov edx, [esp+off]; mov [eax+off], edx
  3810. ctx 0x8b cctx_emit ;
  3811. ctx 0x94 cctx_emit ;
  3812. ctx 0x24 cctx_emit ;
  3813. ctx i cctx_emit32 ;
  3814. ctx 0x89 cctx_emit ;
  3815. ctx 0x90 cctx_emit ;
  3816. ctx i cctx_emit32 ;
  3817. @i i 4 - = ;
  3818. }
  3819. }
  3820. fun cctx_default_promotion 2 {
  3821. $ctx
  3822. $type_idx
  3823. @ctx 1 param = ;
  3824. @type_idx 0 param = ;
  3825. if type_idx TYPE_CHAR ==
  3826. type_idx TYPE_SCHAR == ||
  3827. type_idx TYPE_SHORT == ||
  3828. type_idx TYPE_INT == || {
  3829. TYPE_INT ret ;
  3830. }
  3831. if type_idx TYPE_UCHAR ==
  3832. type_idx TYPE_USHORT == ||
  3833. type_idx TYPE_UINT == || {
  3834. TYPE_UINT ret ;
  3835. }
  3836. type_idx ret ;
  3837. }
  3838. fun ast_gen_function_call 3 {
  3839. $ast
  3840. $ctx
  3841. $lctx
  3842. @ast 2 param = ;
  3843. @ctx 1 param = ;
  3844. @lctx 0 param = ;
  3845. $left
  3846. $right
  3847. @left ast AST_LEFT take = ;
  3848. @right ast AST_RIGHT take = ;
  3849. $type_idx
  3850. @type_idx ast ctx lctx ast_eval_type = ;
  3851. $fun_ptr_idx
  3852. $fun_ptr_type
  3853. $fun_idx
  3854. $fun_type
  3855. $return_type_idx
  3856. $return_type
  3857. @fun_ptr_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  3858. @fun_ptr_type ctx fun_ptr_idx cctx_get_type = ;
  3859. fun_ptr_type TYPE_KIND take TYPE_KIND_POINTER == "ast_gen_function_call: left is not a pointer" assert_msg ;
  3860. @fun_idx fun_ptr_type TYPE_BASE take = ;
  3861. @fun_type ctx fun_idx cctx_get_type = ;
  3862. fun_type TYPE_KIND take TYPE_KIND_FUNCTION == "ast_gen_function_call: left is not a pointer to function" assert_msg ;
  3863. @return_type_idx fun_type TYPE_BASE take = ;
  3864. @return_type ctx return_type_idx cctx_get_type = ;
  3865. $args
  3866. @args fun_type TYPE_ARGS take = ;
  3867. # If the function will return an object, immediately allocate it
  3868. $returns_obj
  3869. @returns_obj return_type TYPE_KIND take TYPE_KIND_STRUCT == return_type TYPE_KIND take TYPE_KIND_UNION == || = ;
  3870. if returns_obj {
  3871. # sub esp, footprint
  3872. ctx 0x81 cctx_emit ;
  3873. ctx 0xec cctx_emit ;
  3874. ctx ctx return_type_idx cctx_type_footprint cctx_emit32 ;
  3875. }
  3876. # Passed arguments are stored in reverse order
  3877. $passed_args
  3878. @passed_args 4 vector_init = ;
  3879. if right AST_NAME take 0 != {
  3880. $cont
  3881. @cont 1 = ;
  3882. while cont {
  3883. if right AST_NAME take "," strcmp 0 == {
  3884. passed_args right AST_RIGHT take vector_push_back ;
  3885. @right right AST_LEFT take = ;
  3886. } else {
  3887. passed_args right vector_push_back ;
  3888. @cont 0 = ;
  3889. }
  3890. }
  3891. }
  3892. # Push arguments on the stack, right to left
  3893. $ellipsis
  3894. @ellipsis fun_type TYPE_ELLIPSIS take = ;
  3895. if ellipsis {
  3896. passed_args vector_size args vector_size >= "ast_gen_function_call: too few arguments" assert_msg ;
  3897. } else {
  3898. passed_args vector_size args vector_size == "ast_gen_function_call: arguments number does not match" assert_msg ;
  3899. }
  3900. $i
  3901. @i 0 = ;
  3902. $rewind
  3903. @rewind 0 = ;
  3904. $excess_args
  3905. @excess_args passed_args vector_size args vector_size - = ;
  3906. while i passed_args vector_size < {
  3907. $passed_arg
  3908. @passed_arg passed_args i vector_at = ;
  3909. passed_arg ctx lctx ast_push_value ;
  3910. $from_type
  3911. $to_type
  3912. @from_type passed_arg ctx lctx ast_eval_type = ;
  3913. if i excess_args < {
  3914. @to_type ctx from_type cctx_default_promotion = ;
  3915. } else {
  3916. $arg
  3917. @arg args args vector_size i excess_args - - 1 - vector_at = ;
  3918. @to_type arg = ;
  3919. }
  3920. lctx ctx from_type to_type lctx_convert_stack ;
  3921. @rewind rewind ctx to_type cctx_type_footprint + = ;
  3922. @i i 1 + = ;
  3923. }
  3924. # If the function will return an object, push the returned value address
  3925. if returns_obj {
  3926. # lea eax, [esp+rewind]; push eax
  3927. ctx 0x8d cctx_emit ;
  3928. ctx 0x84 cctx_emit ;
  3929. ctx 0x24 cctx_emit ;
  3930. ctx rewind cctx_emit32 ;
  3931. ctx 0x50 cctx_emit ;
  3932. }
  3933. # Call function
  3934. # ast_push_value; pop eax; call eax
  3935. left ctx lctx ast_push_value ;
  3936. ctx 0x58 cctx_emit ;
  3937. ctx 0xff cctx_emit ;
  3938. ctx 0xd0 cctx_emit ;
  3939. # Clean up stack
  3940. # add esp, rewind
  3941. ctx 0x81 cctx_emit ;
  3942. ctx 0xc4 cctx_emit ;
  3943. ctx rewind cctx_emit32 ;
  3944. # Push result if there is one and it is not an object
  3945. if type_idx TYPE_VOID != returns_obj ! && {
  3946. $res_footprint
  3947. @res_footprint ctx ast ctx lctx ast_eval_type cctx_type_footprint = ;
  3948. res_footprint 4 == res_footprint 0 == || res_footprint 8 == || "ast_gen_function_call: return type is not scalar" assert_msg ;
  3949. if res_footprint 4 >= {
  3950. if res_footprint 8 == {
  3951. # push edx
  3952. ctx 0x52 cctx_emit ;
  3953. }
  3954. # push eax
  3955. ctx 0x50 cctx_emit ;
  3956. }
  3957. }
  3958. passed_args vector_destroy ;
  3959. }
  3960. fun ast_push_value_ptr 3 {
  3961. $ast
  3962. $ctx
  3963. $lctx
  3964. @ast 2 param = ;
  3965. @ctx 1 param = ;
  3966. @lctx 0 param = ;
  3967. $name
  3968. @name ast AST_NAME take = ;
  3969. $sum
  3970. $is_prefix
  3971. $is_postfix
  3972. @is_prefix name "++_PRE" strcmp 0 ==
  3973. name "--_PRE" strcmp 0 == || = ;
  3974. @is_postfix name "++_POST" strcmp 0 ==
  3975. name "--_POST" strcmp 0 == || = ;
  3976. $subtract
  3977. $assign
  3978. $incdec
  3979. @sum name "+" strcmp 0 == name "[" strcmp 0 == || name "+=" strcmp 0 == || = ;
  3980. @subtract name "-" strcmp 0 == name "-=" strcmp 0 == || = ;
  3981. @assign name "+=" strcmp 0 == name "-=" strcmp 0 == || = ;
  3982. @incdec name "++_PRE" strcmp 0 ==
  3983. name "--_PRE" strcmp 0 == ||
  3984. name "++_POST" strcmp 0 == ||
  3985. name "--_POST" strcmp 0 == || = ;
  3986. sum subtract || incdec || "ast_push_value_ptr: not a sum or a subtraction" assert_msg ;
  3987. if incdec {
  3988. is_prefix is_postfix || "ast_push_value_ptr: error 1" assert_msg ;
  3989. is_prefix ! is_postfix ! || "ast_push_value_ptr: error 2" assert_msg ;
  3990. assign ! "ast_push_value_ptr: error 3" assert_msg ;
  3991. } else {
  3992. is_prefix ! is_postfix ! && "ast_push_value_ptr: error 4" assert_msg ;
  3993. }
  3994. $left_idx
  3995. $right_idx
  3996. $left_ptr
  3997. $right_ptr
  3998. $left_size
  3999. $right_size
  4000. if is_prefix ! {
  4001. @left_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  4002. @left_ptr ctx left_idx cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == = ;
  4003. if left_ptr {
  4004. if ctx left_idx cctx_get_type TYPE_BASE take TYPE_VOID == {
  4005. @left_size 1 = ;
  4006. } else {
  4007. @left_size ctx ctx left_idx cctx_get_type TYPE_BASE take cctx_type_size = ;
  4008. }
  4009. }
  4010. }
  4011. if is_postfix ! {
  4012. @right_idx ast AST_RIGHT take ctx lctx ast_eval_type = ;
  4013. @right_ptr ctx right_idx cctx_get_type TYPE_KIND take TYPE_KIND_POINTER == = ;
  4014. if right_ptr {
  4015. if ctx right_idx cctx_get_type TYPE_BASE take TYPE_VOID == {
  4016. @right_size 1 = ;
  4017. } else {
  4018. @right_size ctx ctx right_idx cctx_get_type TYPE_BASE take cctx_type_size = ;
  4019. }
  4020. }
  4021. }
  4022. $processed
  4023. @processed 0 = ;
  4024. if incdec {
  4025. processed ! "ast_push_value_ptr: error 5" assert_msg ;
  4026. if is_prefix right_ptr && {
  4027. # ast_push_addr; pop eax
  4028. ast AST_RIGHT take ctx lctx ast_push_addr ;
  4029. ctx 0x58 cctx_emit ;
  4030. if name **c '+' == {
  4031. # add [eax], size
  4032. ctx 0x81 cctx_emit ;
  4033. ctx 0x00 cctx_emit ;
  4034. ctx right_size cctx_emit32 ;
  4035. } else {
  4036. # sub [eax], size
  4037. ctx 0x81 cctx_emit ;
  4038. ctx 0x28 cctx_emit ;
  4039. ctx right_size cctx_emit32 ;
  4040. }
  4041. # push [eax]
  4042. ctx 0xff cctx_emit ;
  4043. ctx 0x30 cctx_emit ;
  4044. @processed 1 = ;
  4045. }
  4046. if is_postfix left_ptr && {
  4047. # ast_push_addr; pop eax; mov edx, [eax]
  4048. ast AST_LEFT take ctx lctx ast_push_addr ;
  4049. ctx 0x58 cctx_emit ;
  4050. ctx 0x8b cctx_emit ;
  4051. ctx 0x10 cctx_emit ;
  4052. if name **c '+' == {
  4053. # add [eax], size
  4054. ctx 0x81 cctx_emit ;
  4055. ctx 0x00 cctx_emit ;
  4056. ctx left_size cctx_emit32 ;
  4057. } else {
  4058. # sub [eax], size
  4059. ctx 0x81 cctx_emit ;
  4060. ctx 0x28 cctx_emit ;
  4061. ctx left_size cctx_emit32 ;
  4062. }
  4063. # push edx
  4064. ctx 0x52 cctx_emit ;
  4065. @processed 1 = ;
  4066. }
  4067. }
  4068. if sum {
  4069. processed ! "ast_push_value_ptr: error 6" assert_msg ;
  4070. left_ptr right_ptr && ! "ast_push_value_ptr: cannot take sum of two pointers" assert_msg ;
  4071. if left_ptr {
  4072. if assign {
  4073. # When sum-assigning, push both the address and the value on
  4074. # the stack: first we use the value to do the computation,
  4075. # then the address to assign
  4076. # ast_push_addr; mov eax, [esp]; push [eax]
  4077. ast AST_LEFT take ctx lctx ast_push_addr ;
  4078. ctx 0x8b cctx_emit ;
  4079. ctx 0x04 cctx_emit ;
  4080. ctx 0x24 cctx_emit ;
  4081. ctx 0xff cctx_emit ;
  4082. ctx 0x30 cctx_emit ;
  4083. } else {
  4084. # ast_push_value
  4085. ast AST_LEFT take ctx lctx ast_push_value ;
  4086. }
  4087. # ast_push_value; lctx_convert_stack; push size
  4088. ast AST_RIGHT take ctx lctx ast_push_value ;
  4089. lctx ctx ast AST_RIGHT take ctx lctx ast_eval_type TYPE_UINT lctx_convert_stack ;
  4090. ctx 0x68 cctx_emit ;
  4091. ctx left_size cctx_emit32 ;
  4092. @processed 1 = ;
  4093. }
  4094. if right_ptr {
  4095. assign ! "ast_push_value_ptr: right of sum-assign must be integer" assert_msg ;
  4096. # ast_push_value; ast_push_value; lctx_convert_stack; push size
  4097. ast AST_RIGHT take ctx lctx ast_push_value ;
  4098. ast AST_LEFT take ctx lctx ast_push_value ;
  4099. lctx ctx ast AST_LEFT take ctx lctx ast_eval_type TYPE_UINT lctx_convert_stack ;
  4100. ctx 0x68 cctx_emit ;
  4101. ctx right_size cctx_emit32 ;
  4102. @processed 1 = ;
  4103. }
  4104. if processed {
  4105. # pop eax; pop edx; imul edx; pop ecx; add eax, ecx
  4106. ctx 0x58 cctx_emit ;
  4107. ctx 0x5a cctx_emit ;
  4108. ctx 0xf7 cctx_emit ;
  4109. ctx 0xea cctx_emit ;
  4110. ctx 0x59 cctx_emit ;
  4111. ctx 0x01 cctx_emit ;
  4112. ctx 0xc8 cctx_emit ;
  4113. if assign {
  4114. # pop edx; mov [edx], eax
  4115. ctx 0x5a cctx_emit ;
  4116. ctx 0x89 cctx_emit ;
  4117. ctx 0x02 cctx_emit ;
  4118. }
  4119. # push eax
  4120. ctx 0x50 cctx_emit ;
  4121. }
  4122. }
  4123. if subtract {
  4124. processed ! "ast_push_value_ptr: error 7" assert_msg ;
  4125. left_ptr ! right_ptr && ! "ast_push_value_ptr: cannot take different of a non-pointer and a pointer" assert_msg ;
  4126. if left_ptr {
  4127. if right_ptr {
  4128. assign ! "ast_push_value_ptr: right of subtract-assign must be integer" assert_msg ;
  4129. left_size right_size == "ast_push_value_ptr: cannot take difference of pointers to types of different size" assert_msg ;
  4130. # push size; ast_push_value; ast_push_value
  4131. ctx 0x68 cctx_emit ;
  4132. ctx left_size cctx_emit32 ;
  4133. ast AST_LEFT take ctx lctx ast_push_value ;
  4134. ast AST_RIGHT take ctx lctx ast_push_value ;
  4135. # pop edx; pop eax; sub eax, edx; pop ecx; cdq; idiv ecx; push eax
  4136. ctx 0x5a cctx_emit ;
  4137. ctx 0x58 cctx_emit ;
  4138. ctx 0x29 cctx_emit ;
  4139. ctx 0xd0 cctx_emit ;
  4140. ctx 0x59 cctx_emit ;
  4141. ctx 0x99 cctx_emit ;
  4142. ctx 0xf7 cctx_emit ;
  4143. ctx 0xf9 cctx_emit ;
  4144. ctx 0x50 cctx_emit ;
  4145. } else {
  4146. if assign {
  4147. # See the comment for sum-assigning
  4148. # ast_push_addr; mov eax, [esp]; push [eax]
  4149. ast AST_LEFT take ctx lctx ast_push_addr ;
  4150. ctx 0x8b cctx_emit ;
  4151. ctx 0x04 cctx_emit ;
  4152. ctx 0x24 cctx_emit ;
  4153. ctx 0xff cctx_emit ;
  4154. ctx 0x30 cctx_emit ;
  4155. } else {
  4156. # ast_push_value
  4157. ast AST_LEFT take ctx lctx ast_push_value ;
  4158. }
  4159. # ast_push_value; lctx_convert_stack; push size
  4160. ast AST_RIGHT take ctx lctx ast_push_value ;
  4161. lctx ctx ast AST_RIGHT take ctx lctx ast_eval_type TYPE_UINT lctx_convert_stack ;
  4162. ctx 0x68 cctx_emit ;
  4163. ctx left_size cctx_emit32 ;
  4164. # pop eax; pop edx; imul edx; pop ecx; neg eax; add eax, ecx
  4165. ctx 0x58 cctx_emit ;
  4166. ctx 0x5a cctx_emit ;
  4167. ctx 0xf7 cctx_emit ;
  4168. ctx 0xea cctx_emit ;
  4169. ctx 0x59 cctx_emit ;
  4170. ctx 0xf7 cctx_emit ;
  4171. ctx 0xd8 cctx_emit ;
  4172. ctx 0x01 cctx_emit ;
  4173. ctx 0xc8 cctx_emit ;
  4174. if assign {
  4175. # pop edx; mov [edx], eax
  4176. ctx 0x5a cctx_emit ;
  4177. ctx 0x89 cctx_emit ;
  4178. ctx 0x02 cctx_emit ;
  4179. }
  4180. # push eax
  4181. ctx 0x50 cctx_emit ;
  4182. }
  4183. @processed 1 = ;
  4184. }
  4185. }
  4186. processed ret ;
  4187. }
  4188. fun ast_push_value 3 {
  4189. $ast
  4190. $ctx
  4191. $lctx
  4192. @ast 2 param = ;
  4193. @ctx 1 param = ;
  4194. @lctx 0 param = ;
  4195. $name
  4196. @name ast AST_NAME take = ;
  4197. $type_idx
  4198. @type_idx ast ctx lctx ast_eval_type = ;
  4199. # In case of type decaying, return the address
  4200. $orig_type_idx
  4201. @orig_type_idx ast AST_ORIG_TYPE_IDX take = ;
  4202. if orig_type_idx 0xffffffff != {
  4203. $orig_type
  4204. @orig_type ctx orig_type_idx cctx_get_type = ;
  4205. $orig_kind
  4206. @orig_kind orig_type TYPE_KIND take = ;
  4207. if orig_kind TYPE_KIND_FUNCTION == orig_kind TYPE_KIND_ARRAY == || {
  4208. ast ctx lctx ast_push_addr ;
  4209. ret ;
  4210. }
  4211. }
  4212. if ast AST_TYPE take 0 == {
  4213. # Operand
  4214. if name is_valid_identifier {
  4215. $enum_consts
  4216. @enum_consts ctx CCTX_ENUM_CONSTS take = ;
  4217. if name "sizeof" strcmp 0 == {
  4218. # push type_size
  4219. ctx 0x68 cctx_emit ;
  4220. ctx ctx ast AST_CAST_TYPE_IDX take cctx_type_size cctx_emit32 ;
  4221. } else {
  4222. if enum_consts name map_has {
  4223. $value
  4224. @value enum_consts name map_at = ;
  4225. ctx 0x68 cctx_emit ;
  4226. ctx value cctx_emit32 ;
  4227. } else {
  4228. # Push the address
  4229. ast ctx lctx ast_push_addr ;
  4230. # pop eax
  4231. ctx 0x58 cctx_emit ;
  4232. ctx ctx type_idx cctx_type_footprint cctx_gen_push_data ;
  4233. }
  4234. }
  4235. } else {
  4236. if name **c '\"' == {
  4237. 0 "ast_push_value: error 1" assert_msg ;
  4238. } else {
  4239. # Value is already encoded in the AST
  4240. }
  4241. if ctx type_idx cctx_type_footprint 8 == {
  4242. # push upper32
  4243. ctx 0x68 cctx_emit ;
  4244. ctx ast AST_VALUE take i64_to_upper32 cctx_emit32 ;
  4245. } else {
  4246. ctx type_idx cctx_type_footprint 4 == "ast_push_value: error 2" assert_msg ;
  4247. }
  4248. # push lower32
  4249. ctx 0x68 cctx_emit ;
  4250. ctx ast AST_VALUE take i64_to_32 cctx_emit32 ;
  4251. }
  4252. } else {
  4253. # Operator
  4254. $processed
  4255. @processed 0 = ;
  4256. if name "+" strcmp 0 ==
  4257. name "-" strcmp 0 == ||
  4258. name "+=" strcmp 0 == ||
  4259. name "-=" strcmp 0 == ||
  4260. name "++_PRE" strcmp 0 == ||
  4261. name "--_PRE" strcmp 0 == ||
  4262. name "++_POST" strcmp 0 == ||
  4263. name "--_POST" strcmp 0 == ||
  4264. processed ! && {
  4265. @processed ast ctx lctx ast_push_value_ptr = ;
  4266. }
  4267. if name "*" strcmp 0 ==
  4268. name "/" strcmp 0 == ||
  4269. name "%" strcmp 0 == ||
  4270. name "+" strcmp 0 == ||
  4271. name "-" strcmp 0 == ||
  4272. name "&" strcmp 0 == ||
  4273. name "^" strcmp 0 == ||
  4274. name "|" strcmp 0 == ||
  4275. name "<<" strcmp 0 == ||
  4276. name ">>" strcmp 0 == ||
  4277. name "*=" strcmp 0 == ||
  4278. name "/=" strcmp 0 == ||
  4279. name "%=" strcmp 0 == ||
  4280. name "+=" strcmp 0 == ||
  4281. name "-=" strcmp 0 == ||
  4282. name "&=" strcmp 0 == ||
  4283. name "^=" strcmp 0 == ||
  4284. name "|=" strcmp 0 == ||
  4285. name "<<=" strcmp 0 == ||
  4286. name ">>=" strcmp 0 == ||
  4287. name "<" strcmp 0 == ||
  4288. name ">" strcmp 0 == ||
  4289. name "<=" strcmp 0 == ||
  4290. name ">=" strcmp 0 == ||
  4291. name "==" strcmp 0 == ||
  4292. name "!=" strcmp 0 == ||
  4293. name "+_PRE" strcmp 0 == ||
  4294. name "-_PRE" strcmp 0 == ||
  4295. name "~_PRE" strcmp 0 == ||
  4296. name "!_PRE" strcmp 0 == ||
  4297. name "++_PRE" strcmp 0 == ||
  4298. name "--_PRE" strcmp 0 == ||
  4299. name "++_POST" strcmp 0 == ||
  4300. name "--_POST" strcmp 0 == ||
  4301. processed ! && {
  4302. ast ctx lctx ast_push_value_arith ;
  4303. @processed 1 = ;
  4304. }
  4305. if name "&&" strcmp 0 ==
  4306. name "||" strcmp 0 == ||
  4307. processed ! && {
  4308. ast ctx lctx ast_push_value_logic ;
  4309. @processed 1 = ;
  4310. }
  4311. if name "=" strcmp 0 == {
  4312. ast AST_RIGHT take ctx lctx ast_push_value ;
  4313. lctx ctx ast AST_RIGHT take ctx lctx ast_eval_type ast ctx lctx ast_eval_type lctx_convert_stack ;
  4314. ast AST_LEFT take ctx lctx ast_push_addr ;
  4315. # pop eax; cctx_gen_move_data
  4316. ctx 0x58 cctx_emit ;
  4317. ctx ctx ast ctx lctx ast_eval_type cctx_type_size cctx_gen_move_data ;
  4318. @processed 1 = ;
  4319. }
  4320. if name "(" strcmp 0 == {
  4321. ast ctx lctx ast_gen_function_call ;
  4322. @processed 1 = ;
  4323. }
  4324. if name "*_PRE" strcmp 0 == name "[" strcmp 0 == || {
  4325. # Push the address
  4326. ast ctx lctx ast_push_addr ;
  4327. # pop eax
  4328. ctx 0x58 cctx_emit ;
  4329. ctx ctx type_idx cctx_type_footprint cctx_gen_push_data ;
  4330. @processed 1 = ;
  4331. }
  4332. if name "&_PRE" strcmp 0 == {
  4333. ast AST_RIGHT take ctx lctx ast_push_addr ;
  4334. @processed 1 = ;
  4335. }
  4336. if name "." strcmp 0 == {
  4337. $struct_idx
  4338. $struct_type
  4339. $struct_size
  4340. @struct_idx ast AST_LEFT take ctx lctx ast_eval_type = ;
  4341. @struct_type ctx struct_idx cctx_get_type = ;
  4342. @struct_size ctx struct_idx cctx_type_footprint = ;
  4343. ast AST_RIGHT take AST_TYPE take 0 == "ast_push_value: right is not a plain name" assert_msg ;
  4344. $name
  4345. @name ast AST_RIGHT take AST_NAME take = ;
  4346. $field
  4347. @field struct_type name type_get_idx = ;
  4348. field 0xffffffff != "ast_push_value: specified field does not exist" assert_msg ;
  4349. $res_idx
  4350. $res_size
  4351. $off
  4352. @res_idx ast ctx lctx ast_eval_type = ;
  4353. @res_size ctx res_idx cctx_type_footprint = ;
  4354. @off struct_type TYPE_FIELDS_OFFS take field vector_at = ;
  4355. # ast_push_value; lea eax, [esp+struct_size-res_size]; add esp, off; cctx_gen_move_data_backward; mov esp, eax
  4356. ast AST_LEFT take ctx lctx ast_push_value ;
  4357. ctx 0x8d cctx_emit ;
  4358. ctx 0x84 cctx_emit ;
  4359. ctx 0x24 cctx_emit ;
  4360. ctx struct_size res_size - cctx_emit32 ;
  4361. ctx 0x81 cctx_emit ;
  4362. ctx 0xc4 cctx_emit ;
  4363. ctx off cctx_emit32 ;
  4364. ctx res_size cctx_gen_move_data_backward ;
  4365. ctx 0x89 cctx_emit ;
  4366. ctx 0xc4 cctx_emit ;
  4367. @processed 1 = ;
  4368. }
  4369. if name "->" strcmp 0 == {
  4370. # Push the address
  4371. ast ctx lctx ast_push_addr ;
  4372. # pop eax
  4373. ctx 0x58 cctx_emit ;
  4374. ctx ctx type_idx cctx_type_footprint cctx_gen_push_data ;
  4375. @processed 1 = ;
  4376. }
  4377. if name "?" strcmp 0 == {
  4378. $else_lab
  4379. $end_lab
  4380. @else_lab lctx ctx lctx_gen_label = ;
  4381. @end_lab lctx ctx lctx_gen_label = ;
  4382. # Evaluate guard expression
  4383. ast AST_LEFT take ctx lctx ast_push_value ;
  4384. lctx ctx ast AST_LEFT take ctx lctx ast_eval_type TYPE_BOOL lctx_convert_stack ;
  4385. # pop eax; test eax, eax; cctx_gen_label_jump
  4386. ctx 0x58 cctx_emit ;
  4387. ctx 0x85 cctx_emit ;
  4388. ctx 0xc0 cctx_emit ;
  4389. ctx lctx else_lab JUMP_TYPE_JZ 0 cctx_gen_label_jump ;
  4390. # Evaluate center expression
  4391. ast AST_CENTER take ctx lctx ast_push_value ;
  4392. lctx ctx ast AST_CENTER take ctx lctx ast_eval_type type_idx lctx_convert_stack ;
  4393. # cctx_gen_label_jump
  4394. ctx lctx end_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4395. # Evaluate right expression
  4396. lctx ctx else_lab lctx_fix_label ;
  4397. ast AST_RIGHT take ctx lctx ast_push_value ;
  4398. lctx ctx ast AST_RIGHT take ctx lctx ast_eval_type type_idx lctx_convert_stack ;
  4399. lctx ctx end_lab lctx_fix_label ;
  4400. @processed 1 = ;
  4401. }
  4402. if name "(_PRE" strcmp 0 == {
  4403. ast AST_RIGHT take ctx lctx ast_push_value ;
  4404. if type_idx TYPE_VOID == {
  4405. # Cast to void, discard the return value
  4406. $right_type
  4407. @right_type ast AST_RIGHT take ctx lctx ast_eval_type = ;
  4408. if right_type TYPE_VOID != {
  4409. # add esp, footprint
  4410. ctx 0x81 cctx_emit ;
  4411. ctx 0xc4 cctx_emit ;
  4412. ctx ctx right_type cctx_type_footprint cctx_emit32 ;
  4413. }
  4414. } else {
  4415. lctx ctx ast AST_RIGHT take ctx lctx ast_eval_type type_idx lctx_convert_stack ;
  4416. }
  4417. @processed 1 = ;
  4418. }
  4419. if name "sizeof_PRE" strcmp 0 == {
  4420. $sub_type_idx
  4421. @sub_type_idx ast AST_RIGHT take ctx lctx ast_eval_type = ;
  4422. if ast AST_RIGHT take AST_ORIG_TYPE_IDX take 0xffffffff != {
  4423. @sub_type_idx ast AST_RIGHT take AST_ORIG_TYPE_IDX take = ;
  4424. }
  4425. # push type_size
  4426. ctx 0x68 cctx_emit ;
  4427. ctx ctx sub_type_idx cctx_type_size cctx_emit32 ;
  4428. @processed 1 = ;
  4429. }
  4430. if name "," strcmp 0 == {
  4431. # Push left and discard
  4432. ast AST_LEFT take ctx lctx ast_push_value ;
  4433. if ast AST_LEFT take ctx lctx ast_eval_type TYPE_VOID != {
  4434. $footprint
  4435. @footprint ctx ast AST_LEFT take ctx lctx ast_eval_type cctx_type_footprint = ;
  4436. # add esp, footprint
  4437. ctx 0x81 cctx_emit ;
  4438. ctx 0xc4 cctx_emit ;
  4439. ctx footprint cctx_emit32 ;
  4440. }
  4441. # Push right
  4442. ast AST_RIGHT take ctx lctx ast_push_value ;
  4443. @processed 1 = ;
  4444. }
  4445. processed "ast_push_value: not implemented" name assert_msg_str ;
  4446. }
  4447. }
  4448. fun ast_c_eval 3 {
  4449. $ast
  4450. $ctx
  4451. $lctx
  4452. @ast 2 param = ;
  4453. @ctx 1 param = ;
  4454. @lctx 0 param = ;
  4455. # First push value
  4456. ast ctx lctx ast_push_value ;
  4457. # Then pop and discard it (if it is not void)
  4458. $type_idx
  4459. @type_idx ast ctx lctx ast_eval_type = ;
  4460. if type_idx TYPE_VOID != {
  4461. $footprint
  4462. @footprint ctx type_idx cctx_type_footprint = ;
  4463. # add esp, footprint
  4464. ctx 0x81 cctx_emit ;
  4465. ctx 0xc4 cctx_emit ;
  4466. ctx footprint cctx_emit32 ;
  4467. }
  4468. }
  4469. fun cctx_compile_expression 2 {
  4470. $ctx
  4471. $lctx
  4472. $target_type_idx
  4473. $end_tok
  4474. @ctx 3 param = ;
  4475. @lctx 2 param = ;
  4476. @target_type_idx 1 param = ;
  4477. @end_tok 0 param = ;
  4478. $ast
  4479. @ast ctx end_tok cctx_parse_ast1 = ;
  4480. #ast ctx lctx ast_eval_type ;
  4481. #ast ast_dump ;
  4482. if target_type_idx TYPE_VOID == {
  4483. ast ctx lctx ast_c_eval ;
  4484. } else {
  4485. ast ctx lctx ast_push_value ;
  4486. lctx ctx ast ctx lctx ast_eval_type target_type_idx lctx_convert_stack ;
  4487. }
  4488. ast ast_destroy ;
  4489. }
  4490. ifun cctx_compile_statement_or_block 2
  4491. ifun cctx_compile_block 2
  4492. fun cctx_compile_statement 2 {
  4493. $ctx
  4494. $lctx
  4495. @ctx 1 param = ;
  4496. @lctx 0 param = ;
  4497. $processed
  4498. @processed 0 = ;
  4499. $tok
  4500. @tok ctx cctx_get_token_or_fail = ;
  4501. # Check if we found the closing brace
  4502. if tok "}" strcmp 0 == processed ! && {
  4503. @processed 1 = ;
  4504. 0 ret ;
  4505. }
  4506. $expect_semicolon
  4507. @expect_semicolon 0 = ;
  4508. # Allow and ignore empty statements
  4509. if tok ";" strcmp 0 == processed ! && {
  4510. @processed 1 = ;
  4511. }
  4512. # Allow a block to be began at every point (with this
  4513. # cctx_compile_statement_or_block could be simplified)
  4514. if tok "{" strcmp 0 == processed ! && {
  4515. ctx lctx cctx_compile_block ;
  4516. @processed 1 = ;
  4517. }
  4518. # Parse return
  4519. if tok "return" strcmp 0 == processed ! && {
  4520. $ret_type
  4521. @ret_type lctx LCTX_RETURN_TYPE_IDX take = ;
  4522. if ret_type TYPE_VOID != {
  4523. ctx lctx ret_type ";" cctx_compile_expression ;
  4524. if lctx LCTX_RETURNS_OBJ take {
  4525. # mov eax, [ebp+8]; cctx_gen_move_data; add esp, size
  4526. ctx 0x8b cctx_emit ;
  4527. ctx 0x45 cctx_emit ;
  4528. ctx 0x08 cctx_emit ;
  4529. ctx ctx ret_type cctx_type_size cctx_gen_move_data ;
  4530. ctx 0x81 cctx_emit ;
  4531. ctx 0xc4 cctx_emit ;
  4532. ctx ctx ret_type cctx_type_footprint cctx_emit32 ;
  4533. } else {
  4534. # pop eax
  4535. ctx 0x58 cctx_emit ;
  4536. if ctx ret_type cctx_type_footprint 8 == {
  4537. # pop edx
  4538. ctx 0x5a cctx_emit ;
  4539. } else {
  4540. ctx ret_type cctx_type_footprint 4 == "cctx_compile_statement: error 2" assert_msg ;
  4541. }
  4542. }
  4543. }
  4544. ctx lctx lctx LCTX_RETURN_LABEL take JUMP_TYPE_JMP 1 cctx_gen_label_jump ;
  4545. @processed 1 = ;
  4546. @expect_semicolon 1 = ;
  4547. }
  4548. # Parse break
  4549. if tok "break" strcmp 0 == processed ! && {
  4550. ctx lctx lctx LCTX_BREAK_LABEL take JUMP_TYPE_JMP 1 cctx_gen_label_jump ;
  4551. @processed 1 = ;
  4552. @expect_semicolon 1 = ;
  4553. }
  4554. # Parse continue
  4555. if tok "continue" strcmp 0 == processed ! && {
  4556. ctx lctx lctx LCTX_CONTINUE_LABEL take JUMP_TYPE_JMP 1 cctx_gen_label_jump ;
  4557. @processed 1 = ;
  4558. @expect_semicolon 1 = ;
  4559. }
  4560. # Parse if
  4561. if tok "if" strcmp 0 == processed ! && {
  4562. $else_lab
  4563. $end_lab
  4564. @else_lab lctx ctx lctx_gen_label = ;
  4565. @end_lab lctx ctx lctx_gen_label = ;
  4566. # Compile guard expression
  4567. @tok ctx cctx_get_token_or_fail = ;
  4568. tok "(" strcmp 0 == "cctx_compile_statement: ( expected" assert_msg ;
  4569. ctx lctx TYPE_BOOL ")" cctx_compile_expression ;
  4570. @tok ctx cctx_get_token_or_fail = ;
  4571. tok ")" strcmp 0 == "cctx_compile_statement: ) expected" assert_msg ;
  4572. # pop eax; test eax, eax; cctx_gen_label_jump
  4573. ctx 0x58 cctx_emit ;
  4574. ctx 0x85 cctx_emit ;
  4575. ctx 0xc0 cctx_emit ;
  4576. ctx lctx else_lab JUMP_TYPE_JZ 0 cctx_gen_label_jump ;
  4577. # Compile body
  4578. ctx lctx cctx_compile_statement_or_block ;
  4579. # cctx_gen_label_jump
  4580. ctx lctx end_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4581. # Compile else
  4582. lctx ctx else_lab lctx_fix_label ;
  4583. @tok ctx cctx_get_token_or_fail = ;
  4584. if tok "else" strcmp 0 == {
  4585. ctx lctx cctx_compile_statement_or_block ;
  4586. } else {
  4587. ctx cctx_give_back_token ;
  4588. }
  4589. lctx ctx end_lab lctx_fix_label ;
  4590. @processed 1 = ;
  4591. }
  4592. # Parse for
  4593. if tok "for" strcmp 0 == processed ! && {
  4594. # Set up labels
  4595. $continue_lab
  4596. $break_lab
  4597. $restart_lab
  4598. $body_lab
  4599. @continue_lab lctx ctx lctx_gen_label = ;
  4600. @break_lab lctx ctx lctx_gen_label = ;
  4601. @restart_lab lctx ctx lctx_gen_label = ;
  4602. @body_lab lctx ctx lctx_gen_label = ;
  4603. # Compile initialization expression
  4604. @tok ctx cctx_get_token_or_fail = ;
  4605. tok "(" strcmp 0 == "cctx_compile_statement: ( expected after for" assert_msg ;
  4606. @tok ctx cctx_get_token_or_fail = ;
  4607. if tok ";" strcmp 0 != {
  4608. ctx cctx_give_back_token ;
  4609. ctx lctx TYPE_VOID ";" cctx_compile_expression ;
  4610. @tok ctx cctx_get_token_or_fail = ;
  4611. tok ";" strcmp 0 == "cctx_compile_statement: ; expected after for" assert_msg ;
  4612. }
  4613. # Compile guard expression
  4614. lctx ctx restart_lab lctx_fix_label ;
  4615. @tok ctx cctx_get_token_or_fail = ;
  4616. if tok ";" strcmp 0 != {
  4617. ctx cctx_give_back_token ;
  4618. ctx lctx TYPE_BOOL ";" cctx_compile_expression ;
  4619. @tok ctx cctx_get_token_or_fail = ;
  4620. tok ";" strcmp 0 == "cctx_compile_statement: second ; expected after for" assert_msg ;
  4621. } else {
  4622. # push 1
  4623. ctx 0x6a cctx_emit ;
  4624. ctx 0x01 cctx_emit ;
  4625. }
  4626. # pop eax; test eax, eax; cctx_gen_label_jump; cctx_gen_label_jump
  4627. ctx 0x58 cctx_emit ;
  4628. ctx 0x85 cctx_emit ;
  4629. ctx 0xc0 cctx_emit ;
  4630. ctx lctx break_lab JUMP_TYPE_JZ 0 cctx_gen_label_jump ;
  4631. ctx lctx body_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4632. # Compile iteration expression
  4633. lctx ctx continue_lab lctx_fix_label ;
  4634. @tok ctx cctx_get_token_or_fail = ;
  4635. if tok ")" strcmp 0 != {
  4636. ctx cctx_give_back_token ;
  4637. ctx lctx TYPE_VOID ")" cctx_compile_expression ;
  4638. @tok ctx cctx_get_token_or_fail = ;
  4639. tok ")" strcmp 0 == "cctx_compile_statement: ) expected after for" assert_msg ;
  4640. }
  4641. # cctx_gen_label_jump
  4642. ctx lctx restart_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4643. # Compile body
  4644. $old_break_lab
  4645. $old_continue_lab
  4646. @old_break_lab lctx LCTX_BREAK_LABEL take = ;
  4647. @old_continue_lab lctx LCTX_CONTINUE_LABEL take = ;
  4648. lctx LCTX_BREAK_LABEL take_addr break_lab = ;
  4649. lctx LCTX_CONTINUE_LABEL take_addr continue_lab = ;
  4650. lctx ctx body_lab lctx_fix_label ;
  4651. ctx lctx cctx_compile_statement_or_block ;
  4652. lctx LCTX_BREAK_LABEL take_addr old_break_lab = ;
  4653. lctx LCTX_CONTINUE_LABEL take_addr old_continue_lab = ;
  4654. # cctx_gen_label_jump
  4655. ctx lctx continue_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4656. lctx ctx break_lab lctx_fix_label ;
  4657. @processed 1 = ;
  4658. }
  4659. # Parse while
  4660. if tok "while" strcmp 0 == processed ! && {
  4661. # Set up labels
  4662. $continue_lab
  4663. $break_lab
  4664. @continue_lab lctx ctx lctx_gen_label = ;
  4665. @break_lab lctx ctx lctx_gen_label = ;
  4666. # Compile guard expression
  4667. lctx ctx continue_lab lctx_fix_label ;
  4668. @tok ctx cctx_get_token_or_fail = ;
  4669. tok "(" strcmp 0 == "cctx_compile_statement: ( expected after while" assert_msg ;
  4670. ctx lctx TYPE_BOOL ")" cctx_compile_expression ;
  4671. @tok ctx cctx_get_token_or_fail = ;
  4672. tok ")" strcmp 0 == "cctx_compile_statement: ) expected after while" assert_msg ;
  4673. # pop eax; test eax, eax; cctx_gen_label_jump
  4674. ctx 0x58 cctx_emit ;
  4675. ctx 0x85 cctx_emit ;
  4676. ctx 0xc0 cctx_emit ;
  4677. ctx lctx break_lab JUMP_TYPE_JZ 0 cctx_gen_label_jump ;
  4678. # Compile body
  4679. $old_break_lab
  4680. $old_continue_lab
  4681. @old_break_lab lctx LCTX_BREAK_LABEL take = ;
  4682. @old_continue_lab lctx LCTX_CONTINUE_LABEL take = ;
  4683. lctx LCTX_BREAK_LABEL take_addr break_lab = ;
  4684. lctx LCTX_CONTINUE_LABEL take_addr continue_lab = ;
  4685. ctx lctx cctx_compile_statement_or_block ;
  4686. lctx LCTX_BREAK_LABEL take_addr old_break_lab = ;
  4687. lctx LCTX_CONTINUE_LABEL take_addr old_continue_lab = ;
  4688. # cctx_gen_label_jump
  4689. ctx lctx continue_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4690. lctx ctx break_lab lctx_fix_label ;
  4691. @processed 1 = ;
  4692. }
  4693. # Parse do ... while
  4694. if tok "do" strcmp 0 == processed ! && {
  4695. # Set up labels
  4696. $continue_lab
  4697. $break_lab
  4698. $restart_lab
  4699. @continue_lab lctx ctx lctx_gen_label = ;
  4700. @break_lab lctx ctx lctx_gen_label = ;
  4701. @restart_lab lctx ctx lctx_gen_label = ;
  4702. # Compile body
  4703. lctx ctx restart_lab lctx_fix_label ;
  4704. $old_break_lab
  4705. $old_continue_lab
  4706. @old_break_lab lctx LCTX_BREAK_LABEL take = ;
  4707. @old_continue_lab lctx LCTX_CONTINUE_LABEL take = ;
  4708. lctx LCTX_BREAK_LABEL take_addr break_lab = ;
  4709. lctx LCTX_CONTINUE_LABEL take_addr continue_lab = ;
  4710. ctx lctx cctx_compile_statement_or_block ;
  4711. lctx LCTX_BREAK_LABEL take_addr old_break_lab = ;
  4712. lctx LCTX_CONTINUE_LABEL take_addr old_continue_lab = ;
  4713. # Except while
  4714. @tok ctx cctx_get_token_or_fail = ;
  4715. tok "while" strcmp 0 == "cctx_compile_statement: while expected after do" assert_msg ;
  4716. # Compile guard expression
  4717. lctx ctx continue_lab lctx_fix_label ;
  4718. @tok ctx cctx_get_token_or_fail = ;
  4719. tok "(" strcmp 0 == "cctx_compile_statement: ( expected after while after do" assert_msg ;
  4720. ctx lctx TYPE_BOOL ")" cctx_compile_expression ;
  4721. @tok ctx cctx_get_token_or_fail = ;
  4722. tok ")" strcmp 0 == "cctx_compile_statement: ) expected after while after do" assert_msg ;
  4723. # pop eax; test eax, eax; cctx_gen_label_jump
  4724. ctx 0x58 cctx_emit ;
  4725. ctx 0x85 cctx_emit ;
  4726. ctx 0xc0 cctx_emit ;
  4727. ctx lctx break_lab JUMP_TYPE_JZ 0 cctx_gen_label_jump ;
  4728. # cctx_gen_label_jump
  4729. ctx lctx restart_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4730. lctx ctx break_lab lctx_fix_label ;
  4731. @expect_semicolon 1 = ;
  4732. @processed 1 = ;
  4733. }
  4734. # Parse switch
  4735. if tok "switch" strcmp 0 == processed ! && {
  4736. $break_lab
  4737. $logic_lab
  4738. @break_lab lctx ctx lctx_gen_label = ;
  4739. @logic_lab lctx ctx lctx_gen_label = ;
  4740. # Compile switch expression
  4741. @tok ctx cctx_get_token_or_fail = ;
  4742. tok "(" strcmp 0 == "cctx_compile_statement: ( expected after switch" assert_msg ;
  4743. $ast
  4744. @ast ctx ")" cctx_parse_ast1 = ;
  4745. $type_idx
  4746. @type_idx ast ctx lctx ast_eval_type promote_integer_type = ;
  4747. ast ctx lctx ast_push_value ;
  4748. lctx ctx ast ctx lctx ast_eval_type type_idx lctx_convert_stack ;
  4749. lctx ctx type_idx TYPE_ULONG lctx_convert_stack ;
  4750. ast ast_destroy ;
  4751. @tok ctx cctx_get_token_or_fail = ;
  4752. tok ")" strcmp 0 == "cctx_compile_statement: ) expected after switch" assert_msg ;
  4753. # Jump to the switch logic, which is at the end (because for the
  4754. # moment we have no idea of which labels will appear)
  4755. ctx lctx logic_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4756. # Compile the body
  4757. $old_break_lab
  4758. $old_default_lab
  4759. $old_case_labs
  4760. @old_break_lab lctx LCTX_BREAK_LABEL take = ;
  4761. @old_default_lab lctx LCTX_DEFAULT_LABEL take = ;
  4762. @old_case_labs lctx LCTX_CASE_LABELS take = ;
  4763. lctx LCTX_BREAK_LABEL take_addr break_lab = ;
  4764. lctx LCTX_DEFAULT_LABEL take_addr 0xffffffff = ;
  4765. lctx LCTX_CASE_LABELS take_addr 8 vector_init = ;
  4766. ctx lctx cctx_compile_statement_or_block ;
  4767. # Jump to the break, to avoid doing the switch logic again
  4768. ctx lctx break_lab JUMP_TYPE_JMP 0 cctx_gen_label_jump ;
  4769. # Switch logic
  4770. lctx ctx logic_lab lctx_fix_label ;
  4771. $i
  4772. @i 0 = ;
  4773. $labs
  4774. @labs lctx LCTX_CASE_LABELS take = ;
  4775. while i labs vector_size < {
  4776. $ast
  4777. $lab
  4778. @ast labs i vector_at_addr ** = ;
  4779. @lab labs i vector_at_addr 4 + ** = ;
  4780. ast ctx lctx ast_push_value ;
  4781. lctx ctx ast ctx lctx ast_eval_type type_idx lctx_convert_stack ;
  4782. lctx ctx type_idx TYPE_ULONG lctx_convert_stack ;
  4783. # cctx_gen_label_jump with conditional jump and stack rewind
  4784. # modifies EAX
  4785. # pop eax; pop edx; sub eax, [esp]; sub edx, [esp+4]; or eax, edx; pop ecx; pop edx; cctx_gen_label_jump; push edx; push ecx
  4786. ctx 0x58 cctx_emit ;
  4787. ctx 0x5a cctx_emit ;
  4788. ctx 0x2b cctx_emit ;
  4789. ctx 0x04 cctx_emit ;
  4790. ctx 0x24 cctx_emit ;
  4791. ctx 0x2b cctx_emit ;
  4792. ctx 0x54 cctx_emit ;
  4793. ctx 0x24 cctx_emit ;
  4794. ctx 0x04 cctx_emit ;
  4795. ctx 0x09 cctx_emit ;
  4796. ctx 0xd0 cctx_emit ;
  4797. ctx 0x59 cctx_emit ;
  4798. ctx 0x5a cctx_emit ;
  4799. ctx lctx lab JUMP_TYPE_JZ 1 cctx_gen_label_jump ;
  4800. ctx 0x52 cctx_emit ;
  4801. ctx 0x51 cctx_emit ;
  4802. ast ast_destroy ;
  4803. @i i 1 + = ;
  4804. }
  4805. # Discard the switch value
  4806. # pop eax; pop edx
  4807. ctx 0x58 cctx_emit ;
  4808. ctx 0x5a cctx_emit ;
  4809. if lctx LCTX_DEFAULT_LABEL take 0xffffffff != {
  4810. # cctx_gen_label_jump
  4811. ctx lctx lctx LCTX_DEFAULT_LABEL take JUMP_TYPE_JMP 1 cctx_gen_label_jump ;
  4812. }
  4813. lctx LCTX_CASE_LABELS take vector_destroy ;
  4814. lctx LCTX_BREAK_LABEL take_addr old_break_lab = ;
  4815. lctx LCTX_DEFAULT_LABEL take_addr old_default_lab = ;
  4816. lctx LCTX_CASE_LABELS take_addr old_case_labs = ;
  4817. # Finally, fix break label
  4818. lctx ctx break_lab lctx_fix_label ;
  4819. @processed 1 = ;
  4820. }
  4821. # Parse case
  4822. if tok "case" strcmp 0 == processed ! && {
  4823. $labs
  4824. @labs lctx LCTX_CASE_LABELS take = ;
  4825. $ast
  4826. @ast ctx ":" cctx_parse_ast1 = ;
  4827. # Evaluate the AST to check that it is constant
  4828. ctx lctx ast ast_eval_compile ;
  4829. @tok ctx cctx_get_token_or_fail = ;
  4830. tok ":" strcmp 0 == "cctx_compile_statement: expected : after case" assert_msg ;
  4831. labs 0 != "cctx_compile_statement: not in a switch block" assert_msg ;
  4832. $lab
  4833. @lab lctx ctx lctx_gen_label = ;
  4834. lctx ctx lab lctx_fix_label ;
  4835. labs ast vector_push_back ;
  4836. labs labs vector_size 1 - vector_at_addr 4 + lab = ;
  4837. ctx lctx cctx_compile_statement_or_block ;
  4838. @expect_semicolon 0 = ;
  4839. @processed 1 = ;
  4840. }
  4841. # Parse default
  4842. if tok "default" strcmp 0 == processed ! && {
  4843. @tok ctx cctx_get_token_or_fail = ;
  4844. tok ":" strcmp 0 == "cctx_compile_statement: expected : after default" assert_msg ;
  4845. lctx LCTX_CASE_LABELS take 0 != "cctx_compile_statement: not in a switch block" assert_msg ;
  4846. lctx LCTX_DEFAULT_LABEL take 0xffffffff == "cctx_compile_statement: default label already seen" assert_msg ;
  4847. $lab
  4848. @lab lctx ctx lctx_gen_label = ;
  4849. lctx ctx lab lctx_fix_label ;
  4850. lctx LCTX_DEFAULT_LABEL take_addr lab = ;
  4851. ctx lctx cctx_compile_statement_or_block ;
  4852. @expect_semicolon 0 = ;
  4853. @processed 1 = ;
  4854. }
  4855. # Parse goto
  4856. if tok "goto" strcmp 0 == processed ! && {
  4857. @tok ctx cctx_get_token_or_fail = ;
  4858. $lab
  4859. if lctx LCTX_GOTO_LABELS take tok map_has {
  4860. @lab lctx LCTX_GOTO_LABELS take tok map_at = ;
  4861. } else {
  4862. @lab lctx ctx lctx_gen_label = ;
  4863. lctx LCTX_GOTO_LABELS take tok lab map_set ;
  4864. }
  4865. # cctx_gen_label_jump
  4866. ctx lctx lab JUMP_TYPE_JMP 1 cctx_gen_label_jump ;
  4867. @processed 1 = ;
  4868. @expect_semicolon 1 = ;
  4869. }
  4870. # Consider one more token to see if it is a goto label
  4871. if processed ! {
  4872. $tok2
  4873. @tok2 ctx cctx_get_token_or_fail = ;
  4874. if tok2 ":" strcmp 0 == {
  4875. $lab
  4876. if lctx LCTX_GOTO_LABELS take tok map_has {
  4877. @lab lctx LCTX_GOTO_LABELS take tok map_at = ;
  4878. } else {
  4879. @lab lctx ctx lctx_gen_label = ;
  4880. lctx LCTX_GOTO_LABELS take tok lab map_set ;
  4881. }
  4882. lctx ctx lab lctx_fix_label ;
  4883. ctx lctx cctx_compile_statement_or_block ;
  4884. @expect_semicolon 0 = ;
  4885. @processed 1 = ;
  4886. } else {
  4887. ctx cctx_give_back_token ;
  4888. }
  4889. }
  4890. if processed ! {
  4891. ctx cctx_give_back_token ;
  4892. # Try to parse a type, in which case we have a variable declaration
  4893. $type_idx
  4894. @type_idx ctx cctx_parse_type = ;
  4895. if type_idx 0xffffffff != {
  4896. # There is a type, so we have a variable declaration
  4897. $cont
  4898. @cont 1 = ;
  4899. while cont {
  4900. $actual_type_idx
  4901. $name
  4902. ctx lctx type_idx @actual_type_idx @name 0 cctx_parse_declarator "cctx_compile_statement: error 1" assert_msg ;
  4903. name 0 != "cctx_compile_statement: cannot instantiate variable without name" assert_msg ;
  4904. lctx ctx actual_type_idx name lctx_push_var ;
  4905. @tok ctx cctx_get_token_or_fail = ;
  4906. if tok "=" strcmp 0 == {
  4907. $right_ast
  4908. $left_ast
  4909. $ast
  4910. @right_ast ctx "," ";" cctx_parse_ast2 = ;
  4911. @left_ast ast_init = ;
  4912. left_ast AST_TYPE take_addr 0 = ;
  4913. left_ast AST_NAME take_addr name strdup = ;
  4914. @ast ast_init = ;
  4915. ast AST_TYPE take_addr 1 = ;
  4916. ast AST_NAME take_addr "=" strdup = ;
  4917. ast AST_RIGHT take_addr right_ast = ;
  4918. ast AST_LEFT take_addr left_ast = ;
  4919. ast ctx lctx ast_c_eval ;
  4920. ast ast_destroy ;
  4921. } else {
  4922. ctx cctx_give_back_token ;
  4923. }
  4924. @tok ctx cctx_get_token_or_fail = ;
  4925. if tok ";" strcmp 0 == {
  4926. ctx cctx_give_back_token ;
  4927. @cont 0 = ;
  4928. } else {
  4929. tok "," strcmp 0 == "cctx_compile_statement: comma expected" assert_msg ;
  4930. }
  4931. }
  4932. } else {
  4933. # No type, so this is an expression
  4934. ctx lctx TYPE_VOID ";" cctx_compile_expression ;
  4935. }
  4936. @expect_semicolon 1 = ;
  4937. }
  4938. # Expect and consume the semicolon
  4939. if expect_semicolon {
  4940. @tok ctx cctx_get_token_or_fail = ;
  4941. tok ";" strcmp 0 == "cctx_compile_statement: ; expected" assert_msg ;
  4942. }
  4943. 1 ret ;
  4944. }
  4945. fun cctx_compile_block 2 {
  4946. $ctx
  4947. $lctx
  4948. @ctx 1 param = ;
  4949. @lctx 0 param = ;
  4950. $saved_pos
  4951. @saved_pos lctx ctx lctx_save_status = ;
  4952. $cont
  4953. @cont 1 = ;
  4954. while cont {
  4955. @cont ctx lctx cctx_compile_statement = ;
  4956. }
  4957. lctx ctx saved_pos lctx_restore_status ;
  4958. }
  4959. fun cctx_compile_statement_or_block 2 {
  4960. $ctx
  4961. $lctx
  4962. @ctx 1 param = ;
  4963. @lctx 0 param = ;
  4964. $tok
  4965. @tok ctx cctx_get_token_or_fail = ;
  4966. if tok "{" strcmp 0 == {
  4967. ctx lctx cctx_compile_block ;
  4968. } else {
  4969. ctx cctx_give_back_token ;
  4970. ctx lctx cctx_compile_statement ;
  4971. }
  4972. }
  4973. fun cctx_compile_function 3 {
  4974. $ctx
  4975. $type_idx
  4976. $arg_names
  4977. @ctx 2 param = ;
  4978. @type_idx 1 param = ;
  4979. @arg_names 0 param = ;
  4980. # Costruct the local context
  4981. $lctx
  4982. @lctx lctx_init = ;
  4983. lctx LCTX_RETURN_LABEL take_addr lctx ctx lctx_gen_label = ;
  4984. lctx LCTX_RETURN_TYPE_IDX take_addr ctx type_idx cctx_get_type TYPE_BASE take = ;
  4985. lctx ctx type_idx arg_names lctx_prime_stack ;
  4986. lctx ctx lctx_gen_prologue ;
  4987. ctx lctx cctx_compile_block ;
  4988. lctx ctx lctx LCTX_RETURN_LABEL take lctx_fix_label ;
  4989. lctx ctx lctx_gen_epilogue ;
  4990. lctx lctx_destroy ;
  4991. }
  4992. fun cctx_mangle_function_type 2 {
  4993. $ctx
  4994. $type_idx
  4995. @ctx 1 param = ;
  4996. @type_idx 0 param = ;
  4997. $type
  4998. @type ctx type_idx cctx_get_type = ;
  4999. type TYPE_KIND take TYPE_KIND_FUNCTION == "cctx_mangle_function_type: not a function type" assert_msg ;
  5000. $base_idx
  5001. @base_idx type TYPE_BASE take = ;
  5002. $args
  5003. @args type TYPE_ARGS take = ;
  5004. $new_args
  5005. @new_args 4 vector_init = ;
  5006. $ellipsis
  5007. @ellipsis type TYPE_ELLIPSIS take = ;
  5008. $i
  5009. @i 0 = ;
  5010. while i args vector_size < {
  5011. $arg_idx
  5012. @arg_idx args i vector_at = ;
  5013. $arg_type
  5014. @arg_type ctx arg_idx cctx_get_type = ;
  5015. if arg_type TYPE_KIND take TYPE_KIND_ARRAY == {
  5016. $arg_base
  5017. @arg_base arg_type TYPE_BASE take = ;
  5018. @arg_idx ctx arg_base cctx_get_pointer_type = ;
  5019. }
  5020. if arg_type TYPE_KIND take TYPE_KIND_FUNCTION == {
  5021. @arg_idx ctx arg_idx cctx_get_pointer_type = ;
  5022. }
  5023. new_args arg_idx vector_push_back ;
  5024. @i i 1 + = ;
  5025. }
  5026. ctx base_idx new_args ellipsis cctx_get_function_type ret ;
  5027. }
  5028. fun cctx_assign_with_size 4 {
  5029. $ctx
  5030. $loc
  5031. $value
  5032. $size
  5033. @ctx 3 param = ;
  5034. @loc 2 param = ;
  5035. @value 1 param = ;
  5036. @size 0 param = ;
  5037. if ctx CCTX_STAGE take 2 != {
  5038. ret ;
  5039. }
  5040. if size 1 == {
  5041. loc value ** =c ;
  5042. ret ;
  5043. }
  5044. if size 2 == {
  5045. loc value ** =c ;
  5046. loc 1 + value ** 8 >> =c ;
  5047. ret ;
  5048. }
  5049. if size 4 == {
  5050. loc value ** = ;
  5051. ret ;
  5052. }
  5053. if size 8 == {
  5054. loc value ** = ;
  5055. loc 4 + value 4 + ** = ;
  5056. ret ;
  5057. }
  5058. 0 "cctx_assign_with_size: invalid size" assert_msg ;
  5059. }
  5060. fun cctx_parse_initializer 3 {
  5061. $ctx
  5062. $type_idx
  5063. $loc
  5064. @ctx 2 param = ;
  5065. @type_idx 1 param = ;
  5066. @loc 0 param = ;
  5067. $type
  5068. @type ctx type_idx cctx_get_type = ;
  5069. if type_idx is_integer_type type TYPE_KIND take TYPE_KIND_POINTER == || {
  5070. $ast
  5071. @ast ctx "," "}" ";" cctx_parse_ast3 = ;
  5072. #ast ast_dump ;
  5073. ctx 0 ast ast_eval_compile ;
  5074. $size
  5075. @size ctx type_idx cctx_type_size = ;
  5076. ctx loc ast AST_VALUE take size cctx_assign_with_size ;
  5077. ast ast_destroy ;
  5078. 0xffffffff ret ;
  5079. }
  5080. if type TYPE_KIND take TYPE_KIND_STRUCT == {
  5081. $tok
  5082. @tok ctx cctx_get_token_or_fail = ;
  5083. tok "{" strcmp 0 == "cctx_parse_initializer: { expected" assert_msg ;
  5084. $i
  5085. @i 0 = ;
  5086. $offs
  5087. @offs type TYPE_FIELDS_OFFS take = ;
  5088. $type_idxs
  5089. @type_idxs type TYPE_FIELDS_TYPE_IDXS take = ;
  5090. while i offs vector_size < {
  5091. @tok ctx cctx_get_token_or_fail = ;
  5092. if tok "}" strcmp 0 == {
  5093. @i offs vector_size = ;
  5094. } else {
  5095. ctx cctx_give_back_token ;
  5096. ctx type_idxs i vector_at loc offs i vector_at + cctx_parse_initializer ;
  5097. @tok ctx cctx_get_token_or_fail = ;
  5098. if tok "}" strcmp 0 == {
  5099. @i offs vector_size = ;
  5100. } else {
  5101. tok "," strcmp 0 == "cctx_parse_initializer: , or } expected" assert_msg ;
  5102. @i i 1 + = ;
  5103. }
  5104. }
  5105. }
  5106. tok "}" strcmp 0 == "cctx_parse_initializer: initializer has too many entries" assert_msg ;
  5107. 0xffffffff ret ;
  5108. }
  5109. if type TYPE_KIND take TYPE_KIND_ARRAY == type TYPE_BASE take TYPE_CHAR == && {
  5110. $tok
  5111. @tok ctx cctx_get_token_or_fail = ;
  5112. if tok **c '\"' == {
  5113. @tok tok 1 + = ;
  5114. $i
  5115. @i 0 = ;
  5116. $len
  5117. @len type TYPE_LENGTH take = ;
  5118. while i len 1 - < len 0xffffffff == || {
  5119. if tok **c '\"' == {
  5120. tok 1 + **c '\0' == "cctx_parse_initializer: illegal string literal" assert_msg ;
  5121. # Add the final blank
  5122. if ctx CCTX_STAGE take 0 != {
  5123. loc '\0' =c ;
  5124. }
  5125. if len 0xffffffff == {
  5126. @len i 1 + = ;
  5127. }
  5128. @i len 1 - = ;
  5129. } else {
  5130. if ctx CCTX_STAGE take 0 == {
  5131. @tok 1 ctx escape_char ;
  5132. } else {
  5133. @tok @loc ctx escape_char ;
  5134. }
  5135. @i i 1 + = ;
  5136. }
  5137. }
  5138. tok **c '\"' == "cctx_parse_initializer: initializer string is too long" assert_msg ;
  5139. tok 1 + **c '\0' == "cctx_parse_initializer: illegal string literal" assert_msg ;
  5140. len ret ;
  5141. } else {
  5142. ctx cctx_give_back_token ;
  5143. }
  5144. }
  5145. if type TYPE_KIND take TYPE_KIND_ARRAY == {
  5146. $tok
  5147. @tok ctx cctx_get_token_or_fail = ;
  5148. tok "{" strcmp 0 == "cctx_parse_initializer: { expected" assert_msg ;
  5149. $i
  5150. @i 0 = ;
  5151. $len
  5152. @len type TYPE_LENGTH take = ;
  5153. $base_type_idx
  5154. @base_type_idx type TYPE_BASE take = ;
  5155. $base_size
  5156. @base_size ctx base_type_idx cctx_type_size = ;
  5157. while i len < len 0xffffffff == || {
  5158. @tok ctx cctx_get_token_or_fail = ;
  5159. if tok "}" strcmp 0 == {
  5160. if len 0xffffffff == {
  5161. @len i = ;
  5162. }
  5163. @i len = ;
  5164. } else {
  5165. ctx cctx_give_back_token ;
  5166. ctx base_type_idx loc i base_size * + cctx_parse_initializer ;
  5167. @tok ctx cctx_get_token_or_fail = ;
  5168. @i i 1 + = ;
  5169. if tok "}" strcmp 0 == {
  5170. if len 0xffffffff == {
  5171. @len i = ;
  5172. }
  5173. @i len = ;
  5174. } else {
  5175. tok "," strcmp 0 == "cctx_parse_initializer: , or } expected" assert_msg ;
  5176. }
  5177. }
  5178. }
  5179. if tok "," strcmp 0 == {
  5180. @tok ctx cctx_get_token_or_fail = ;
  5181. }
  5182. tok "}" strcmp 0 == "cctx_parse_initializer: initializer has too many entries" assert_msg ;
  5183. len ret ;
  5184. }
  5185. 0 "cctx_parse_initializer: not implemented" assert_msg ;
  5186. }
  5187. fun cctx_compile_line 1 {
  5188. $ctx
  5189. @ctx 0 param = ;
  5190. $tok
  5191. @tok ctx cctx_get_token_or_fail = ;
  5192. if tok "typedef" strcmp 0 == {
  5193. $type_idx
  5194. @type_idx ctx cctx_parse_type = ;
  5195. type_idx 0xffffffff != "cctx_compile_line: type expected after typedef" assert_msg ;
  5196. $cont
  5197. @cont 1 = ;
  5198. while cont {
  5199. $actual_type_idx
  5200. $name
  5201. ctx 0 type_idx @actual_type_idx @name 0 cctx_parse_declarator "cctx_compile_line: could not parse declarator after typedef" assert_msg ;
  5202. name 0 != "cctx_compile_line: cannot define type without name" assert_msg ;
  5203. $typenames
  5204. @typenames ctx CCTX_TYPENAMES take = ;
  5205. typenames name map_has ! "cctx_compile_line: type name already defined" assert_msg ;
  5206. typenames name actual_type_idx map_set ;
  5207. @tok ctx cctx_get_token_or_fail = ;
  5208. if tok ";" strcmp 0 == {
  5209. @cont 0 = ;
  5210. } else {
  5211. tok "," strcmp 0 == "cctx_compile_line: comma expected after typedef" assert_msg ;
  5212. }
  5213. }
  5214. ret ;
  5215. } else {
  5216. ctx cctx_give_back_token ;
  5217. }
  5218. $extern
  5219. $static
  5220. @extern 0 = ;
  5221. @static 0 = ;
  5222. $cont
  5223. @cont 1 = ;
  5224. while cont {
  5225. @tok ctx cctx_get_token_or_fail = ;
  5226. if tok "extern" strcmp 0 == {
  5227. @extern 1 = ;
  5228. } else {
  5229. if tok "static" strcmp 0 == {
  5230. @static 1 = ;
  5231. } else {
  5232. ctx cctx_give_back_token ;
  5233. @cont 0 = ;
  5234. }
  5235. }
  5236. }
  5237. $type_idx
  5238. @type_idx ctx cctx_parse_type = ;
  5239. type_idx 0xffffffff != "cctx_compile: type expected" tok assert_msg_str ;
  5240. @tok ctx cctx_get_token_or_fail = ;
  5241. if tok ";" strcmp 0 == {
  5242. @cont 0 = ;
  5243. } else {
  5244. ctx cctx_give_back_token ;
  5245. @cont 1 = ;
  5246. }
  5247. while cont {
  5248. $actual_type_idx
  5249. $name
  5250. $arg_names
  5251. @arg_names 4 vector_init = ;
  5252. ctx 0 type_idx @actual_type_idx @name arg_names cctx_parse_declarator "cctx_compile_line: could not parse declarator" assert_msg ;
  5253. $type
  5254. @type ctx actual_type_idx cctx_get_type = ;
  5255. name 0 != "cctx_compile_line: cannot instantiate variable without name" assert_msg ;
  5256. if type TYPE_KIND take TYPE_KIND_FUNCTION == {
  5257. # If it is a function, first mangle its parameters' types
  5258. @actual_type_idx ctx actual_type_idx cctx_mangle_function_type = ;
  5259. @type ctx actual_type_idx cctx_get_type = ;
  5260. # Then check if it has a body
  5261. @tok ctx cctx_get_token_or_fail = ;
  5262. if tok "{" strcmp 0 == {
  5263. # There is the body, register the global and compile the body
  5264. ctx name ctx CCTX_CURRENT_LOC take actual_type_idx cctx_add_global ;
  5265. ctx actual_type_idx arg_names cctx_compile_function ;
  5266. @cont 0 = ;
  5267. } else {
  5268. # No body, register the global with a fictious location
  5269. ctx cctx_give_back_token ;
  5270. ctx name 0xffffffff actual_type_idx cctx_add_global ;
  5271. }
  5272. } else {
  5273. if extern {
  5274. ctx name 0xffffffff actual_type_idx cctx_add_global ;
  5275. } else {
  5276. # If it is anything else, register it and allocate its size
  5277. $loc
  5278. @loc ctx CCTX_CURRENT_LOC take = ;
  5279. $initializer
  5280. @initializer 0 = ;
  5281. @tok ctx cctx_get_token_or_fail = ;
  5282. if tok "=" strcmp 0 == {
  5283. @initializer 1 = ;
  5284. } else {
  5285. ctx cctx_give_back_token ;
  5286. }
  5287. if ctx CCTX_STAGE take 0 == {
  5288. # During stage 0, if there is an initializer parse it
  5289. # immediately, because it might encode the length of an
  5290. # array
  5291. if initializer {
  5292. $actual_len
  5293. @actual_len ctx actual_type_idx loc cctx_parse_initializer = ;
  5294. if type TYPE_KIND take TYPE_KIND_ARRAY == type TYPE_LENGTH take 0xffffffff == && {
  5295. actual_len 0xffffffff != "cctx_compile_line: error 1" assert_msg ;
  5296. ctx CCTX_ARRAY_LENS take name actual_len map_set ;
  5297. @actual_type_idx ctx type TYPE_BASE take actual_len cctx_get_array_type = ;
  5298. @type ctx actual_type_idx cctx_get_type = ;
  5299. }
  5300. }
  5301. #type type_dump ;
  5302. $found
  5303. @found 0 = ;
  5304. if static ctx name cctx_has_global && {
  5305. @found 1 = ;
  5306. $global
  5307. @global ctx name cctx_get_global = ;
  5308. ctx global GLOBAL_TYPE_IDX take actual_type_idx cctx_type_compare "cctx_compile_line: global redefined with another type" name assert_msg_str ;
  5309. if initializer {
  5310. global GLOBAL_INITIALIZED take ! "cctx_compile_line: global initialized more than once" name assert_msg_str ;
  5311. global GLOBAL_INITIALIZED take_addr 1 = ;
  5312. }
  5313. }
  5314. if found ! {
  5315. ctx name loc actual_type_idx cctx_add_global ;
  5316. ctx ctx actual_type_idx cctx_type_footprint cctx_emit_zeros ;
  5317. }
  5318. } else {
  5319. if initializer type TYPE_KIND take TYPE_KIND_ARRAY == && type TYPE_LENGTH take 0xffffffff == && {
  5320. $actual_len
  5321. @actual_len ctx CCTX_ARRAY_LENS take name map_at = ;
  5322. @actual_type_idx ctx type TYPE_BASE take actual_len cctx_get_array_type = ;
  5323. @type ctx actual_type_idx cctx_get_type = ;
  5324. }
  5325. #type type_dump ;
  5326. $emit
  5327. @emit 1 = ;
  5328. if static {
  5329. $global
  5330. @global ctx name cctx_get_global = ;
  5331. if global GLOBAL_EMITTED take ! {
  5332. global GLOBAL_EMITTED take_addr 1 = ;
  5333. } else {
  5334. @emit 0 = ;
  5335. @loc global GLOBAL_LOC take = ;
  5336. }
  5337. }
  5338. if emit {
  5339. ctx name loc actual_type_idx cctx_add_global ;
  5340. ctx ctx actual_type_idx cctx_type_footprint cctx_emit_zeros ;
  5341. }
  5342. if initializer {
  5343. ctx actual_type_idx loc cctx_parse_initializer ;
  5344. }
  5345. }
  5346. }
  5347. }
  5348. arg_names vector_destroy ;
  5349. if cont {
  5350. @tok ctx cctx_get_token_or_fail = ;
  5351. if tok ";" strcmp 0 == {
  5352. @cont 0 = ;
  5353. } else {
  5354. tok "," strcmp 0 == "cctx_compile_line: comma expected" assert_msg ;
  5355. }
  5356. }
  5357. }
  5358. }
  5359. fun cctx_compile 1 {
  5360. $ctx
  5361. @ctx 0 param = ;
  5362. ctx CCTX_STAGE take_addr 0 = ;
  5363. $start_loc
  5364. @start_loc 0 = ;
  5365. $size
  5366. while ctx CCTX_STAGE take 3 < {
  5367. if ctx CCTX_VERBOSE take {
  5368. "Compilation stage " log ;
  5369. ctx CCTX_STAGE take 1 + itoa log ;
  5370. }
  5371. ctx CCTX_CURRENT_LOC take_addr start_loc = ;
  5372. ctx CCTX_TOKENS_POS take_addr 0 = ;
  5373. ctx CCTX_DOT_POS take_addr 0 = ;
  5374. ctx CCTX_LABEL_NUM take_addr 0 = ;
  5375. ctx cctx_reset_types ;
  5376. ctx cctx_clean_globals ;
  5377. ctx cctx_create_basic_types ;
  5378. ctx "__builtin_handles" ctx CCTX_HANDLES take vector_data TYPE_VOID_PTR cctx_add_global ;
  5379. while ctx cctx_is_eof ! {
  5380. ctx cctx_compile_line ;
  5381. }
  5382. if ctx CCTX_VERBOSE take {
  5383. "\n" log ;
  5384. }
  5385. if ctx CCTX_STAGE take 0 == {
  5386. @size ctx CCTX_CURRENT_LOC take start_loc - = ;
  5387. @start_loc size platform_allocate = ;
  5388. } else {
  5389. ctx CCTX_CURRENT_LOC take start_loc - size == "cctx_compile: error 1" assert_msg ;
  5390. }
  5391. ctx CCTX_STAGE take_addr ctx CCTX_STAGE take 1 + = ;
  5392. }
  5393. if ctx CCTX_VERBOSE take {
  5394. "Compiled program has size " log ;
  5395. size itoa log ;
  5396. " and starts at " log ;
  5397. start_loc itoa log ;
  5398. "\n" log ;
  5399. }
  5400. if ctx CCTX_DEBUG take {
  5401. "Compiled dump:\n" log ;
  5402. start_loc size dump_mem ;
  5403. "\n" log ;
  5404. }
  5405. }
  5406. fun parse_c 1 {
  5407. $filename
  5408. @filename 0 param = ;
  5409. # Preprocessing
  5410. $ctx
  5411. @ctx ppctx_init = ;
  5412. ctx filename ppctx_set_base_filename ;
  5413. $tokens
  5414. @tokens 4 vector_init = ;
  5415. tokens ctx filename preproc_file ;
  5416. @tokens tokens remove_whites = ;
  5417. @tokens tokens collapse_strings = ;
  5418. "Finished preprocessing\n" log ;
  5419. #tokens print_token_list ;
  5420. # Compilation
  5421. $cctx
  5422. @cctx tokens cctx_init = ;
  5423. cctx CCTX_DEBUG take_addr 0 = ;
  5424. cctx cctx_compile ;
  5425. # Debug output
  5426. # "TYPES TABLE\n" log ;
  5427. # cctx cctx_dump_types ;
  5428. # "TYPE NAMES TABLE\n" log ;
  5429. # cctx cctx_dump_typenames ;
  5430. # "GLOBALS TABLE\n" log ;
  5431. # cctx cctx_dump_globals ;
  5432. cctx cctx_print_stats ;
  5433. # Try to execute the code
  5434. "Executing compiled code...\n" log ;
  5435. $main_global
  5436. @main_global cctx "_start" cctx_get_global = ;
  5437. $main_addr
  5438. @main_addr main_global GLOBAL_LOC take = ;
  5439. $arg
  5440. @arg "_main" = ;
  5441. $res
  5442. @res @arg 1 main_addr \2 = ;
  5443. "It returned " log ;
  5444. res itoa log ;
  5445. "\n" log ;
  5446. # Cleanup
  5447. tokens free_vect_of_ptrs ;
  5448. cctx cctx_destroy ;
  5449. ctx ppctx_destroy ;
  5450. }