pas2jsfiler.pp 238 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 2018 Mattias Gaertner [email protected]
  4. Pascal to Javascript converter class.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. Abstract:
  12. Write and read a precompiled module (pcu, gzipped json).
  13. - Built-In symbols are collected in one array.
  14. - symbols of this module are stored in a tree
  15. - external references are stored in used module trees. They can refer
  16. recursively to other external references, so they are collected in a Queue.
  17. Works:
  18. - store used source files and checksums
  19. - store compiler flags
  20. - restore module as json
  21. - restore types
  22. - references to built in symbols via Id
  23. - references to module's TPasElement via Id
  24. - resolving forward references
  25. - restore resolver scopes
  26. - restore resolved references and access flags
  27. - useanalyzer: use restored proc references
  28. - write+read compiled proc body
  29. - converter: use precompiled body
  30. - store/restore/use precompiled JS of proc bodies
  31. - store/restore/use precompiled JS of proc local const
  32. - store/restore/use precompiled JS of initialization plus references
  33. - useanalyzer: generate + use initialization/finalization references
  34. - uses section
  35. - indirect used units
  36. - external references
  37. - stop after uses section and continue reading
  38. - WPO uses Proc.References
  39. - gzipped json
  40. - write final switches
  41. ToDo:
  42. - store used GUIDs
  43. - distinguish reader errors in fatal and error
  44. - when pcu is bad, unload and use src
  45. - replace GUID with crc
  46. - srcmaps for precompiled js
  47. }
  48. unit Pas2JsFiler;
  49. {$mode objfpc}{$H+}
  50. interface
  51. uses
  52. Classes, Types, SysUtils, contnrs,
  53. {$ifdef pas2js}
  54. {$else}
  55. zstream, AVL_Tree,
  56. {$endif}
  57. fpjson, jsonparser, jsonscanner,
  58. PasTree, PScanner, PParser, PasResolveEval, PasResolver,
  59. Pas2jsFileUtils, FPPas2Js;
  60. const
  61. PCUMagic = 'Pas2JSCache';
  62. PCUVersion = 3;
  63. { Version Changes:
  64. 1: initial version
  65. 2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
  66. - pcsfAncestorResolved
  67. - removed msIgnoreInterfaces
  68. 3: changed records from function to objects
  69. }
  70. BuiltInNodeName = 'BuiltIn';
  71. PCUDefaultParserOptions: TPOptions = po_Pas2js;
  72. PCUBoolStr: array[boolean] of string = (
  73. 'False',
  74. 'True'
  75. );
  76. PCUParserOptionNames: array[TPOption] of string = (
  77. 'delphi',
  78. 'KeepScannerError',
  79. 'CAssignments',
  80. 'ResolveStandardTypes',
  81. 'AsmWhole',
  82. 'NoOverloadedProcs',
  83. 'KeepClassForward',
  84. 'ArrayRangeExpr',
  85. 'SelfToken',
  86. 'CheckModeSwitches',
  87. 'CheckCondFunction',
  88. 'StopOnErrorDirective',
  89. 'ExtClassConstWithoutExpr',
  90. 'StopOnUnitInterface');
  91. PCUDefaultModeSwitches: TModeSwitches = [
  92. msObjfpc,
  93. msClass,
  94. msResult,
  95. msNestedComment,
  96. msRepeatForward,
  97. msInitFinal,
  98. msOut,
  99. msDefaultPara,
  100. msHintDirective,
  101. msProperty,
  102. msExcept,
  103. msDefaultUnicodestring,
  104. msCBlocks];
  105. PCUModeSwitchNames: array[TModeSwitch] of string = (
  106. 'None',
  107. 'Fpc',
  108. 'Objfpc',
  109. 'Delphi',
  110. 'DelphiUnicode',
  111. 'TP7',
  112. 'Mac',
  113. 'Iso',
  114. 'Extpas',
  115. 'GPC',
  116. 'Class',
  117. 'Objpas',
  118. 'Result',
  119. 'StringPchar',
  120. 'CVarSupport',
  121. 'NestedComment',
  122. 'TPProcVar',
  123. 'MacProcVar',
  124. 'RepeatForward',
  125. 'Pointer2Procedure',
  126. 'AutoDeref',
  127. 'InitFinal',
  128. 'DefaultAnsistring',
  129. 'Out',
  130. 'DefaultPara',
  131. 'HintDirective',
  132. 'DuplicateNames',
  133. 'Property',
  134. 'DefaultInline',
  135. 'Except',
  136. 'ObjectiveC1',
  137. 'ObjectiveC2',
  138. 'NestedProcVars',
  139. 'NonLocalGoto',
  140. 'AdvancedRecords',
  141. 'ISOLikeUnaryMinus',
  142. 'SystemCodePage',
  143. 'FinalFields',
  144. 'DefaultUnicodestring',
  145. 'TypeHelpers',
  146. 'CBlocks',
  147. 'ISOLikeIO',
  148. 'ISOLikeProgramsPara',
  149. 'ISOLikeMod',
  150. 'ArrayOperators',
  151. 'ExternalClass',
  152. 'PrefixedAttributes',
  153. 'IgnoreAttributes',
  154. 'OmitRTTI',
  155. 'MultipleScopeHelpers'
  156. );
  157. PCUDefaultBoolSwitches: TBoolSwitches = [
  158. bsHints,
  159. bsNotes,
  160. bsWarnings
  161. ];
  162. PCUBoolSwitchNames: array[TBoolSwitch] of string = (
  163. 'None',
  164. 'Align',
  165. 'BoolEval',
  166. 'Assertions',
  167. 'DebugInfo',
  168. 'Extension',
  169. 'ImportedData',
  170. 'LongStrings',
  171. 'IOChecks',
  172. 'WriteableConst',
  173. 'LocalSymbols',
  174. 'TypeInfo',
  175. 'Optimization',
  176. 'OpenStrings',
  177. 'OverflowChecks',
  178. 'RangeChecks',
  179. 'TypedAddress',
  180. 'SafeDivide',
  181. 'VarStringChecks',
  182. 'Stackframes',
  183. 'ExtendedSyntax',
  184. 'ReferenceInfo',
  185. 'Hints',
  186. 'Notes',
  187. 'Warnings',
  188. 'Macro',
  189. 'ScopedEnums',
  190. 'ObjectChecks',
  191. 'PointerMath',
  192. 'Goto'
  193. );
  194. PCUDefaultConverterOptions: TPasToJsConverterOptions = [coUseStrict];
  195. PCUConverterOptions: array[TPasToJsConverterOption] of string = (
  196. 'LowerCase',
  197. 'SwitchStatement',
  198. 'EnumNumbers',
  199. 'UseStrict',
  200. 'NoTypeInfo',
  201. 'EliminateDeadCode',
  202. 'StoreImplJS',
  203. 'RTLVersionCheckMain',
  204. 'RTLVersionCheckSystem',
  205. 'RTLVersionCheckUnit'
  206. );
  207. PCUDefaultTargetPlatform = PlatformBrowser;
  208. PCUTargetPlatformNames: array[TPasToJsPlatform] of string = (
  209. 'Browser',
  210. 'NodeJS'
  211. );
  212. PCUDefaultTargetProcessor = ProcessorECMAScript5;
  213. PCUTargetProcessorNames: array[TPasToJsProcessor] of string = (
  214. 'ECMAScript5',
  215. 'ECMAScript6'
  216. );
  217. PCUMemberVisibilityNames: array[TPasMemberVisibility] of string = (
  218. 'Default',
  219. 'Private',
  220. 'Protected',
  221. 'Public',
  222. 'Published',
  223. 'Automated',
  224. 'StrictPrivate',
  225. 'StrictProtected'
  226. );
  227. PCUMemberHintNames: array[TPasMemberHint] of string = (
  228. 'Deprecated',
  229. 'Library',
  230. 'Platform',
  231. 'Experimental',
  232. 'Unimplemented'
  233. );
  234. PCUDefaultModuleScopeFlags = [pmsfRangeErrorSearched];
  235. PCUModuleScopeFlagNames: array[TPasModuleScopeFlag] of string = (
  236. 'AssertSearched',
  237. 'RangeErrorNeeded',
  238. 'RangeErrorSearched'
  239. ) ;
  240. PCUDefaultIdentifierKind = pikSimple;
  241. PCUIdentifierKindNames: array[TPasIdentifierKind] of string = (
  242. 'None',
  243. 'BaseType',
  244. 'BuiltInProc',
  245. 'Simple',
  246. 'Proc',
  247. 'Namespace'
  248. );
  249. PCUVarModifierNames: array[TVariableModifier] of string = (
  250. 'CVar',
  251. 'External',
  252. 'Public',
  253. 'Export',
  254. 'Class',
  255. 'Static'
  256. );
  257. PCUDefaultExprKind = pekIdent;
  258. PCUExprKindNames: array[TPasExprKind] of string = (
  259. 'Ident',
  260. 'Number',
  261. 'String',
  262. 'Set',
  263. 'Nil',
  264. 'Bool',
  265. 'Range',
  266. 'Unary',
  267. 'Binary',
  268. 'Func',
  269. 'Array',
  270. 'List',
  271. 'Inherited',
  272. 'Self',
  273. 'Specialize',
  274. 'Procedure');
  275. PCUExprOpCodeNames: array[TExprOpCode] of string = (
  276. 'None',
  277. 'Add',
  278. 'Sub',
  279. 'Mul',
  280. 'DivF',
  281. 'DivI',
  282. 'Mod',
  283. 'Pow',
  284. 'Shr',
  285. 'Shl',
  286. 'Not',
  287. 'And',
  288. 'Or',
  289. 'Xor',
  290. 'Eq',
  291. 'NE',
  292. 'LT',
  293. 'GT',
  294. 'LTE',
  295. 'GTE',
  296. 'In',
  297. 'Is',
  298. 'As',
  299. 'SymDif',
  300. 'Addr',
  301. 'Deref',
  302. 'MemAddr',
  303. 'SubId'
  304. );
  305. PCUPackModeNames: array[TPackMode] of string = (
  306. 'None',
  307. 'Packed',
  308. 'BitPacked'
  309. );
  310. PCURESetElKindNames : array[TRESetElKind] of string = (
  311. 'None',
  312. 'Enum',
  313. 'Int',
  314. 'Char',
  315. 'Bool'
  316. );
  317. PCUObjKindNames: array[TPasObjKind] of string = (
  318. 'Object',
  319. 'Class',
  320. 'Interface',
  321. 'ClassHelper',
  322. 'RecordHelper',
  323. 'TypeHelper',
  324. 'DispInterface'
  325. );
  326. PCUClassInterfaceTypeNames: array[TPasClassInterfaceType] of string = (
  327. 'COM',
  328. 'CORBA'
  329. );
  330. PCUClassScopeFlagNames: array[TPasClassScopeFlag] of string = (
  331. 'AncestorResolved',
  332. 'Sealed',
  333. 'Published'
  334. );
  335. PCUArgumentAccessNames: array[TArgumentAccess] of string = (
  336. 'Default',
  337. 'Const',
  338. 'Var',
  339. 'Out',
  340. 'ConstRef'
  341. );
  342. PCUCallingConventionNames: array[TCallingConvention] of string = (
  343. 'Default',
  344. 'Register',
  345. 'Pascal',
  346. 'CDecl',
  347. 'StdCall',
  348. 'OldFPCCall',
  349. 'SafeCall',
  350. 'SysCall'
  351. );
  352. PCUProcTypeModifierNames: array[TProcTypeModifier] of string = (
  353. 'OfObject',
  354. 'IsNested',
  355. 'Static',
  356. 'Varargs',
  357. 'ReferenceTo'
  358. );
  359. PCUProcedureMessageTypeNames: array[TProcedureMessageType] of string = (
  360. 'None',
  361. 'Integer',
  362. 'String'
  363. );
  364. PCUOperatorTypeNames: array[TOperatorType] of string = (
  365. 'Unknown',
  366. 'Implicit',
  367. 'Explicit',
  368. 'Mul',
  369. 'Plus',
  370. 'Minus',
  371. 'Division',
  372. 'LessThan',
  373. 'Equal',
  374. 'GreaterThan',
  375. 'Assign',
  376. 'NotEqual',
  377. 'LessEqualThan',
  378. 'GreaterEqualThan',
  379. 'Power',
  380. 'SymmetricalDifference',
  381. 'Inc',
  382. 'Dec',
  383. 'Mod',
  384. 'Negative',
  385. 'Positive',
  386. 'BitWiseOr',
  387. 'Div',
  388. 'LeftShift',
  389. 'LogicalOr',
  390. 'BitwiseAnd',
  391. 'bitwiseXor',
  392. 'LogicalAnd',
  393. 'LogicalNot',
  394. 'LogicalXor',
  395. 'RightShift',
  396. 'Enumerator',
  397. 'In'
  398. );
  399. PCUProcedureModifierNames: array[TProcedureModifier] of string = (
  400. 'Virtual',
  401. 'Dynamic',
  402. 'Abstract',
  403. 'Override',
  404. 'Export',
  405. 'Overload',
  406. 'Message',
  407. 'Reintroduce',
  408. 'Inline',
  409. 'Assembler',
  410. 'Public',
  411. 'CompilerProc',
  412. 'External',
  413. 'Forward',
  414. 'DispId',
  415. 'NoReturn',
  416. 'Far',
  417. 'Final'
  418. );
  419. PCUProcedureScopeFlagNames: array[TPasProcedureScopeFlag] of string = (
  420. 'GrpOverload'
  421. );
  422. PCUDefaultPSRefAccess = psraRead;
  423. PCUPSRefAccessNames: array[TPSRefAccess] of string = (
  424. 'None',
  425. 'Read',
  426. 'Write',
  427. 'ReadWrite',
  428. 'WriteRead',
  429. 'TypeInfo'
  430. );
  431. PCUResolvedRefAccessNames: array[TResolvedRefAccess] of string = (
  432. 'None',
  433. 'Read',
  434. 'Assign',
  435. 'ReadAndAssign',
  436. 'VarParam',
  437. 'OutParam',
  438. 'ParamToUnknownProc'
  439. );
  440. PCUResolvedReferenceFlagNames: array[TResolvedReferenceFlag] of string = (
  441. 'Dot',
  442. 'ImplicitCall',
  443. 'NoImplicitCall',
  444. 'NewInst',
  445. 'FreeInst',
  446. 'VMT',
  447. 'ConstInh'
  448. );
  449. type
  450. { TPCUInitialFlags }
  451. TPCUInitialFlags = class
  452. public
  453. ParserOptions: TPOptions;
  454. ModeSwitches: TModeSwitches;
  455. BoolSwitches: TBoolSwitches;
  456. ConverterOptions: TPasToJsConverterOptions;
  457. TargetPlatform: TPasToJsPlatform;
  458. TargetProcessor: TPasToJsProcessor;
  459. // ToDo: defines
  460. constructor Create;
  461. procedure Clear;
  462. end;
  463. type
  464. TPCUSourceFileType = (
  465. sftUnit,
  466. sftInclude
  467. );
  468. TPCUSourceFileKinds = set of TPCUSourceFileType;
  469. const
  470. PCUSourceFileTypeNames: array[TPCUSourceFileType] of string = (
  471. 'Unit',
  472. 'Include'
  473. );
  474. type
  475. TPCUSourceFileChecksum = cardinal;
  476. EPas2JsFilerError = class(Exception)
  477. public
  478. Owner: TObject;
  479. end;
  480. EPas2JsWriteError = class(EPas2JsFilerError);
  481. EPas2JsReadError = class(EPas2JsFilerError);
  482. { TPCUSourceFile }
  483. TPCUSourceFile = class
  484. public
  485. FileType: TPCUSourceFileType;
  486. Filename: string;
  487. Checksum: TPCUSourceFileChecksum;
  488. Index: integer;
  489. end;
  490. TPCUSourceFileArray = array of TPCUSourceFile;
  491. TPCUGetSrcEvent = procedure(Sender: TObject; aFilename: string;
  492. out p: PChar; out Count: integer) of object;
  493. { TPCUFilerContext - base class TPCUWriterContext/TPCUReaderContext }
  494. TPCUFilerContext = class
  495. public
  496. ModeSwitches: TModeSwitches;
  497. BoolSwitches: TBoolSwitches;
  498. end;
  499. { TPCUFilerPendingElRef }
  500. TPCUFilerPendingElRef = class
  501. public
  502. Next: TPCUFilerPendingElRef;
  503. ErrorEl: TPasElement;
  504. end;
  505. { TPCUFilerElementRef }
  506. TPCUFilerElementRef = class
  507. public
  508. ParentRef: TPCUFilerElementRef;
  509. Element: TPasElement;
  510. Id: integer; // 0 = pending
  511. Pending: TPCUFilerPendingElRef;
  512. Obj: TJSONObject;
  513. Elements: TJSONArray; // for external references
  514. NextNewExt: TPCUFilerElementRef; // next new external reference
  515. procedure AddPending(Item: TPCUFilerPendingElRef);
  516. procedure Clear;
  517. destructor Destroy; override;
  518. end;
  519. TPCUFilerElementRefArray = array of TPCUFilerElementRef;
  520. { TPCUFiler - base class TPCUWriter/TPCUReader}
  521. TPCUFiler = class
  522. private
  523. FFileVersion: longint;
  524. FGUID: TGUID;
  525. FInitialFlags: TPCUInitialFlags;
  526. FOnGetSrc: TPCUGetSrcEvent;
  527. FParser: TPasParser;
  528. FResolver: TPas2JSResolver;
  529. FScanner: TPascalScanner;
  530. FSourceFiles: TObjectList;
  531. function GetSourceFiles(Index: integer): TPCUSourceFile;
  532. protected
  533. FElementRefs: TAVLTree; // tree of TPCUFilerElementRef sorted for Element
  534. procedure RaiseMsg(Id: int64; const Msg: string = ''); virtual; abstract; overload;
  535. procedure RaiseMsg(Id: int64; El: TPasElement; const Msg: string = ''); overload;
  536. function GetDefaultMemberVisibility(El: TPasElement): TPasMemberVisibility; virtual;
  537. function GetDefaultPasScopeVisibilityContext(Scope: TPasScope): TPasElement; virtual;
  538. procedure GetDefaultsPasIdentifierProps(El: TPasElement; out Kind: TPasIdentifierKind; out Name: string); virtual;
  539. function GetDefaultClassScopeFlags(Scope: TPas2JSClassScope): TPasClassScopeFlags; virtual;
  540. function GetDefaultProcModifiers(Proc: TPasProcedure): TProcedureModifiers; virtual;
  541. function GetDefaultProcTypeModifiers(ProcType: TPasProcedureType): TProcTypeModifiers; virtual;
  542. function GetDefaultExprHasEvalValue(Expr: TPasExpr): boolean; virtual;
  543. function GetSrcCheckSum(aFilename: string): TPCUSourceFileChecksum; virtual;
  544. function GetDefaultRefName(El: TPasElement): string; virtual;
  545. function GetElementReference(El: TPasElement; AutoCreate: boolean = true): TPCUFilerElementRef;
  546. function CreateElementRef(El: TPasElement): TPCUFilerElementRef; virtual;
  547. procedure AddedBuiltInRef(Ref: TPCUFilerElementRef); virtual;
  548. public
  549. constructor Create; virtual;
  550. destructor Destroy; override;
  551. procedure Clear; virtual;
  552. property Resolver: TPas2JSResolver read FResolver;
  553. property Parser: TPasParser read FParser;
  554. property Scanner: TPascalScanner read FScanner;
  555. property InitialFlags: TPCUInitialFlags read FInitialFlags;
  556. property OnGetSrc: TPCUGetSrcEvent read FOnGetSrc write FOnGetSrc;
  557. function SourceFileCount: integer;
  558. property SourceFiles[Index: integer]: TPCUSourceFile read GetSourceFiles;
  559. property ElementRefs: TAVLTree read FElementRefs;
  560. property GUID: TGUID read FGUID write FGUID;
  561. end;
  562. { TPCUCustomWriter }
  563. TPCUCustomWriter = class(TPCUFiler)
  564. private
  565. FOnIsElementUsed: TPas2JSIsElementUsedEvent;
  566. public
  567. procedure WritePCU(aResolver: TPas2JSResolver; aConverter: TPasToJSConverter;
  568. InitFlags: TPCUInitialFlags; aStream: TStream; Compressed: boolean); virtual; abstract;
  569. property OnIsElementUsed: TPas2JSIsElementUsedEvent read FOnIsElementUsed write FOnIsElementUsed;
  570. end;
  571. TPCUWriterClass = class of TPCUWriter;
  572. { TPCUCustomReader }
  573. TPCUCustomReader = class(TPCUFiler)
  574. private
  575. FSourceFilename: string;
  576. public
  577. procedure ReadPCU(aResolver: TPas2JSResolver; aStream: TStream); virtual; abstract;
  578. function ReadContinue: boolean; virtual; abstract; // true=finished
  579. function ReadCanContinue: boolean; virtual; // true=not finished and no pending used interface
  580. property SourceFilename: string read FSourceFilename write FSourceFilename; // default value for TPasElement.SourceFilename
  581. end;
  582. TPCUReaderClass = class of TPCUCustomReader;
  583. { TPCUWriterContext }
  584. TPCUWriterContext = class(TPCUFilerContext)
  585. public
  586. Section: TPasSection;
  587. SectionObj: TJSONObject;
  588. IndirectUsesArr: TJSONArray;
  589. end;
  590. { TPCUWriterPendingElRefObj }
  591. TPCUWriterPendingElRefObj = class(TPCUFilerPendingElRef)
  592. public
  593. Obj: TJSONObject;
  594. PropName: string;
  595. end;
  596. { TPCUWriterPendingElRefArray }
  597. TPCUWriterPendingElRefArray = class(TPCUFilerPendingElRef)
  598. public
  599. Arr: TJSONArray;
  600. Index: integer;
  601. end;
  602. { TPCUWriter }
  603. TPCUWriter = class(TPCUCustomWriter)
  604. private
  605. FConverter: TPasToJSConverter;
  606. FElementIdCounter: integer;
  607. FJSON: TJSONObject;
  608. FSourceFilesSorted: TPCUSourceFileArray;
  609. FInImplementation: boolean;
  610. FBuiltInSymbolsArr: TJSONArray;
  611. protected
  612. FFirstNewExt, FLastNewExt: TPCUFilerElementRef; // not yet stored external references
  613. procedure RaiseMsg(Id: int64; const Msg: string = ''); override; overload;
  614. procedure ResolvePendingElRefs(Ref: TPCUFilerElementRef);
  615. function CheckElScope(El: TPasElement; NotNilId: int64; ScopeClass: TPasScopeClass): TPasScope; virtual;
  616. procedure AddArrayFlag(Obj: TJSONObject; var Arr: TJSONArray;
  617. const ArrName, Flag: string; Enable: boolean);
  618. procedure AddReferenceToArray(Arr: TJSONArray; El: TPasElement; WriteNull: boolean = true); virtual;
  619. procedure AddReferenceToObj(Obj: TJSONObject; const PropName: string;
  620. El: TPasElement; WriteNil: boolean = false); virtual;
  621. procedure CreateElReferenceId(Ref: TPCUFilerElementRef); virtual;
  622. function CreateElementRef(El: TPasElement): TPCUFilerElementRef; override;
  623. procedure AddedBuiltInRef(Ref: TPCUFilerElementRef); override;
  624. protected
  625. procedure WriteHeaderMagic(Obj: TJSONObject); virtual;
  626. procedure WriteHeaderVersion(Obj: TJSONObject); virtual;
  627. procedure WriteGUID(Obj: TJSONObject); virtual;
  628. procedure WriteInitialFlags(Obj: TJSONObject); virtual;
  629. procedure WriteFinalFlags(Obj: TJSONObject); virtual;
  630. procedure WriteParserOptions(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPOptions); virtual;
  631. procedure WriteModeSwitches(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TModeSwitches); virtual;
  632. procedure WriteBoolSwitches(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TBoolSwitches); virtual;
  633. procedure WriteConverterOptions(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasToJsConverterOptions); virtual;
  634. procedure WriteSrcFiles(Obj: TJSONObject); virtual;
  635. procedure WriteMemberHints(Obj: TJSONObject; const Value, DefaultValue: TPasMemberHints); virtual;
  636. procedure WritePasScope(Obj: TJSONObject; Scope: TPasScope; aContext: TPCUWriterContext); virtual;
  637. procedure WriteIdentifierScope(Obj: TJSONObject; Scope: TPasIdentifierScope; aContext: TPCUWriterContext); virtual;
  638. procedure WriteModuleScopeFlags(Obj: TJSONObject; const Value, DefaultValue: TPasModuleScopeFlags); virtual;
  639. procedure WriteModuleScope(Obj: TJSONObject; Scope: TPas2JSModuleScope; aContext: TPCUWriterContext); virtual;
  640. procedure WriteSrcPos(Obj: TJSONObject; El: TPasElement; aContext: TPCUWriterContext); virtual;
  641. procedure WritePasElement(Obj: TJSONObject; El: TPasElement; aContext: TPCUWriterContext); virtual;
  642. procedure WriteModule(Obj: TJSONObject; aModule: TPasModule; aContext: TPCUWriterContext); virtual;
  643. procedure WriteSection(ParentJSON: TJSONObject; Section: TPasSection;
  644. const PropName: string; aContext: TPCUWriterContext); virtual;
  645. procedure WriteDeclarations(ParentJSON: TJSONObject; Decls: TPasDeclarations; aContext: TPCUWriterContext); virtual;
  646. procedure WriteElementProperty(Obj: TJSONObject; Parent: TPasElement;
  647. const PropName: string; El: TPasElement; aContext: TPCUWriterContext); virtual;
  648. procedure WriteElementList(Obj: TJSONObject; Parent: TPasElement;
  649. const PropName: string; ListOfElements: TFPList; aContext: TPCUWriterContext;
  650. ReferencesAllowed: boolean = false); virtual;
  651. procedure WriteElement(Obj: TJSONObject; El: TPasElement; aContext: TPCUWriterContext); virtual;
  652. procedure WriteElType(Obj: TJSONObject; El: TPasElement; const PropName: string; aType: TPasType; aContext: TPCUWriterContext); virtual;
  653. procedure WriteVarModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TVariableModifiers); virtual;
  654. procedure WriteResolvedRefFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TResolvedReferenceFlags); virtual;
  655. procedure WriteResolvedReference(Obj: TJSONObject; Ref: TResolvedReference; ErrorEl: TPasElement); virtual;
  656. procedure WriteExprCustomData(Obj: TJSONObject; Expr: TPasExpr; aContext: TPCUWriterContext); virtual;
  657. procedure WriteExpr(Obj: TJSONObject; Parent: TPasElement;
  658. const PropName: string; Expr: TPasExpr; aContext: TPCUWriterContext); virtual;
  659. procedure WritePasExpr(Obj: TJSONObject; Expr: TPasExpr;
  660. DefaultKind: TPasExprKind; DefaultOpCode: TExprOpCode; aContext: TPCUWriterContext); virtual;
  661. procedure WritePasExprArray(Obj: TJSONObject; Parent: TPasElement;
  662. const PropName: string; const ExprArr: TPasExprArray; aContext: TPCUWriterContext); virtual;
  663. procedure WriteScopeReferences(Obj: TJSONObject; References: TPasScopeReferences;
  664. const PropName: string; aContext: TPCUWriterContext); virtual;
  665. procedure WriteUnaryExpr(Obj: TJSONObject; Expr: TUnaryExpr; aContext: TPCUWriterContext); virtual;
  666. procedure WriteBinaryExpr(Obj: TJSONObject; Expr: TBinaryExpr; aContext: TPCUWriterContext); virtual;
  667. procedure WritePrimitiveExpr(Obj: TJSONObject; Expr: TPrimitiveExpr; aContext: TPCUWriterContext); virtual;
  668. procedure WriteBoolConstExpr(Obj: TJSONObject; Expr: TBoolConstExpr; aContext: TPCUWriterContext); virtual;
  669. procedure WriteParamsExpr(Obj: TJSONObject; Expr: TParamsExpr; aContext: TPCUWriterContext); virtual;
  670. procedure WriteRecordValues(Obj: TJSONObject; Expr: TRecordValues; aContext: TPCUWriterContext); virtual;
  671. procedure WriteArrayValues(Obj: TJSONObject; Expr: TArrayValues; aContext: TPCUWriterContext); virtual;
  672. procedure WriteResString(Obj: TJSONObject; El: TPasResString; aContext: TPCUWriterContext); virtual;
  673. procedure WriteAliasType(Obj: TJSONObject; El: TPasAliasType; aContext: TPCUWriterContext); virtual;
  674. procedure WritePointerType(Obj: TJSONObject; El: TPasPointerType; aContext: TPCUWriterContext); virtual;
  675. procedure WriteSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUWriterContext); virtual;
  676. procedure WriteInlineTypeExpr(Obj: TJSONObject; Expr: TInlineTypeExpr; aContext: TPCUWriterContext); virtual;
  677. procedure WriteInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext); virtual;
  678. procedure WriteRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUWriterContext); virtual;
  679. procedure WriteArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUWriterContext); virtual;
  680. procedure WriteFileType(Obj: TJSONObject; El: TPasFileType; aContext: TPCUWriterContext); virtual;
  681. procedure WriteEnumValue(Obj: TJSONObject; El: TPasEnumValue; aContext: TPCUWriterContext); virtual;
  682. procedure WriteEnumTypeScope(Obj: TJSONObject; Scope: TPasEnumTypeScope; aContext: TPCUWriterContext); virtual;
  683. procedure WriteEnumType(Obj: TJSONObject; El: TPasEnumType; aContext: TPCUWriterContext); virtual;
  684. procedure WriteSetType(Obj: TJSONObject; El: TPasSetType; aContext: TPCUWriterContext); virtual;
  685. procedure WriteRecordVariant(Obj: TJSONObject; El: TPasVariant; aContext: TPCUWriterContext); virtual;
  686. procedure WriteRecordTypeScope(Obj: TJSONObject; Scope: TPasRecordScope; aContext: TPCUWriterContext); virtual;
  687. procedure WriteRecordType(Obj: TJSONObject; El: TPasRecordType; aContext: TPCUWriterContext); virtual;
  688. procedure WriteClassScopeFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasClassScopeFlags); virtual;
  689. procedure WriteClassIntfMapProcs(Obj: TJSONObject; Map: TPasClassIntfMap); virtual;
  690. procedure WriteClassScope(Obj: TJSONObject; Scope: TPas2JSClassScope; aContext: TPCUWriterContext); virtual;
  691. procedure WriteClassType(Obj: TJSONObject; El: TPasClassType; aContext: TPCUWriterContext); virtual;
  692. procedure WriteArgument(Obj: TJSONObject; El: TPasArgument; aContext: TPCUWriterContext); virtual;
  693. procedure WriteProcTypeModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TProcTypeModifiers); virtual;
  694. procedure WriteProcedureType(Obj: TJSONObject; El: TPasProcedureType; aContext: TPCUWriterContext); virtual;
  695. procedure WriteResultElement(Obj: TJSONObject; El: TPasResultElement; aContext: TPCUWriterContext); virtual;
  696. procedure WriteFunctionType(Obj: TJSONObject; El: TPasFunctionType; aContext: TPCUWriterContext); virtual;
  697. procedure WriteStringType(Obj: TJSONObject; El: TPasStringType; aContext: TPCUWriterContext); virtual;
  698. procedure WriteVariable(Obj: TJSONObject; El: TPasVariable; aContext: TPCUWriterContext); virtual;
  699. procedure WriteExportSymbol(Obj: TJSONObject; El: TPasExportSymbol; aContext: TPCUWriterContext); virtual;
  700. procedure WriteConst(Obj: TJSONObject; El: TPasConst; aContext: TPCUWriterContext); virtual;
  701. procedure WritePropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUWriterContext); virtual;
  702. procedure WriteProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUWriterContext); virtual;
  703. procedure WriteMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUWriterContext); virtual;
  704. procedure WriteProcedureModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TProcedureModifiers); virtual;
  705. procedure WriteProcScopeFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasProcedureScopeFlags); virtual;
  706. procedure WriteProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPCUWriterContext); virtual;
  707. procedure WriteProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
  708. procedure WriteOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUWriterContext); virtual;
  709. procedure WriteExtRefSignature(Ref: TPCUFilerElementRef; aContext: TPCUWriterContext); virtual;
  710. function WriteExternalReference(El: TPasElement; aContext: TPCUWriterContext): TPCUFilerElementRef; virtual;
  711. procedure WriteExternalReferences(aContext: TPCUWriterContext); virtual;
  712. public
  713. constructor Create; override;
  714. destructor Destroy; override;
  715. procedure Clear; override;
  716. procedure WritePCU(aResolver: TPas2JSResolver; aConverter: TPasToJSConverter;
  717. InitFlags: TPCUInitialFlags; aStream: TStream; Compressed: boolean); override;
  718. function WriteJSON(aResolver: TPas2JSResolver; aConverter: TPasToJSConverter;
  719. InitFlags: TPCUInitialFlags): TJSONObject; virtual;
  720. function IndexOfSourceFile(const Filename: string): integer;
  721. property SourceFilesSorted: TPCUSourceFileArray read FSourceFilesSorted;
  722. property JSON: TJSONObject read FJSON;
  723. property Converter: TPasToJSConverter read FConverter;
  724. end;
  725. { TPCUReaderContext }
  726. TPCUReaderContext = class(TPCUFilerContext)
  727. end;
  728. TOnSetElReference = procedure(El: TPasElement; Data: TObject) of object;
  729. { TPCUReaderPendingElRef }
  730. TPCUReaderPendingElRef = class(TPCUFilerPendingElRef)
  731. public
  732. Data: TObject;
  733. Setter: TOnSetElReference;
  734. end;
  735. TPCUAddRef = {$IFDEF CheckPasTreeRefCount}String{$ELSE}boolean{$ENDIF};
  736. { TPCUReaderPendingElListRef }
  737. TPCUReaderPendingElListRef = class(TPCUFilerPendingElRef)
  738. public
  739. List: TFPList;
  740. Index: integer;
  741. AddRef: TPCUAddRef;
  742. end;
  743. { TPCUReaderPendingIdentifierScope }
  744. TPCUReaderPendingIdentifierScope = class
  745. public
  746. Scope: TPasIdentifierScope;
  747. Arr: TJSONArray;
  748. end;
  749. { TPCUReader }
  750. TPCUReader = class(TPCUCustomReader)
  751. private
  752. FElementRefsArray: TPCUFilerElementRefArray; // TPCUFilerElementRef by Id
  753. FJSON: TJSONObject;
  754. FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope
  755. procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
  756. procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
  757. procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
  758. procedure Set_InlineTypeExpr_DestType(RefEl: TPasElement; Data: TObject);
  759. procedure Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
  760. procedure Set_FileType_ElType(RefEl: TPasElement; Data: TObject);
  761. procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
  762. procedure Set_Variant_Members(RefEl: TPasElement; Data: TObject);
  763. procedure Set_RecordType_VariantEl(RefEl: TPasElement; Data: TObject);
  764. procedure Set_RecordScope_DefaultProperty(RefEl: TPasElement; Data: TObject);
  765. procedure Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
  766. procedure Set_ClassScope_NewInstanceFunction(RefEl: TPasElement; Data: TObject);
  767. procedure Set_ClassScope_DirectAncestor(RefEl: TPasElement; Data: TObject);
  768. procedure Set_ClassScope_DefaultProperty(RefEl: TPasElement; Data: TObject);
  769. procedure Set_ClassIntfMap_Intf(RefEl: TPasElement; Data: TObject);
  770. procedure Set_ClassType_AncestorType(RefEl: TPasElement; Data: TObject);
  771. procedure Set_ClassType_HelperForType(RefEl: TPasElement; Data: TObject);
  772. procedure Set_ResultElement_ResultType(RefEl: TPasElement; Data: TObject);
  773. procedure Set_PasScope_VisibilityContext(RefEl: TPasElement; Data: TObject);
  774. procedure Set_ModScope_AssertClass(RefEl: TPasElement; Data: TObject);
  775. procedure Set_ModScope_AssertDefConstructor(RefEl: TPasElement; Data: TObject);
  776. procedure Set_ModScope_AssertMsgConstructor(RefEl: TPasElement; Data: TObject);
  777. procedure Set_ModScope_RangeErrorClass(RefEl: TPasElement; Data: TObject);
  778. procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
  779. procedure Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement; Data: TObject);
  780. procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
  781. procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
  782. procedure Set_ProcedureScope_Overridden(RefEl: TPasElement; Data: TObject);
  783. procedure Set_ResolvedReference_Declaration(RefEl: TPasElement; Data: TObject);
  784. protected
  785. procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
  786. function CheckJSONArray(Data: TJSONData; El: TPasElement; const PropName: string): TJSONArray;
  787. function CheckJSONObject(Data: TJSONData; Id: int64): TJSONObject;
  788. function CheckJSONString(Data: TJSONData; Id: int64): String;
  789. function ReadString(Obj: TJSONObject; const PropName: string; out s: string; El: TPasElement): boolean;
  790. function ReadInteger(Obj: TJSONObject; const PropName: string; out i: integer; El: TPasElement): boolean;
  791. function ReadBoolean(Obj: TJSONObject; const PropName: string; out b: boolean; El: TPasElement): boolean;
  792. function ReadArray(Obj: TJSONObject; const PropName: string; out Arr: TJSONArray; El: TPasElement): boolean;
  793. function ReadObject(Obj: TJSONObject; const PropName: string; out SubObj: TJSONObject; El: TPasElement): boolean;
  794. function CreateContext: TPCUReaderContext; virtual;
  795. function GetElReference(Id: integer; ErrorEl: TPasElement): TPCUFilerElementRef; virtual;
  796. function AddElReference(Id: integer; ErrorEl: TPasElement; El: TPasElement): TPCUFilerElementRef; virtual;
  797. procedure PromiseSetElReference(Id: integer; const Setter: TOnSetElReference;
  798. Data: TObject; ErrorEl: TPasElement); virtual;
  799. procedure PromiseSetElListReference(Id: integer; List: TFPList; Index: integer;
  800. AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
  801. procedure ReadHeaderMagic(Obj: TJSONObject); virtual;
  802. procedure ReadHeaderVersion(Obj: TJSONObject); virtual;
  803. procedure ReadGUID(Obj: TJSONObject); virtual;
  804. procedure ReadHeaderItem(const PropName: string; Data: TJSONData); virtual;
  805. procedure ReadArrayFlags(Data: TJSONData; El: TPasElement; const PropName: string; out Names: TStringDynArray; out Enable: TBooleanDynArray);
  806. function ReadParserOptions(Obj: TJSONObject; El: TPasElement; const PropName: string; const DefaultValue: TPOptions): TPOptions; virtual;
  807. function ReadModeSwitches(Obj: TJSONObject; El: TPasElement; const PropName: string; const DefaultValue: TModeSwitches): TModeSwitches; virtual;
  808. function ReadBoolSwitches(Obj: TJSONObject; El: TPasElement; const PropName: string; const DefaultValue: TBoolSwitches): TBoolSwitches; virtual;
  809. function ReadConverterOptions(Obj: TJSONObject; El: TPasElement; const PropName: string; const DefaultValue: TPasToJsConverterOptions): TPasToJsConverterOptions; virtual;
  810. procedure ReadTargetPlatform(Data: TJSONData); virtual;
  811. procedure ReadTargetProcessor(Data: TJSONData); virtual;
  812. procedure ReadSrcFiles(Data: TJSONData); virtual;
  813. function ReadMemberHints(Obj: TJSONObject; El: TPasElement; const DefaultValue: TPasMemberHints): TPasMemberHints; virtual;
  814. procedure ReadSrcPos(Obj: TJSONObject; El: TPasElement; aContext: TPCUReaderContext); virtual;
  815. procedure ReadPasElement(Obj: TJSONObject; El: TPasElement; aContext: TPCUReaderContext); virtual;
  816. procedure ReadExternalMembers(El: TPasElement; Arr: TJSONArray; Members: TFPList); virtual;
  817. procedure ReadExternalReferences(Obj: TJSONObject; El: TPasElement); virtual;
  818. procedure ReadUsedUnitsInit(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
  819. procedure ReadUsedUnitsFinish(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
  820. procedure ReadSectionScope(Obj: TJSONObject; Scope: TPas2JSSectionScope; aContext: TPCUReaderContext); virtual;
  821. procedure ReadSection(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
  822. procedure ReadDeclarations(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
  823. function CreateElement(AClass: TPTreeElement; const AName: String;
  824. AParent: TPasElement): TPasElement; virtual;
  825. function ReadElement(Obj: TJSONObject; Parent: TPasElement; aContext: TPCUReaderContext): TPasElement; virtual;
  826. function ReadElementProperty(Obj: TJSONObject; Parent: TPasElement;
  827. const PropName: string; BaseClass: TPTreeElement; aContext: TPCUReaderContext): TPasElement; virtual;
  828. procedure ReadElementReference(Obj: TJSONObject; Instance: TPasElementBase;
  829. const PropName: string; const Setter: TOnSetElReference); virtual;
  830. procedure ReadElementList(Obj: TJSONObject; Parent: TPasElement;
  831. const PropName: string; ListOfElements: TFPList; AddRef: TPCUAddRef;
  832. aContext: TPCUReaderContext); virtual;
  833. procedure ReadElType(Obj: TJSONObject; const PropName: string; El: TPasElement;
  834. const Setter: TOnSetElReference; aContext: TPCUReaderContext); virtual;
  835. function ReadResolvedRefFlags(Obj: TJSONObject; El: TPasElement;
  836. const PropName: string; const DefaultValue: TResolvedReferenceFlags): TResolvedReferenceFlags; virtual;
  837. procedure ReadResolvedReference(Obj: TJSONObject; Ref: TResolvedReference; ErrorEl: TPasElement); virtual;
  838. procedure ReadPasExpr(Obj: TJSONObject; Expr: TPasExpr; DefKind: TPasExprKind; aContext: TPCUReaderContext); virtual;
  839. procedure ReadExprCustomData(Obj: TJSONObject; Expr: TPasExpr; aContext: TPCUReaderContext); virtual;
  840. function ReadExpr(Obj: TJSONObject; Parent: TPasElement; const PropName: string;
  841. aContext: TPCUReaderContext): TPasExpr; virtual;
  842. procedure ReadPasExprArray(Obj: TJSONObject; Parent: TPasElement;
  843. const PropName: string; var ExprArr: TPasExprArray; aContext: TPCUReaderContext); virtual;
  844. procedure ReadPasScope(Obj: TJSONObject; Scope: TPasScope; aContext: TPCUReaderContext); virtual;
  845. procedure ReadScopeReferences(Obj: TJSONObject; Scope: TPasScope;
  846. const PropName: string; var References: TPasScopeReferences); virtual;
  847. procedure ReadIdentifierScopeArray(Arr: TJSONArray; Scope: TPasIdentifierScope); virtual;
  848. procedure ReadIdentifierScope(Obj: TJSONObject; Scope: TPasIdentifierScope; aContext: TPCUReaderContext); virtual;
  849. function ReadModuleScopeFlags(Obj: TJSONObject; El: TPasElement; const DefaultValue: TPasModuleScopeFlags): TPasModuleScopeFlags; virtual;
  850. procedure ReadModuleScope(Obj: TJSONObject; Scope: TPas2JSModuleScope; aContext: TPCUReaderContext); virtual;
  851. procedure ReadModuleHeader(Data: TJSONData); virtual;
  852. function ReadModule(Obj: TJSONObject; aContext: TPCUReaderContext): boolean; virtual;
  853. procedure ReadUnaryExpr(Obj: TJSONObject; Expr: TUnaryExpr; aContext: TPCUReaderContext); virtual;
  854. procedure ReadBinaryExpr(Obj: TJSONObject; Expr: TBinaryExpr; aContext: TPCUReaderContext); virtual;
  855. procedure ReadBoolConstExpr(Obj: TJSONObject; Expr: TBoolConstExpr; aContext: TPCUReaderContext); virtual;
  856. procedure ReadParamsExpr(Obj: TJSONObject; Expr: TParamsExpr; aContext: TPCUReaderContext); virtual;
  857. procedure ReadRecordValues(Obj: TJSONObject; Expr: TRecordValues; aContext: TPCUReaderContext); virtual;
  858. procedure ReadArrayValues(Obj: TJSONObject; Expr: TArrayValues; aContext: TPCUReaderContext); virtual;
  859. procedure ReadResString(Obj: TJSONObject; El: TPasResString; aContext: TPCUReaderContext); virtual;
  860. procedure ReadAliasType(Obj: TJSONObject; El: TPasAliasType; aContext: TPCUReaderContext); virtual;
  861. procedure ReadPointerType(Obj: TJSONObject; El: TPasPointerType; aContext: TPCUReaderContext); virtual;
  862. procedure ReadSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUReaderContext); virtual;
  863. procedure ReadInlineTypeExpr(Obj: TJSONObject; Expr: TInlineTypeExpr; aContext: TPCUReaderContext); virtual;
  864. procedure ReadInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext); virtual;
  865. procedure ReadRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUReaderContext); virtual;
  866. procedure ReadArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUReaderContext); virtual;
  867. procedure ReadFileType(Obj: TJSONObject; El: TPasFileType; aContext: TPCUReaderContext); virtual;
  868. procedure ReadEnumValue(Obj: TJSONObject; El: TPasEnumValue; aContext: TPCUReaderContext); virtual;
  869. procedure ReadEnumTypeScope(Obj: TJSONObject; Scope: TPasEnumTypeScope; aContext: TPCUReaderContext); virtual;
  870. procedure ReadEnumType(Obj: TJSONObject; El: TPasEnumType; aContext: TPCUReaderContext); virtual;
  871. procedure ReadSetType(Obj: TJSONObject; El: TPasSetType; aContext: TPCUReaderContext); virtual;
  872. function ReadPackedMode(Obj: TJSONObject; const PropName: string; ErrorEl: TPasElement): TPackMode; virtual;
  873. procedure ReadRecordVariant(Obj: TJSONObject; El: TPasVariant; aContext: TPCUReaderContext); virtual;
  874. procedure ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope; aContext: TPCUReaderContext); virtual;
  875. procedure ReadRecordType(Obj: TJSONObject; El: TPasRecordType; aContext: TPCUReaderContext); virtual;
  876. function ReadClassInterfaceType(Obj: TJSONObject; const PropName: string; ErrorEl: TPasElement; DefaultValue: TPasClassInterfaceType): TPasClassInterfaceType;
  877. function ReadClassScopeFlags(Obj: TJSONObject; El: TPasElement;
  878. const PropName: string; const DefaultValue: TPasClassScopeFlags): TPasClassScopeFlags; virtual;
  879. procedure ReadClassScopeAbstractProcs(Obj: TJSONObject; Scope: TPas2JSClassScope); virtual;
  880. procedure ReadClassIntfMapProcs(Obj: TJSONObject; Map: TPasClassIntfMap; OrigIntfType: TPasType); virtual;
  881. procedure ReadClassIntfMap(Obj: TJSONObject; Scope: TPas2JSClassScope; Map: TPasClassIntfMap; OrigIntfType: TPasType); virtual;
  882. procedure ReadClassScopeInterfaces(Obj: TJSONObject; Scope: TPas2JSClassScope); virtual;
  883. procedure ReadClassScope(Obj: TJSONObject; Scope: TPas2JSClassScope; aContext: TPCUReaderContext); virtual;
  884. procedure ReadClassType(Obj: TJSONObject; El: TPasClassType; aContext: TPCUReaderContext); virtual;
  885. procedure ReadArgument(Obj: TJSONObject; El: TPasArgument; aContext: TPCUReaderContext); virtual;
  886. function ReadProcTypeModifiers(Obj: TJSONObject; El: TPasElement;
  887. const PropName: string; const DefaultValue: TProcTypeModifiers): TProcTypeModifiers; virtual;
  888. procedure ReadProcedureType(Obj: TJSONObject; El: TPasProcedureType; aContext: TPCUReaderContext); virtual;
  889. procedure ReadResultElement(Obj: TJSONObject; El: TPasResultElement; aContext: TPCUReaderContext); virtual;
  890. procedure ReadFunctionType(Obj: TJSONObject; El: TPasFunctionType; aContext: TPCUReaderContext); virtual;
  891. procedure ReadStringType(Obj: TJSONObject; El: TPasStringType; aContext: TPCUReaderContext); virtual;
  892. function ReadVarModifiers(Obj: TJSONObject; El: TPasElement;
  893. const PropName: string; const DefaultValue: TVariableModifiers): TVariableModifiers; virtual;
  894. procedure ReadVariable(Obj: TJSONObject; El: TPasVariable; aContext: TPCUReaderContext); virtual;
  895. procedure ReadExportSymbol(Obj: TJSONObject; El: TPasExportSymbol; aContext: TPCUReaderContext); virtual;
  896. procedure ReadConst(Obj: TJSONObject; El: TPasConst; aContext: TPCUReaderContext); virtual;
  897. procedure ReadPropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUReaderContext); virtual;
  898. procedure ReadProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUReaderContext); virtual;
  899. procedure ReadMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUReaderContext); virtual;
  900. function ReadProcedureModifiers(Obj: TJSONObject; El: TPasElement;
  901. const PropName: string; const DefaultValue: TProcedureModifiers): TProcedureModifiers; virtual;
  902. function ReadProcScopeFlags(Obj: TJSONObject; El: TPasElement;
  903. const PropName: string; const DefaultValue: TPasProcedureScopeFlags): TPasProcedureScopeFlags; virtual;
  904. procedure ReadProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPCUReaderContext); virtual;
  905. procedure ReadProcScopeReferences(Obj: TJSONObject; ImplScope: TPas2JSProcedureScope); virtual;
  906. procedure ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
  907. procedure ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
  908. procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUReaderContext); virtual;
  909. procedure ResolvePending; virtual;
  910. procedure ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement); virtual;
  911. public
  912. constructor Create; override;
  913. destructor Destroy; override;
  914. procedure Clear; override;
  915. procedure ReadPCU(aResolver: TPas2JSResolver; aStream: TStream); override; // sets property JSON, reads header and returns
  916. procedure ReadJSONHeader(aResolver: TPas2JSResolver; Obj: TJSONObject); virtual;
  917. function ReadContinue: boolean; override; // true=finished
  918. property FileVersion: longint read FFileVersion;
  919. property JSON: TJSONObject read FJSON;
  920. end;
  921. { TPas2JSPrecompileFormat }
  922. TPas2JSPrecompileFormat = class
  923. public
  924. Ext: string;
  925. Description: string; // used by -h
  926. ReaderClass: TPCUReaderClass;
  927. WriterClass: TPCUWriterClass;
  928. Enabled: boolean;
  929. end;
  930. { TPas2JSPrecompileFormats }
  931. TPas2JSPrecompileFormats = class
  932. private
  933. FItems: TObjectList; // list of TObjectList
  934. function GetItems(Index: integer): TPas2JSPrecompileFormat;
  935. public
  936. constructor Create;
  937. destructor Destroy; override;
  938. procedure Clear;
  939. function Count: integer;
  940. function Add(aFormat: TPas2JSPrecompileFormat): TPas2JSPrecompileFormats;
  941. function Add(const Ext, Description: string;
  942. const Reader: TPCUReaderClass;
  943. const Writer: TPCUWriterClass
  944. ): TPas2JSPrecompileFormat;
  945. function IndexOf(aFormat: TPas2JSPrecompileFormat): integer;
  946. function FindExt(Ext: string): TPas2JSPrecompileFormat;
  947. function Remove(aFormat: TPas2JSPrecompileFormat): integer;
  948. function Delete(Index: integer): TPas2JSPrecompileFormats;
  949. property Items[Index: integer]: TPas2JSPrecompileFormat read GetItems; default;
  950. end;
  951. var
  952. PrecompileFormats: TPas2JSPrecompileFormats = nil;
  953. function ComparePointer(Data1, Data2: Pointer): integer;
  954. function ComparePCUSrcFiles(File1, File2: Pointer): integer;
  955. function ComparePCUFilerElementRef(Ref1, Ref2: Pointer): integer;
  956. function CompareElWithPCUFilerElementRef(El, Ref: Pointer): integer;
  957. function EncodeVLQ(i: TMaxPrecInt): string; overload;
  958. function EncodeVLQ(i: TMaxPrecUInt): string; overload;
  959. function DecodeVLQ(const s: string): TMaxPrecInt; // base256 Variable Length Quantity
  960. function DecodeVLQ(var p: PByte): TMaxPrecInt; // base256 Variable Length Quantity
  961. function ComputeChecksum(p: PChar; Cnt: integer): TPCUSourceFileChecksum;
  962. function crc32(crc: cardinal; buf: Pbyte; len: cardinal): cardinal;
  963. function ModeSwitchToInt(ms: TModeSwitch): byte;
  964. function StrToPasIdentifierKind(const s: string): TPasIdentifierKind;
  965. procedure WriteJSON(aData: TJSONData; TargetStream: TStream; Compressed: boolean);
  966. procedure GrowIdToRefsArray(var IdToRefsArray: TPCUFilerElementRefArray; Id: integer);
  967. function dbgmem(const s: string): string; overload;
  968. function dbgmem(p: PChar; Cnt: integer): string; overload;
  969. implementation
  970. function ComparePointer(Data1, Data2: Pointer): integer;
  971. begin
  972. if Data1>Data2 then Result:=-1
  973. else if Data1<Data2 then Result:=1
  974. else Result:=0;
  975. end;
  976. function ComparePCUSrcFiles(File1, File2: Pointer): integer;
  977. var
  978. Src1: TPCUSourceFile absolute File1;
  979. Src2: TPCUSourceFile absolute File2;
  980. begin
  981. Result:=CompareStr(Src1.Filename,Src2.Filename);
  982. end;
  983. function ComparePCUFilerElementRef(Ref1, Ref2: Pointer): integer;
  984. var
  985. Reference1: TPCUFilerElementRef absolute Ref1;
  986. Reference2: TPCUFilerElementRef absolute Ref2;
  987. begin
  988. Result:=ComparePointer(Reference1.Element,Reference2.Element);
  989. end;
  990. function CompareElWithPCUFilerElementRef(El, Ref: Pointer): integer;
  991. var
  992. Element: TPasElement absolute El;
  993. Reference: TPCUFilerElementRef absolute Ref;
  994. begin
  995. Result:=ComparePointer(Element,Reference.Element);
  996. end;
  997. function EncodeVLQ(i: TMaxPrecInt): string;
  998. { Convert signed number to base256-VLQ:
  999. Each byte has 8bit, where the least significant bit is the continuation bit
  1000. (1=there is a next byte).
  1001. The first byte contains the sign bit in the last bit
  1002. and the 6 most significant bits of the number.
  1003. For example:
  1004. 0 = %00000000 => 0
  1005. 1 = %00000001 => -0
  1006. 2 = %00000010 => 1
  1007. 130 5 = %10000010 %00000101 = 000010 0000101 = 100000101 = 133
  1008. }
  1009. var
  1010. digits: integer;
  1011. begin
  1012. digits:=0;
  1013. if i<0 then
  1014. begin
  1015. if i=Low(TMaxPrecInt) then
  1016. begin
  1017. Result:=EncodeVLQ(High(TMaxPrecInt)+1);
  1018. Result[1]:=chr(ord(Result[1]) or 1);
  1019. exit;
  1020. end;
  1021. digits:=1;
  1022. i:=-i;
  1023. end;
  1024. inc(digits,(i and %111111) shl 1);
  1025. i:=i shr 6;
  1026. if i>0 then
  1027. inc(digits,%10000000); // need another byte -> set continuation bit
  1028. Result:=chr(digits);
  1029. while i>0 do
  1030. begin
  1031. digits:=i and %1111111;
  1032. i:=i shr 7;
  1033. if i>0 then
  1034. inc(digits,%10000000); // need another byte -> set continuation bit
  1035. Result:=Result+chr(digits);
  1036. end;
  1037. end;
  1038. function EncodeVLQ(i: TMaxPrecUInt): string;
  1039. var
  1040. digits: integer;
  1041. begin
  1042. digits:=(i and %111111) shl 1;
  1043. if i>0 then
  1044. inc(digits,%10000000); // need another byte -> set continuation bit
  1045. Result:=chr(digits);
  1046. i:=i shr 6;
  1047. while i>0 do
  1048. begin
  1049. digits:=i and %1111111;
  1050. i:=i shr 7;
  1051. if i>0 then
  1052. inc(digits,%10000000); // need another byte -> set continuation bit
  1053. Result:=Result+chr(digits);
  1054. end;
  1055. end;
  1056. function DecodeVLQ(const s: string): TMaxPrecInt;
  1057. var
  1058. p: PByte;
  1059. begin
  1060. if s='' then
  1061. raise EConvertError.Create('DecodeVLQ empty');
  1062. p:=PByte(s);
  1063. Result:=DecodeVLQ(p);
  1064. if p-PByte(s)<>length(s) then
  1065. raise EConvertError.Create('DecodeVLQ waste');
  1066. end;
  1067. function DecodeVLQ(var p: PByte): TMaxPrecInt;
  1068. { Convert base256-VLQ to signed number,
  1069. For the fomat see EncodeVLQ
  1070. }
  1071. procedure RaiseInvalid;
  1072. begin
  1073. raise ERangeError.Create('DecodeVLQ');
  1074. end;
  1075. const
  1076. MaxShift = 63; // actually log2(High(TMaxPrecInt))
  1077. var
  1078. digit, Shift: Integer;
  1079. Negated: Boolean;
  1080. begin
  1081. digit:=p^;
  1082. inc(p);
  1083. Negated:=(digit and 1)>0;
  1084. Result:=(digit shr 1) and %111111;
  1085. Shift:=6;
  1086. while digit>=%10000000 do
  1087. begin
  1088. digit:=p^;
  1089. inc(p);
  1090. if Shift>MaxShift then
  1091. RaiseInvalid;
  1092. inc(Result,TMaxPrecInt(digit and %1111111) shl Shift);
  1093. inc(Shift,7);
  1094. end;
  1095. if Negated then
  1096. Result:=-Result;
  1097. end;
  1098. function ComputeChecksum(p: PChar; Cnt: integer): TPCUSourceFileChecksum;
  1099. var
  1100. SrcP, SrcEndP, SrcLineEndP, SrcLineStartP: PChar;
  1101. l: PtrInt;
  1102. CheckSum, CurLen: Cardinal;
  1103. begin
  1104. if Cnt=0 then exit(0);
  1105. // ignore trailing spaces and unify line endings
  1106. SrcP:=p;
  1107. SrcEndP:=p+Cnt;
  1108. while (SrcEndP>SrcP) and (SrcEndP[-1] in [#9,#10,#13,' ']) do
  1109. dec(SrcEndP);
  1110. CheckSum:=crc32(0,nil,0);
  1111. while SrcP<SrcEndP do
  1112. begin
  1113. SrcLineStartP:=SrcP;
  1114. while (SrcP<SrcEndP) and not (SrcP^ in [#10,#13]) do
  1115. inc(SrcP);
  1116. SrcLineEndP:=SrcP;
  1117. while (SrcLineEndP>SrcLineStartP) and (SrcLineEndP[-1] in [#9,' ']) do
  1118. dec(SrcLineEndP);
  1119. l:=SrcLineEndP-SrcLineStartP;
  1120. while l>0 do
  1121. begin
  1122. if l<$8000 then
  1123. CurLen:=l
  1124. else
  1125. CurLen:=$8000;
  1126. CheckSum:=crc32(CheckSum, PByte(SrcLineStartP), CurLen);
  1127. inc(SrcLineStartP,CurLen);
  1128. dec(l,CurLen);
  1129. end;
  1130. while (SrcP<SrcEndP) and (SrcP^ in [#10,#13]) do
  1131. inc(SrcP);
  1132. end;
  1133. Result:=CheckSum;
  1134. end;
  1135. const
  1136. crc32_table : array[Byte] of cardinal = (
  1137. $00000000, $77073096, $ee0e612c, $990951ba, $076dc419,
  1138. $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4,
  1139. $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07,
  1140. $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de,
  1141. $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856,
  1142. $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,
  1143. $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4,
  1144. $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
  1145. $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3,
  1146. $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a,
  1147. $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599,
  1148. $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,
  1149. $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190,
  1150. $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f,
  1151. $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e,
  1152. $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
  1153. $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed,
  1154. $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,
  1155. $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3,
  1156. $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2,
  1157. $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a,
  1158. $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5,
  1159. $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010,
  1160. $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
  1161. $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17,
  1162. $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6,
  1163. $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615,
  1164. $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,
  1165. $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344,
  1166. $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
  1167. $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a,
  1168. $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
  1169. $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1,
  1170. $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c,
  1171. $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef,
  1172. $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,
  1173. $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe,
  1174. $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31,
  1175. $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c,
  1176. $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
  1177. $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b,
  1178. $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
  1179. $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1,
  1180. $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c,
  1181. $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278,
  1182. $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7,
  1183. $4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66,
  1184. $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
  1185. $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605,
  1186. $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8,
  1187. $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b,
  1188. $2d02ef8d);
  1189. function crc32(crc: cardinal; buf: Pbyte; len: cardinal): cardinal;
  1190. begin
  1191. if buf = nil then
  1192. exit(0);
  1193. crc := crc xor $FFFFFFFF;
  1194. while (len >= 8) do
  1195. begin
  1196. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1197. inc(buf);
  1198. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1199. inc(buf);
  1200. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1201. inc(buf);
  1202. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1203. inc(buf);
  1204. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1205. inc(buf);
  1206. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1207. inc(buf);
  1208. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1209. inc(buf);
  1210. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1211. inc(buf);
  1212. dec(len, 8);
  1213. end;
  1214. while (len > 0) do
  1215. begin
  1216. crc := crc32_table[(crc xor buf^) and $ff] xor (crc shr 8);
  1217. inc(buf);
  1218. dec(len);
  1219. end;
  1220. result := crc xor $FFFFFFFF;
  1221. end;
  1222. function ModeSwitchToInt(ms: TModeSwitch): byte;
  1223. begin
  1224. case ms of
  1225. msNone: Result:=0;
  1226. msFpc: Result:=1;
  1227. msObjfpc: Result:=2;
  1228. msDelphi: Result:=3;
  1229. msDelphiUnicode: Result:=4;
  1230. msTP7: Result:=5;
  1231. msMac: Result:=6;
  1232. msIso: Result:=7;
  1233. msExtpas: Result:=8;
  1234. msGPC: Result:=9;
  1235. msClass: Result:=10;
  1236. msObjpas: Result:=11;
  1237. msResult: Result:=12;
  1238. msStringPchar: Result:=13;
  1239. msCVarSupport: Result:=14;
  1240. msNestedComment: Result:=15;
  1241. msTPProcVar: Result:=16;
  1242. msMacProcVar: Result:=17;
  1243. msRepeatForward: Result:=18;
  1244. msPointer2Procedure: Result:=19;
  1245. msAutoDeref: Result:=20;
  1246. msInitFinal: Result:=21;
  1247. msDefaultAnsistring: Result:=22;
  1248. msOut: Result:=23;
  1249. msDefaultPara: Result:=24;
  1250. msHintDirective: Result:=25;
  1251. msDuplicateNames: Result:=26;
  1252. msProperty: Result:=27;
  1253. msDefaultInline: Result:=28;
  1254. msExcept: Result:=29;
  1255. msObjectiveC1: Result:=30;
  1256. msObjectiveC2: Result:=31;
  1257. msNestedProcVars: Result:=32;
  1258. msNonLocalGoto: Result:=33;
  1259. msAdvancedRecords: Result:=34;
  1260. msISOLikeUnaryMinus: Result:=35;
  1261. msSystemCodePage: Result:=36;
  1262. msFinalFields: Result:=37;
  1263. msDefaultUnicodestring: Result:=38;
  1264. msTypeHelpers: Result:=39;
  1265. msCBlocks: Result:=40;
  1266. msISOLikeIO: Result:=41;
  1267. msISOLikeProgramsPara: Result:=42;
  1268. msISOLikeMod: Result:=43;
  1269. msExternalClass: Result:=44;
  1270. msPrefixedAttributes: Result:=45;
  1271. // msIgnoreInterfaces: Result:=46;
  1272. msIgnoreAttributes: Result:=47;
  1273. end;
  1274. end;
  1275. function StrToPasIdentifierKind(const s: string): TPasIdentifierKind;
  1276. var
  1277. Kind: TPasIdentifierKind;
  1278. begin
  1279. for Kind in TPasIdentifierKind do
  1280. if s=PCUIdentifierKindNames[Kind] then
  1281. exit(Kind);
  1282. Result:=pikNone;
  1283. end;
  1284. procedure WriteJSON(aData: TJSONData; TargetStream: TStream; Compressed: boolean
  1285. );
  1286. var
  1287. CurIndent: integer;
  1288. Spaces: string;
  1289. procedure WriteString(const s: string);
  1290. begin
  1291. if s='' then exit;
  1292. TargetStream.Write(s[1],length(s));
  1293. end;
  1294. procedure WriteChar(const c: char);
  1295. begin
  1296. TargetStream.Write(c,1);
  1297. end;
  1298. procedure WriteLine;
  1299. begin
  1300. WriteString(sLineBreak);
  1301. if CurIndent>0 then
  1302. TargetStream.Write(Spaces[1],CurIndent);
  1303. end;
  1304. procedure Indent;
  1305. begin
  1306. if Compressed then exit;
  1307. inc(CurIndent,2);
  1308. if CurIndent>length(Spaces) then
  1309. Spaces:=Spaces+' ';
  1310. end;
  1311. procedure Unindent;
  1312. begin
  1313. if Compressed then exit;
  1314. dec(CurIndent,2);
  1315. end;
  1316. procedure WriteData(Data: TJSONData); forward;
  1317. procedure WriteObj(Obj: TJSONObject);
  1318. var
  1319. i: Integer;
  1320. Name: String;
  1321. begin
  1322. WriteChar('{');
  1323. if not Compressed then
  1324. begin
  1325. Indent;
  1326. WriteLine;
  1327. end;
  1328. for i:=0 to Obj.Count-1 do
  1329. begin
  1330. if i>0 then
  1331. begin
  1332. WriteChar(',');
  1333. if not Compressed then
  1334. WriteLine;
  1335. end;
  1336. Name:=Obj.Names[i];
  1337. WriteChar('"');
  1338. if IsValidIdent(Name) then
  1339. WriteString(Name)
  1340. else
  1341. WriteString(StringToJSONString(Name,false));
  1342. WriteString('":');
  1343. WriteData(Obj.Elements[Name]);
  1344. end;
  1345. if not Compressed then
  1346. begin
  1347. Unindent;
  1348. WriteLine;
  1349. end;
  1350. WriteChar('}');
  1351. end;
  1352. procedure WriteArray(Arr: TJSONArray);
  1353. var
  1354. i: Integer;
  1355. begin
  1356. WriteChar('[');
  1357. if not Compressed then
  1358. begin
  1359. Indent;
  1360. WriteLine;
  1361. end;
  1362. for i:=0 to Arr.Count-1 do
  1363. begin
  1364. if i>0 then
  1365. begin
  1366. WriteChar(',');
  1367. if not Compressed then
  1368. WriteLine;
  1369. end;
  1370. WriteData(Arr[i]);
  1371. end;
  1372. if not Compressed then
  1373. begin
  1374. Unindent;
  1375. WriteLine;
  1376. end;
  1377. WriteChar(']');
  1378. end;
  1379. procedure WriteData(Data: TJSONData);
  1380. var
  1381. C: TClass;
  1382. begin
  1383. C:=Data.ClassType;
  1384. if C=TJSONObject then
  1385. WriteObj(TJSONObject(Data))
  1386. else if C=TJSONArray then
  1387. WriteArray(TJSONArray(Data))
  1388. else if C.InheritsFrom(TJSONNumber)
  1389. or (C=TJSONBoolean)
  1390. then
  1391. WriteString(Data.AsString)
  1392. else if (C=TJSONNull) then
  1393. WriteString('null')
  1394. else if C=TJSONString then
  1395. begin
  1396. WriteChar('"');
  1397. WriteString(StringToJSONString(Data.AsString));
  1398. WriteChar('"');
  1399. end
  1400. else
  1401. raise EPas2JsWriteError.Create('unknown JSON data '+GetObjName(Data));
  1402. end;
  1403. begin
  1404. CurIndent:=0;
  1405. WriteData(aData);
  1406. end;
  1407. procedure GrowIdToRefsArray(var IdToRefsArray: TPCUFilerElementRefArray; Id: integer);
  1408. var
  1409. OldCapacity, NewCapacity: Integer;
  1410. begin
  1411. OldCapacity:=length(IdToRefsArray);
  1412. if Id>=OldCapacity then
  1413. begin
  1414. // grow
  1415. NewCapacity:=OldCapacity;
  1416. if NewCapacity=0 then NewCapacity:=100;
  1417. while NewCapacity<Id+1 do NewCapacity:=NewCapacity*2;
  1418. SetLength(IdToRefsArray,NewCapacity);
  1419. FillByte(IdToRefsArray[OldCapacity],SizeOf(Pointer)*(NewCapacity-OldCapacity),0);
  1420. end;
  1421. end;
  1422. function dbgmem(const s: string): string;
  1423. begin
  1424. if s='' then exit('');
  1425. Result:=dbgmem(PChar(s),length(s));
  1426. end;
  1427. function dbgmem(p: PChar; Cnt: integer): string;
  1428. procedure AddLine(const Line: string);
  1429. begin
  1430. if Result<>'' then
  1431. Result:=Result+LineEnding;
  1432. Result:=Result+Line;
  1433. end;
  1434. var
  1435. c: Char;
  1436. IsTxt: boolean;
  1437. Line: String;
  1438. i: Integer;
  1439. begin
  1440. Result:='';
  1441. if (p=nil) or (Cnt<=0) then exit;
  1442. Line:='';
  1443. IsTxt:=false;
  1444. for i:=0 to Cnt-1 do
  1445. begin
  1446. c:=p[i];
  1447. if c in ['a'..'z','A'..'Z','_','/','0'..'9'] then
  1448. begin
  1449. if not IsTxt then
  1450. begin
  1451. Line:=Line+'''';
  1452. IsTxt:=true;
  1453. end;
  1454. Line:=Line+c;
  1455. end
  1456. else
  1457. begin
  1458. if IsTxt then
  1459. begin
  1460. Line:=Line+'''';
  1461. IsTxt:=false;
  1462. end;
  1463. Line:=Line+'#'+HexStr(ord(c),2);
  1464. end;
  1465. if length(Line)>78 then
  1466. begin
  1467. AddLine(Line);
  1468. Line:='';
  1469. end;
  1470. end;
  1471. if Line<>'' then
  1472. AddLine(Line);
  1473. end;
  1474. { TPCUCustomReader }
  1475. function TPCUCustomReader.ReadCanContinue: boolean;
  1476. var
  1477. Module: TPasModule;
  1478. Section: TPasSection;
  1479. Scope: TPas2JSSectionScope;
  1480. begin
  1481. Result:=false;
  1482. Module:=Resolver.RootElement;
  1483. if Module=nil then exit(true); // not yet started
  1484. Section:=Resolver.GetLastSection;
  1485. if Section=nil then exit(true); // only header
  1486. Scope:=Section.CustomData as TPas2JSSectionScope;
  1487. if Scope.Finished then exit(false); // finished
  1488. Result:=Section.PendingUsedIntf=nil;
  1489. end;
  1490. { TPCUFilerElementRef }
  1491. procedure TPCUFilerElementRef.AddPending(Item: TPCUFilerPendingElRef);
  1492. begin
  1493. Item.Next:=Pending;
  1494. Pending:=Item;
  1495. end;
  1496. procedure TPCUFilerElementRef.Clear;
  1497. var
  1498. Ref, NextRef: TPCUFilerPendingElRef;
  1499. begin
  1500. Elements:=nil;
  1501. Ref:=Pending;
  1502. while Ref<>nil do
  1503. begin
  1504. NextRef:=Ref.Next;
  1505. Ref.Next:=nil;
  1506. Ref.Free;
  1507. Ref:=NextRef;
  1508. end;
  1509. Pending:=nil;
  1510. end;
  1511. destructor TPCUFilerElementRef.Destroy;
  1512. begin
  1513. Clear;
  1514. inherited Destroy;
  1515. end;
  1516. { TPCUFiler }
  1517. function TPCUFiler.GetSourceFiles(Index: integer): TPCUSourceFile;
  1518. begin
  1519. Result:=TPCUSourceFile(FSourceFiles[Index]);
  1520. end;
  1521. procedure TPCUFiler.RaiseMsg(Id: int64; El: TPasElement; const Msg: string);
  1522. var
  1523. Path, s: String;
  1524. CurEl: TPasElement;
  1525. begin
  1526. Path:='';
  1527. CurEl:=El;
  1528. while CurEl<>nil do
  1529. begin
  1530. if Path<>'' then Path:='.'+Path;
  1531. s:=CurEl.Name;
  1532. if s='' then
  1533. s:=CurEl.ClassName;
  1534. Path:=s+Path;
  1535. CurEl:=CurEl.Parent;
  1536. end;
  1537. s:=Path+': '+Msg;
  1538. if El.GetModule<>Resolver.RootElement then
  1539. s:='This='+Resolver.RootElement.Name+' El='+s;
  1540. RaiseMsg(Id,s);
  1541. end;
  1542. function TPCUFiler.GetDefaultMemberVisibility(El: TPasElement
  1543. ): TPasMemberVisibility;
  1544. var
  1545. aClass: TPasClassType;
  1546. begin
  1547. if El=nil then ;
  1548. Result:=visDefault;
  1549. if El.Parent is TPasClassType then
  1550. begin
  1551. aClass:=TPasClassType(El.Parent);
  1552. case aClass.ObjKind of
  1553. okInterface: Result:=visPublic;
  1554. end;
  1555. end;
  1556. end;
  1557. function TPCUFiler.GetDefaultPasScopeVisibilityContext(Scope: TPasScope
  1558. ): TPasElement;
  1559. var
  1560. El: TPasElement;
  1561. begin
  1562. El:=Scope.Element;
  1563. if El is TPasMembersType then
  1564. Result:=El
  1565. else if El is TPasModule then
  1566. Result:=El
  1567. else if (Scope is TPasProcedureScope) and (Scope.Element.Parent is TPasMembersType) then
  1568. Result:=Scope.Element.Parent
  1569. else
  1570. Result:=nil;
  1571. end;
  1572. procedure TPCUFiler.GetDefaultsPasIdentifierProps(El: TPasElement; out
  1573. Kind: TPasIdentifierKind; out Name: string);
  1574. begin
  1575. Kind:=PCUDefaultIdentifierKind;
  1576. if El is TPasProcedure then
  1577. Kind:=pikProc;
  1578. Name:=El.Name;
  1579. end;
  1580. function TPCUFiler.GetDefaultClassScopeFlags(Scope: TPas2JSClassScope
  1581. ): TPasClassScopeFlags;
  1582. begin
  1583. if FFileVersion<2 then
  1584. Result:=[]
  1585. else
  1586. Result:=[pcsfAncestorResolved];
  1587. if Scope.AncestorScope<>nil then
  1588. begin
  1589. if pcsfPublished in Scope.AncestorScope.Flags then
  1590. Include(Result,pcsfPublished);
  1591. end;
  1592. end;
  1593. function TPCUFiler.GetDefaultProcModifiers(Proc: TPasProcedure
  1594. ): TProcedureModifiers;
  1595. begin
  1596. Result:=[];
  1597. if Proc.Parent is TPasClassType then
  1598. begin
  1599. if TPasClassType(Proc.Parent).IsExternal then
  1600. Include(Result,pmExternal);
  1601. end;
  1602. end;
  1603. function TPCUFiler.GetDefaultProcTypeModifiers(ProcType: TPasProcedureType
  1604. ): TProcTypeModifiers;
  1605. var
  1606. Proc: TPasProcedure;
  1607. begin
  1608. Result:=[];
  1609. if ProcType.Parent is TPasProcedure then
  1610. begin
  1611. Proc:=TPasProcedure(ProcType.Parent);
  1612. if Proc.Parent is TPasClassType then
  1613. Include(Result,ptmOfObject);
  1614. end;
  1615. end;
  1616. function TPCUFiler.GetDefaultExprHasEvalValue(Expr: TPasExpr): boolean;
  1617. var
  1618. C: TClass;
  1619. begin
  1620. C:=Expr.Parent.ClassType;
  1621. if C.InheritsFrom(TPasExpr) then exit(false);
  1622. if (C=TPasAliasType)
  1623. or (C=TPasTypeAliasType)
  1624. or (C=TPasPointerType)
  1625. or (C=TPasProperty)
  1626. then
  1627. exit(false);
  1628. C:=Expr.ClassType;
  1629. if C=TArrayValues then exit(false);
  1630. if C=TRecordValues then exit(false);
  1631. Result:=not Resolver.ExprEvaluator.IsSimpleExpr(Expr);
  1632. end;
  1633. function TPCUFiler.GetSrcCheckSum(aFilename: string): TPCUSourceFileChecksum;
  1634. var
  1635. p: PChar;
  1636. Cnt: integer;
  1637. begin
  1638. OnGetSrc(Self,aFilename,p,Cnt);
  1639. Result:=ComputeChecksum(p,Cnt);
  1640. end;
  1641. function TPCUFiler.GetDefaultRefName(El: TPasElement): string;
  1642. var
  1643. C: TClass;
  1644. begin
  1645. Result:=El.Name;
  1646. if Result<>'' then exit;
  1647. // some elements without name can be referred to:
  1648. C:=El.ClassType;
  1649. if C=TInterfaceSection then
  1650. Result:='Interface'
  1651. else if C=TPasArrayType then
  1652. Result:='Array' // anonymous array
  1653. else if C.InheritsFrom(TPasProcedureType) and (El.Parent is TPasProcedure) then
  1654. Result:='Type'
  1655. else
  1656. Result:='';
  1657. end;
  1658. function TPCUFiler.GetElementReference(El: TPasElement; AutoCreate: boolean
  1659. ): TPCUFilerElementRef;
  1660. var
  1661. Node: TAVLTreeNode;
  1662. MyEl: TPasElement;
  1663. IsBuiltIn: boolean;
  1664. begin
  1665. {$IFDEF VerbosePCUFiler}
  1666. //writeln('TPCUFiler.GetElementReference ',GetObjName(El));
  1667. {$ENDIF}
  1668. IsBuiltIn:=El.CustomData is TResElDataBuiltInSymbol;
  1669. if IsBuiltIn then
  1670. begin
  1671. // built-in symbol -> redirect to symbol of this module
  1672. MyEl:=Resolver.FindLocalBuiltInSymbol(El);
  1673. if MyEl=nil then
  1674. RaiseMsg(20180207121004,El,GetObjName(El.CustomData));
  1675. El:=MyEl;
  1676. end
  1677. else if El is TPasUnresolvedSymbolRef then
  1678. RaiseMsg(20180215190054,El,GetObjName(El));
  1679. Node:=FElementRefs.FindKey(El,@CompareElWithPCUFilerElementRef);
  1680. if Node<>nil then
  1681. Result:=TPCUFilerElementRef(Node.Data)
  1682. else if AutoCreate then
  1683. begin
  1684. Result:=CreateElementRef(El);
  1685. if IsBuiltIn then
  1686. AddedBuiltInRef(Result);
  1687. end
  1688. else
  1689. Result:=nil;
  1690. end;
  1691. function TPCUFiler.CreateElementRef(El: TPasElement): TPCUFilerElementRef;
  1692. {$IFDEF MemCheck}
  1693. var
  1694. Node: TAVLTreeNode;
  1695. {$ENDIF}
  1696. begin
  1697. Result:=TPCUFilerElementRef.Create;
  1698. Result.Element:=El;
  1699. {$IFDEF MemCheck}
  1700. Node:=FElementRefs.Add(Result);
  1701. if Node<>FElementRefs.FindKey(El,@CompareElWithPCUFilerElementRef) then
  1702. RaiseMsg(20180711222046,El);
  1703. {$ELSE}
  1704. FElementRefs.Add(Result);
  1705. {$ENDIF}
  1706. end;
  1707. procedure TPCUFiler.AddedBuiltInRef(Ref: TPCUFilerElementRef);
  1708. begin
  1709. if Ref=nil then ;
  1710. end;
  1711. constructor TPCUFiler.Create;
  1712. begin
  1713. FFileVersion:=PCUVersion;
  1714. FSourceFiles:=TObjectList.Create(true);
  1715. FElementRefs:=TAVLTree.Create(@ComparePCUFilerElementRef);
  1716. FElementRefs.SetNodeManager(TAVLTreeNodeMemManager.Create,true); // no shared manager, needed for multithreading
  1717. end;
  1718. destructor TPCUFiler.Destroy;
  1719. begin
  1720. Clear;
  1721. FreeAndNil(FSourceFiles);
  1722. FreeAndNil(FElementRefs);
  1723. inherited Destroy;
  1724. end;
  1725. procedure TPCUFiler.Clear;
  1726. begin
  1727. FElementRefs.FreeAndClear;
  1728. FSourceFiles.Clear;
  1729. FResolver:=nil;
  1730. FParser:=nil;
  1731. FScanner:=nil;
  1732. end;
  1733. function TPCUFiler.SourceFileCount: integer;
  1734. begin
  1735. Result:=FSourceFiles.Count;
  1736. end;
  1737. { TPCUInitialFlags }
  1738. constructor TPCUInitialFlags.Create;
  1739. begin
  1740. Clear;
  1741. end;
  1742. procedure TPCUInitialFlags.Clear;
  1743. begin
  1744. ParserOptions:=PCUDefaultParserOptions;
  1745. ModeSwitches:=PCUDefaultModeSwitches;
  1746. BoolSwitches:=PCUDefaultBoolSwitches;
  1747. ConverterOptions:=PCUDefaultConverterOptions;
  1748. TargetPlatform:=PCUDefaultTargetPlatform;
  1749. TargetProcessor:=PCUDefaultTargetProcessor;
  1750. end;
  1751. { TPCUWriter }
  1752. procedure TPCUWriter.ResolvePendingElRefs(Ref: TPCUFilerElementRef);
  1753. var
  1754. RefItem: TPCUFilerPendingElRef;
  1755. RefObj: TPCUWriterPendingElRefObj;
  1756. RefArr: TPCUWriterPendingElRefArray;
  1757. begin
  1758. if Ref.Pending=nil then exit;
  1759. // this element is referenced
  1760. if Ref.Id=0 then
  1761. CreateElReferenceId(Ref);
  1762. // resolve all pending references
  1763. while Ref.Pending<>nil do
  1764. begin
  1765. RefItem:=Ref.Pending;
  1766. if RefItem is TPCUWriterPendingElRefObj then
  1767. begin
  1768. RefObj:=TPCUWriterPendingElRefObj(RefItem);
  1769. RefObj.Obj.Add(RefObj.PropName,Ref.Id);
  1770. end
  1771. else if RefItem is TPCUWriterPendingElRefArray then
  1772. begin
  1773. RefArr:=TPCUWriterPendingElRefArray(RefItem);
  1774. RefArr.Arr.Integers[RefArr.Index]:=Ref.Id;
  1775. end
  1776. else
  1777. RaiseMsg(20180207113335,RefItem.ClassName);
  1778. Ref.Pending:=RefItem.Next;
  1779. RefItem.Next:=nil;
  1780. RefItem.Free;
  1781. end;
  1782. end;
  1783. procedure TPCUWriter.RaiseMsg(Id: int64; const Msg: string);
  1784. var
  1785. E: EPas2JsWriteError;
  1786. begin
  1787. E:=EPas2JsWriteError.Create('['+IntToStr(Id)+'] '+Msg);
  1788. E.Owner:=Self;
  1789. {$IFDEF VerbosePCUFiler}
  1790. writeln('TPCUWriter.RaiseMsg ',E.Message);
  1791. {$ENDIF}
  1792. raise E;
  1793. end;
  1794. function TPCUWriter.CheckElScope(El: TPasElement; NotNilId: int64;
  1795. ScopeClass: TPasScopeClass): TPasScope;
  1796. var
  1797. Data: TObject;
  1798. begin
  1799. Data:=El.CustomData;
  1800. if Data=nil then
  1801. begin
  1802. if NotNilId>0 then
  1803. RaiseMsg(NotNilId);
  1804. exit(nil);
  1805. end;
  1806. if Data.ClassType<>ScopeClass then
  1807. RaiseMsg(20180206113601,'expected '+ScopeClass.ClassName+', but found '+Data.ClassName);
  1808. Result:=TPasScope(Data);
  1809. if Result.Element<>El then
  1810. RaiseMsg(20180206113723,'El='+GetObjName(El)+' Scope.Element='+GetObjName(Result.Element));
  1811. if Result.Owner<>Resolver then
  1812. RaiseMsg(20180206113750,El,GetObjName(Result));
  1813. end;
  1814. procedure TPCUWriter.AddArrayFlag(Obj: TJSONObject; var Arr: TJSONArray;
  1815. const ArrName, Flag: string; Enable: boolean);
  1816. begin
  1817. if Arr=nil then
  1818. begin
  1819. Arr:=TJSONArray.Create;
  1820. Obj.Add(ArrName,Arr);
  1821. end;
  1822. if Enable then
  1823. Arr.Add(Flag)
  1824. else
  1825. Arr.Add('-'+Flag);
  1826. end;
  1827. procedure TPCUWriter.AddReferenceToArray(Arr: TJSONArray; El: TPasElement;
  1828. WriteNull: boolean);
  1829. var
  1830. Ref: TPCUFilerElementRef;
  1831. Item: TPCUWriterPendingElRefArray;
  1832. begin
  1833. if El=nil then
  1834. begin
  1835. if WriteNull then
  1836. Arr.Add(CreateJSON);
  1837. exit;
  1838. end;
  1839. Ref:=GetElementReference(El);
  1840. if (Ref.Obj<>nil) and (Ref.Id=0) then
  1841. CreateElReferenceId(Ref);
  1842. Arr.Add(Ref.Id);
  1843. if Ref.Id<>0 then
  1844. exit;
  1845. // Element was not yet written -> add a pending item to the queue
  1846. Item:=TPCUWriterPendingElRefArray.Create;
  1847. Item.ErrorEl:=El;
  1848. Item.Arr:=Arr;
  1849. Item.Index:=Arr.Count-1;
  1850. Ref.AddPending(Item);
  1851. end;
  1852. procedure TPCUWriter.AddReferenceToObj(Obj: TJSONObject;
  1853. const PropName: string; El: TPasElement; WriteNil: boolean);
  1854. var
  1855. Ref: TPCUFilerElementRef;
  1856. Item: TPCUWriterPendingElRefObj;
  1857. begin
  1858. if El=nil then
  1859. begin
  1860. if WriteNil then
  1861. Obj.Add(PropName,0);
  1862. exit;
  1863. end;
  1864. Ref:=GetElementReference(El);
  1865. if (Ref.Obj<>nil) and (Ref.Id=0) then
  1866. CreateElReferenceId(Ref);
  1867. if Ref.Id<>0 then
  1868. Obj.Add(PropName,Ref.Id)
  1869. else
  1870. begin
  1871. // Element was not yet written -> add a pending item to the queue
  1872. Item:=TPCUWriterPendingElRefObj.Create;
  1873. Item.ErrorEl:=El;
  1874. Item.Obj:=Obj;
  1875. Item.PropName:=PropName;
  1876. Ref.AddPending(Item);
  1877. end;
  1878. end;
  1879. procedure TPCUWriter.CreateElReferenceId(Ref: TPCUFilerElementRef);
  1880. begin
  1881. if Ref.Id<>0 then
  1882. RaiseMsg(20180207114300,Ref.Element,IntToStr(Ref.Id));
  1883. inc(FElementIdCounter);
  1884. Ref.Id:=FElementIdCounter;
  1885. Ref.Obj.Add('Id',Ref.Id);
  1886. end;
  1887. function TPCUWriter.CreateElementRef(El: TPasElement): TPCUFilerElementRef;
  1888. begin
  1889. Result:=inherited CreateElementRef(El);
  1890. if El.GetModule<>Resolver.RootElement then
  1891. begin
  1892. if FFirstNewExt=nil then
  1893. FFirstNewExt:=Result
  1894. else
  1895. FLastNewExt.NextNewExt:=Result;
  1896. FLastNewExt:=Result;
  1897. {$IF defined(VerbosePCUFiler) or defined(VerbosePJUFiler) or defined(VerbosePas2JS)}
  1898. if (El.Name='') and (GetDefaultRefName(El)='') then
  1899. RaiseMsg(20180623091608,El);
  1900. {$ENDIF}
  1901. end;
  1902. end;
  1903. procedure TPCUWriter.AddedBuiltInRef(Ref: TPCUFilerElementRef);
  1904. var
  1905. ModuleObj, Obj: TJSONObject;
  1906. El: TPasElement;
  1907. Data: TObject;
  1908. begin
  1909. El:=Ref.Element;
  1910. // add built-in symbol to BuiltIn array
  1911. if El<>Resolver.FindLocalBuiltInSymbol(El) then
  1912. RaiseMsg(20180207124914,El);
  1913. if FBuiltInSymbolsArr=nil then
  1914. begin
  1915. ModuleObj:=JSON.Find('Module') as TJSONObject;
  1916. FBuiltInSymbolsArr:=TJSONArray.Create;
  1917. ModuleObj.Add(BuiltInNodeName,FBuiltInSymbolsArr);
  1918. end;
  1919. Obj:=TJSONObject.Create;
  1920. FBuiltInSymbolsArr.Add(Obj);
  1921. Obj.Add('Name',El.Name);
  1922. // Ref.Id is written in ResolvePendingElRefs
  1923. Data:=El.CustomData;
  1924. if Data is TResElDataBuiltInProc then
  1925. case TResElDataBuiltInProc(Data).BuiltIn of
  1926. bfStrFunc: Obj.Add('Type','Func');
  1927. end;
  1928. Ref.Obj:=Obj;
  1929. ResolvePendingElRefs(Ref);
  1930. end;
  1931. procedure TPCUWriter.WriteHeaderMagic(Obj: TJSONObject);
  1932. begin
  1933. Obj.Add('FileType',PCUMagic);
  1934. end;
  1935. procedure TPCUWriter.WriteHeaderVersion(Obj: TJSONObject);
  1936. begin
  1937. Obj.Add('Version',PCUVersion);
  1938. end;
  1939. procedure TPCUWriter.WriteGUID(Obj: TJSONObject);
  1940. begin
  1941. Obj.Add('GUID',GUIDToString(GUID));
  1942. end;
  1943. procedure TPCUWriter.WriteInitialFlags(Obj: TJSONObject);
  1944. begin
  1945. WriteParserOptions(Obj,'InitParserOpts',InitialFlags.ParserOptions,PCUDefaultParserOptions);
  1946. WriteModeSwitches(Obj,'InitModeSwitches',InitialFlags.Modeswitches,PCUDefaultModeSwitches);
  1947. WriteBoolSwitches(Obj,'InitBoolSwitches',InitialFlags.BoolSwitches,PCUDefaultBoolSwitches);
  1948. WriteConverterOptions(Obj,'InitConverterOpts',InitialFlags.ConverterOptions,PCUDefaultConverterOptions);
  1949. if InitialFlags.TargetPlatform<>PCUDefaultTargetPlatform then
  1950. Obj.Add('TargetPlatform',PCUTargetPlatformNames[InitialFlags.TargetPlatform]);
  1951. if InitialFlags.TargetProcessor<>PCUDefaultTargetProcessor then
  1952. Obj.Add('TargetProcessor',PCUTargetProcessorNames[InitialFlags.TargetProcessor]);
  1953. // ToDo: write initial flags: used defines, used macros
  1954. end;
  1955. procedure TPCUWriter.WriteFinalFlags(Obj: TJSONObject);
  1956. begin
  1957. WriteParserOptions(Obj,'FinalParserOpts',Parser.Options,InitialFlags.ParserOptions);
  1958. WriteModeSwitches(Obj,'FinalModeSwitches',Scanner.CurrentModeSwitches,InitialFlags.Modeswitches);
  1959. WriteBoolSwitches(Obj,'FinalBoolSwitches',Scanner.CurrentBoolSwitches,InitialFlags.BoolSwitches);
  1960. if InitialFlags.ConverterOptions<>Converter.Options then
  1961. RaiseMsg(20180314185555,'InitialFlags='+dbgs(InitialFlags.ConverterOptions)+' Converter='+dbgs(Converter.Options));
  1962. // ToDo: write final flags: used defines, used macros
  1963. end;
  1964. procedure TPCUWriter.WriteParserOptions(Obj: TJSONObject;
  1965. const PropName: string; const Value, DefaultValue: TPOptions);
  1966. var
  1967. Arr: TJSONArray;
  1968. f: TPOption;
  1969. begin
  1970. if Value=DefaultValue then exit;
  1971. Arr:=nil;
  1972. for f in TPOptions do
  1973. if (f in Value)<>(f in DefaultValue) then
  1974. AddArrayFlag(Obj,Arr,PropName,PCUParserOptionNames[f],f in Value);
  1975. end;
  1976. procedure TPCUWriter.WriteModeSwitches(Obj: TJSONObject;
  1977. const PropName: string; const Value, DefaultValue: TModeSwitches);
  1978. var
  1979. Arr: TJSONArray;
  1980. f: TModeSwitch;
  1981. begin
  1982. if Value=DefaultValue then exit;
  1983. Arr:=nil;
  1984. for f in TModeSwitch do
  1985. if (f in Value)<>(f in DefaultValue) then
  1986. AddArrayFlag(Obj,Arr,PropName,PCUModeSwitchNames[f],f in Value);
  1987. end;
  1988. procedure TPCUWriter.WriteBoolSwitches(Obj: TJSONObject;
  1989. const PropName: string; const Value, DefaultValue: TBoolSwitches);
  1990. var
  1991. Arr: TJSONArray;
  1992. f: TBoolSwitch;
  1993. begin
  1994. if Value=DefaultValue then exit;
  1995. Arr:=nil;
  1996. for f in TBoolSwitch do
  1997. if (f in Value)<>(f in DefaultValue) then
  1998. AddArrayFlag(Obj,Arr,PropName,PCUBoolSwitchNames[f],f in Value);
  1999. end;
  2000. procedure TPCUWriter.WriteConverterOptions(Obj: TJSONObject;
  2001. const PropName: string; const Value, DefaultValue: TPasToJsConverterOptions);
  2002. var
  2003. Arr: TJSONArray;
  2004. f: TPasToJsConverterOption;
  2005. begin
  2006. if Value=DefaultValue then exit;
  2007. Arr:=nil;
  2008. for f in TPasToJsConverterOption do
  2009. if (f in Value)<>(f in DefaultValue) then
  2010. AddArrayFlag(Obj,Arr,PropName,PCUConverterOptions[f],f in Value);
  2011. end;
  2012. procedure TPCUWriter.WriteSrcFiles(Obj: TJSONObject);
  2013. var
  2014. CurFile: TPCUSourceFile;
  2015. List: TFPList;
  2016. i: Integer;
  2017. SourcesArr: TJSONArray;
  2018. Src: TJSONObject;
  2019. begin
  2020. List:=TFPList.Create;
  2021. try
  2022. // get files from scanner
  2023. for i:=0 to Scanner.Files.Count-1 do
  2024. begin
  2025. CurFile:=TPCUSourceFile.Create;
  2026. CurFile.Index:=i;
  2027. CurFile.Filename:=Scanner.Files[i];
  2028. if i=0 then
  2029. CurFile.FileType:=sftUnit
  2030. else
  2031. CurFile.FileType:=sftInclude;
  2032. FSourceFiles.Add(CurFile);
  2033. CurFile.Checksum:=GetSrcCheckSum(CurFile.Filename);
  2034. List.Add(CurFile);
  2035. end;
  2036. // create FSourceFilesSorted
  2037. List.Sort(@ComparePCUSrcFiles);
  2038. SetLength(FSourceFilesSorted,List.Count);
  2039. for i:=0 to List.Count-1 do
  2040. FSourceFilesSorted[i]:=TPCUSourceFile(List[i]);
  2041. // write
  2042. SourcesArr:=TJSONArray.Create;
  2043. Obj.Add('Sources',SourcesArr);
  2044. for i:=0 to FSourceFiles.Count-1 do
  2045. begin
  2046. CurFile:=TPCUSourceFile(FSourceFiles[i]);
  2047. Src:=TJSONObject.Create;
  2048. SourcesArr.Add(Src);
  2049. if (i=0) then
  2050. // the first file is the unit source, no need to write Kind
  2051. else if (CurFile.FileType=sftInclude) then
  2052. // the default file type is include, no need to write Kind
  2053. else
  2054. Src.Add('Type',PCUSourceFileTypeNames[CurFile.FileType]);
  2055. Src.Add('File',CurFile.Filename);
  2056. Src.Add('CheckSum',CurFile.Checksum);
  2057. end;
  2058. finally
  2059. List.Free;
  2060. end;
  2061. end;
  2062. procedure TPCUWriter.WriteMemberHints(Obj: TJSONObject; const Value,
  2063. DefaultValue: TPasMemberHints);
  2064. var
  2065. Arr: TJSONArray;
  2066. f: TPasMemberHint;
  2067. begin
  2068. Arr:=nil;
  2069. for f in TPasMemberHints do
  2070. if (f in Value)<>(f in DefaultValue) then
  2071. AddArrayFlag(Obj,Arr,'Hints',PCUMemberHintNames[f],f in Value);
  2072. end;
  2073. procedure TPCUWriter.WritePasElement(Obj: TJSONObject; El: TPasElement;
  2074. aContext: TPCUWriterContext);
  2075. var
  2076. DefHints: TPasMemberHints;
  2077. DefVisibility: TPasMemberVisibility;
  2078. Ref: TPCUFilerElementRef;
  2079. begin
  2080. {$IFDEF VerbosePCUFiler}
  2081. writeln('TPCUWriter.WritePasElement ',GetObjName(El));
  2082. {$ENDIF}
  2083. if El.Name<>'' then
  2084. Obj.Add('Name',Resolver.GetOverloadName(El));
  2085. // Id
  2086. Ref:=GetElementReference(El);
  2087. Ref.Obj:=Obj;
  2088. ResolvePendingElRefs(Ref);
  2089. WriteSrcPos(Obj,El,aContext);
  2090. DefVisibility:=GetDefaultMemberVisibility(El);
  2091. if El.Visibility<>DefVisibility then
  2092. Obj.Add('Visibility',PCUMemberVisibilityNames[El.Visibility]);
  2093. DefHints:=[];
  2094. if El.Parent<>nil then
  2095. DefHints:=El.Parent.Hints;
  2096. WriteMemberHints(Obj,El.Hints,DefHints);
  2097. if El.HintMessage<>'' then
  2098. Obj.Add('HintMessage',El.HintMessage);
  2099. // not needed El.DocComment
  2100. if aContext<>nil then ;
  2101. end;
  2102. procedure TPCUWriter.WriteModuleScopeFlags(Obj: TJSONObject; const Value,
  2103. DefaultValue: TPasModuleScopeFlags);
  2104. var
  2105. Arr: TJSONArray;
  2106. f: TPasModuleScopeFlag;
  2107. begin
  2108. Arr:=nil;
  2109. for f in TPasModuleScopeFlags do
  2110. if (f in Value)<>(f in DefaultValue) then
  2111. AddArrayFlag(Obj,Arr,'ScopeFlags',PCUModuleScopeFlagNames[f],f in Value);
  2112. end;
  2113. procedure TPCUWriter.WriteModule(Obj: TJSONObject; aModule: TPasModule;
  2114. aContext: TPCUWriterContext);
  2115. procedure WSection(Section: TPasSection; const PropName: string);
  2116. begin
  2117. if Section=nil then exit;
  2118. if Section.Parent<>aModule then
  2119. RaiseMsg(20180205153912,aModule,PropName);
  2120. aContext.Section:=Section; // set Section before calling virtual method
  2121. aContext.SectionObj:=nil;
  2122. aContext.IndirectUsesArr:=nil;
  2123. WriteSection(Obj,Section,PropName,aContext);
  2124. end;
  2125. procedure WImplBlock(Block: TPasImplBlock; const PropPrefix: string);
  2126. var
  2127. Scope: TPas2JSInitialFinalizationScope;
  2128. begin
  2129. if Block=nil then exit;
  2130. Scope:=Block.CustomData as TPas2JSInitialFinalizationScope;
  2131. if Scope.JS<>'' then
  2132. Obj.Add(PropPrefix+'JS',Scope.JS);
  2133. WriteScopeReferences(Obj,Scope.References,PropPrefix+'Refs',aContext);
  2134. end;
  2135. procedure RaisePending(Ref: TPCUFilerElementRef);
  2136. {$IF defined(VerbosePJUFiler) or defined(VerbosePCUFiler) or defined(VerboseUnitQueue)}
  2137. var
  2138. PendObj: TPCUWriterPendingElRefObj;
  2139. PendArr: TPCUWriterPendingElRefArray;
  2140. {$ENDIF}
  2141. begin
  2142. {$IF defined(VerbosePJUFiler) or defined(VerbosePCUFiler) or defined(VerboseUnitQueue)}
  2143. {AllowWriteln}
  2144. writeln('TPCUWriter.WriteModule Ref.Element=',GetElementDbgPath(Ref.Element),' Pending=',GetObjName(Ref.Pending),' ErrorEl=',GetElementDbgPath(Ref.Pending.ErrorEl));
  2145. if Ref.Pending is TPCUWriterPendingElRefObj then
  2146. begin
  2147. PendObj:=TPCUWriterPendingElRefObj(Ref.Pending);
  2148. writeln(' Obj=',PendObj.Obj<>nil,' PropName=',PendObj.PropName);
  2149. end
  2150. else if Ref.Pending is TPCUWriterPendingElRefArray then
  2151. begin
  2152. PendArr:=TPCUWriterPendingElRefArray(Ref.Pending);
  2153. writeln(' Arr=',PendArr.Arr<>nil,' Index=',PendArr.Index);
  2154. end;
  2155. {AllowWriteln-}
  2156. {$ENDIF}
  2157. RaiseMsg(20180318225558,Ref.Element,GetObjName(Ref.Pending));
  2158. end;
  2159. var
  2160. ModScope: TPas2JSModuleScope;
  2161. Node: TAVLTreeNode;
  2162. Ref: TPCUFilerElementRef;
  2163. begin
  2164. FInImplementation:=false;
  2165. WritePasElement(Obj,aModule,aContext);
  2166. if aModule.ClassType=TPasModule then
  2167. Obj.Add('Type','Unit')
  2168. else if aModule.ClassType=TPasProgram then
  2169. Obj.Add('Type','Program')
  2170. else if aModule.ClassType=TPasLibrary then
  2171. Obj.Add('Type','Library')
  2172. else
  2173. RaiseMsg(20180203163923);
  2174. // module scope
  2175. ModScope:=TPas2JSModuleScope(CheckElScope(aModule,20180206113855,TPas2JSModuleScope));
  2176. WriteModuleScope(Obj,ModScope,aContext);
  2177. // write sections
  2178. if aModule.ClassType=TPasProgram then
  2179. begin
  2180. WSection(TPasProgram(aModule).ProgramSection,'Program');
  2181. WImplBlock(aModule.InitializationSection,'begin');
  2182. end
  2183. else if aModule.ClassType=TPasLibrary then
  2184. begin
  2185. WSection(TPasLibrary(aModule).LibrarySection,'Library');
  2186. WImplBlock(aModule.InitializationSection,'begin');
  2187. end
  2188. else
  2189. begin
  2190. WSection(aModule.InterfaceSection,'Interface');
  2191. FInImplementation:=true;
  2192. WSection(aModule.ImplementationSection,'Implementation');
  2193. WImplBlock(aModule.InitializationSection,'Init');
  2194. WImplBlock(aModule.FinalizationSection,'Final');
  2195. end;
  2196. //writeln('TPCUWriter.WriteModule WriteExternalReferences of implementation ',Resolver.RootElement.Name,' aContext.Section=',GetObjName(aContext.Section));
  2197. WriteExternalReferences(aContext);
  2198. // consistency check
  2199. Node:=FElementRefs.FindLowest;
  2200. while Node<>nil do
  2201. begin
  2202. Ref:=TPCUFilerElementRef(Node.Data);
  2203. if Ref.Pending<>nil then
  2204. RaisePending(Ref);
  2205. Node:=FElementRefs.FindSuccessor(Node);
  2206. end;
  2207. end;
  2208. procedure TPCUWriter.WritePasScope(Obj: TJSONObject; Scope: TPasScope;
  2209. aContext: TPCUWriterContext);
  2210. var
  2211. DefVisibilityContext: TPasElement;
  2212. begin
  2213. if aContext=nil then ;
  2214. DefVisibilityContext:=GetDefaultPasScopeVisibilityContext(Scope);
  2215. if Scope.VisibilityContext<>DefVisibilityContext then
  2216. AddReferenceToObj(Obj,'VisibilityContext',Scope.VisibilityContext,true);
  2217. end;
  2218. procedure TPCUWriter.WriteIdentifierScope(Obj: TJSONObject;
  2219. Scope: TPasIdentifierScope; aContext: TPCUWriterContext);
  2220. var
  2221. Arr: TJSONArray;
  2222. procedure WriteItem(Item: TPasIdentifier);
  2223. var
  2224. DefKind: TPasIdentifierKind;
  2225. DefName: string;
  2226. Sub: TJSONObject;
  2227. begin
  2228. GetDefaultsPasIdentifierProps(Item.Element,DefKind,DefName);
  2229. if (Item.Kind=DefKind) and (Item.Identifier=DefName) then
  2230. begin
  2231. // add the element Id
  2232. AddReferenceToArray(Arr,Item.Element);
  2233. end
  2234. else begin
  2235. // add a json object
  2236. Sub:=TJSONObject.Create;
  2237. Arr.Add(Sub);
  2238. if Item.Kind<>DefKind then
  2239. Sub.Add('Kind',PCUIdentifierKindNames[Item.Kind]);
  2240. if Item.Identifier<>DefName then
  2241. Sub.Add('Name',Item.Identifier);
  2242. AddReferenceToObj(Sub,'El',Item.Element);
  2243. end;
  2244. end;
  2245. var
  2246. Locals: TFPList;
  2247. i, p: Integer;
  2248. Item: TPasIdentifier;
  2249. Ordered: TPasIdentifierArray;
  2250. begin
  2251. WritePasScope(Obj,Scope,aContext);
  2252. Arr:=nil;
  2253. if aContext=nil then ;
  2254. Locals:=Scope.GetLocalIdentifiers;
  2255. try
  2256. p:=0;
  2257. Ordered:=nil;
  2258. for i:=0 to Locals.Count-1 do
  2259. begin
  2260. if Arr=nil then
  2261. begin
  2262. Arr:=TJSONArray.Create;
  2263. Obj.Add('SItems',Arr);
  2264. end;
  2265. Item:=TPasIdentifier(Locals[i]);
  2266. if Item.NextSameIdentifier=nil then
  2267. WriteItem(Item)
  2268. else
  2269. begin
  2270. // write in declaration order (i.e. reverse)
  2271. p:=0;
  2272. while Item<>nil do
  2273. begin
  2274. if length(Ordered)<=p then
  2275. SetLength(Ordered,length(Ordered)+4);
  2276. Ordered[p]:=Item;
  2277. inc(p);
  2278. Item:=Item.NextSameIdentifier;
  2279. end;
  2280. while p>0 do
  2281. begin
  2282. dec(p);
  2283. WriteItem(Ordered[p]);
  2284. end;
  2285. end;
  2286. end;
  2287. finally
  2288. Locals.Free;
  2289. end;
  2290. end;
  2291. procedure TPCUWriter.WriteModuleScope(Obj: TJSONObject;
  2292. Scope: TPas2JSModuleScope; aContext: TPCUWriterContext);
  2293. var
  2294. aModule: TPasModule;
  2295. begin
  2296. aModule:=Scope.Element as TPasModule;
  2297. if Scope.FirstName<>FirstDottedIdentifier(aModule.Name) then
  2298. RaiseMsg(20180206114233,aModule);
  2299. // write not needed: Scope.FirstName
  2300. WriteModuleScopeFlags(Obj,Scope.Flags,PCUDefaultModuleScopeFlags);
  2301. WriteBoolSwitches(Obj,'BoolSwitches',Scope.BoolSwitches,aContext.BoolSwitches);
  2302. AddReferenceToObj(Obj,'AssertClass',Scope.AssertClass);
  2303. AddReferenceToObj(Obj,'AssertDefConstructor',Scope.AssertDefConstructor);
  2304. AddReferenceToObj(Obj,'AssertMsgConstructor',Scope.AssertMsgConstructor);
  2305. AddReferenceToObj(Obj,'RangeErrorClass',Scope.RangeErrorClass);
  2306. AddReferenceToObj(Obj,'RangeErrorConstructor',Scope.RangeErrorConstructor);
  2307. WritePasScope(Obj,Scope,aContext);
  2308. end;
  2309. procedure TPCUWriter.WriteSrcPos(Obj: TJSONObject; El: TPasElement;
  2310. aContext: TPCUWriterContext);
  2311. var
  2312. LastLine, LastCol, i, CurLine, CurCol: Integer;
  2313. s: String;
  2314. begin
  2315. if aContext=nil then ;
  2316. if (El.Parent=nil) or (El.Parent.SourceFilename<>El.SourceFilename) then
  2317. begin
  2318. if El.SourceFilename<>'' then
  2319. begin
  2320. i:=IndexOfSourceFile(El.SourceFilename);
  2321. if i<0 then
  2322. RaiseMsg(20180205110259,El,El.SourceFilename);
  2323. end
  2324. else
  2325. i:=-1;
  2326. Obj.Add('File',i);
  2327. end;
  2328. if El.Parent=nil then
  2329. begin
  2330. LastLine:=1;
  2331. LastCol:=1;
  2332. end
  2333. else
  2334. Resolver.UnmangleSourceLineNumber(El.Parent.SourceLinenumber,LastLine,LastCol);
  2335. Resolver.UnmangleSourceLineNumber(El.SourceLinenumber,CurLine,CurCol);
  2336. s:='';
  2337. if LastLine<>CurLine then
  2338. s:=IntToStr(CurLine);
  2339. if LastCol<>CurCol then
  2340. s:=s+','+IntToStr(CurCol);
  2341. if s<>'' then
  2342. Obj.Add('Pos',s);
  2343. // not needed: El.SourceEndLinenumber
  2344. end;
  2345. procedure TPCUWriter.WriteSection(ParentJSON: TJSONObject;
  2346. Section: TPasSection; const PropName: string; aContext: TPCUWriterContext);
  2347. var
  2348. Obj, SubObj: TJSONObject;
  2349. Scope, UsesScope: TPas2JSSectionScope;
  2350. i, j: Integer;
  2351. Arr: TJSONArray;
  2352. UsesUnit: TPasUsesUnit;
  2353. Name, InFilename: String;
  2354. Ref: TPCUFilerElementRef;
  2355. begin
  2356. if Section=nil then exit;
  2357. Obj:=TJSONObject.Create;
  2358. ParentJSON.Add(PropName,Obj);
  2359. aContext.SectionObj:=Obj;
  2360. aContext.IndirectUsesArr:=nil;
  2361. WritePasElement(Obj,Section,aContext);
  2362. Scope:=TPas2JSSectionScope(CheckElScope(Section,20180206121825,TPas2JSSectionScope));
  2363. if not Scope.Finished then
  2364. RaiseMsg(20180206130333,Section);
  2365. WriteBoolSwitches(Obj,'BoolSwitches',Scope.BoolSwitches,aContext.BoolSwitches);
  2366. aContext.BoolSwitches:=Scope.BoolSwitches;
  2367. WriteModeSwitches(Obj,'ModeSwitches',Scope.ModeSwitches,aContext.ModeSwitches);
  2368. aContext.ModeSwitches:=Scope.ModeSwitches;
  2369. if Scope.UsesScopes.Count<>length(Section.UsesClause) then
  2370. RaiseMsg(20180206122222,Section);
  2371. Arr:=nil;
  2372. for i:=0 to Scope.UsesScopes.Count-1 do
  2373. begin
  2374. UsesUnit:=Section.UsesClause[i];
  2375. UsesScope:=TPas2JSSectionScope(Scope.UsesScopes[i]);
  2376. if UsesScope.Element<>TPasModule(UsesUnit.Module).InterfaceSection then
  2377. RaiseMsg(20180206122459,Section,'usesscope '+IntToStr(i)+' UsesScope.Element='+GetObjName(UsesScope.Element)+' Module='+GetObjName(Section.UsesClause[i].Module));
  2378. if Arr=nil then
  2379. begin
  2380. Arr:=TJSONArray.Create;
  2381. Obj.Add('Uses',Arr);
  2382. end;
  2383. SubObj:=TJSONObject.Create;
  2384. Arr.Add(SubObj);
  2385. if UsesUnit.Expr<>nil then
  2386. Name:=DotExprToName(UsesUnit.Expr)
  2387. else
  2388. begin
  2389. // implicit unit, e.g. system
  2390. Name:=UsesUnit.Module.Name;
  2391. for j:=0 to Parser.ImplicitUses.Count-1 do
  2392. if CompareText(Parser.ImplicitUses[i],Name)=0 then
  2393. begin
  2394. Name:=Parser.ImplicitUses[i];
  2395. break;
  2396. end;
  2397. end;
  2398. if Name='' then
  2399. RaiseMsg(20180307091654,UsesUnit.Expr);
  2400. SubObj.Add('Name',Name);
  2401. if UsesUnit.InFilename<>nil then
  2402. begin
  2403. InFilename:=Resolver.GetUsesUnitInFilename(UsesUnit.InFilename);
  2404. if InFilename='' then
  2405. RaiseMsg(20180307094723,UsesUnit.InFilename);
  2406. SubObj.Add('In',InFilename);
  2407. end;
  2408. if CompareText(UsesUnit.Module.Name,Name)<>0 then
  2409. SubObj.Add('UnitName',UsesUnit.Module.Name);
  2410. // ref object for uses
  2411. Ref:=GetElementReference(UsesUnit);
  2412. Ref.Obj:=SubObj;
  2413. if OnIsElementUsed(Self,UsesUnit.Module) then
  2414. begin
  2415. // ref object for module
  2416. Ref:=GetElementReference(UsesUnit.Module);
  2417. if Ref.Obj=nil then
  2418. begin
  2419. Ref.Obj:=TJSONObject.Create;
  2420. SubObj.Add('Module',Ref.Obj);
  2421. end;
  2422. end;
  2423. end;
  2424. WriteIdentifierScope(Obj,Scope,aContext);
  2425. // not needed: Scope ElevatedLocals
  2426. // not needed: Scope Helpers
  2427. if (length(Scope.Helpers)>0) and not (Scope.Element is TInterfaceSection) then
  2428. RaiseMsg(20190119122007,Section);
  2429. WriteDeclarations(Obj,Section,aContext);
  2430. if Section is TInterfaceSection then
  2431. begin
  2432. if aContext.SectionObj<>Obj then
  2433. RaiseMsg(20180318112544,Section);
  2434. {$IFDEF VerbosePJUFiler}
  2435. //writeln('TPCUWriter.WriteSection WriteExternalReferences of Interface ',GetElementFullPath(Section));
  2436. {$ENDIF}
  2437. WriteExternalReferences(aContext);
  2438. end;
  2439. end;
  2440. procedure TPCUWriter.WriteDeclarations(ParentJSON: TJSONObject;
  2441. Decls: TPasDeclarations; aContext: TPCUWriterContext);
  2442. var
  2443. i: Integer;
  2444. Decl: TPasElement;
  2445. Arr: TJSONArray;
  2446. DeclObj: TJSONObject;
  2447. begin
  2448. Arr:=nil;
  2449. for i:=0 to Decls.Declarations.Count-1 do
  2450. begin
  2451. Decl:=TPasElement(Decls.Declarations[i]);
  2452. if Decl.Parent<>Decls then
  2453. RaiseMsg(20180208221915,Decl,'['+IntToStr(i)+']='+GetObjName(Decl)+': '+GetObjName(Decls)+'<>'+GetObjName(Decl.Parent));
  2454. if Arr=nil then
  2455. begin
  2456. Arr:=TJSONArray.Create;
  2457. ParentJSON.Add('Declarations',Arr);
  2458. end;
  2459. DeclObj:=TJSONObject.Create;
  2460. Arr.Add(DeclObj);
  2461. WriteElement(DeclObj,Decl,aContext);
  2462. end;
  2463. {$IFDEF VerbosePCUFiler}
  2464. writeln('TPCUWriter.WriteDeclarations END ',GetObjName(Decls));
  2465. {$ENDIF}
  2466. end;
  2467. procedure TPCUWriter.WriteElementProperty(Obj: TJSONObject;
  2468. Parent: TPasElement; const PropName: string; El: TPasElement;
  2469. aContext: TPCUWriterContext);
  2470. var
  2471. SubObj: TJSONObject;
  2472. begin
  2473. if El=nil then exit;
  2474. if (Parent<>El.Parent) then
  2475. RaiseMsg(20180208221751,El,GetObjName(Parent)+'<>'+GetObjName(El.Parent));
  2476. SubObj:=TJSONObject.Create;
  2477. Obj.Add(PropName,SubObj);
  2478. WriteElement(SubObj,El,aContext);
  2479. end;
  2480. procedure TPCUWriter.WriteElementList(Obj: TJSONObject; Parent: TPasElement;
  2481. const PropName: string; ListOfElements: TFPList; aContext: TPCUWriterContext;
  2482. ReferencesAllowed: boolean);
  2483. var
  2484. Arr: TJSONArray;
  2485. i: Integer;
  2486. SubObj: TJSONObject;
  2487. Item: TPasElement;
  2488. begin
  2489. if (ListOfElements=nil) or (ListOfElements.Count=0) then exit;
  2490. Arr:=TJSONArray.Create;
  2491. Obj.Add(PropName,Arr);
  2492. for i:=0 to ListOfElements.Count-1 do
  2493. begin
  2494. Item:=TPasElement(ListOfElements[i]);
  2495. if Item.Parent<>Parent then
  2496. begin
  2497. if not ReferencesAllowed then
  2498. RaiseMsg(20180209191444,Item,GetObjName(Parent)+'<>'+GetObjName(Item.Parent));
  2499. AddReferenceToArray(Arr,Item);
  2500. end
  2501. else
  2502. begin
  2503. SubObj:=TJSONObject.Create;
  2504. Arr.Add(SubObj);
  2505. WriteElement(SubObj,Item,aContext);
  2506. end;
  2507. end;
  2508. end;
  2509. procedure TPCUWriter.WriteElement(Obj: TJSONObject;
  2510. El: TPasElement; aContext: TPCUWriterContext);
  2511. var
  2512. C: TClass;
  2513. Kind: TPasExprKind;
  2514. begin
  2515. C:=El.ClassType;
  2516. if C=TUnaryExpr then
  2517. begin
  2518. Obj.Add('Type','Unary');
  2519. WriteUnaryExpr(Obj,TUnaryExpr(El),aContext);
  2520. end
  2521. else if C=TBinaryExpr then
  2522. begin
  2523. Obj.Add('Type','Binary');
  2524. WriteBinaryExpr(Obj,TBinaryExpr(El),aContext);
  2525. end
  2526. else if C=TPrimitiveExpr then
  2527. begin
  2528. Kind:=TPrimitiveExpr(El).Kind;
  2529. if not (Kind in [pekIdent,pekNumber,pekString]) then
  2530. RaiseMsg(20180210153604,El,PCUExprKindNames[Kind]);
  2531. Obj.Add('Type',PCUExprKindNames[Kind]);
  2532. WritePrimitiveExpr(Obj,TPrimitiveExpr(El),aContext);
  2533. end
  2534. else if C=TBoolConstExpr then
  2535. begin
  2536. if El.CustomData=nil then
  2537. begin
  2538. Obj.Add('Type',PCUBoolStr[TBoolConstExpr(El).Value]);
  2539. WritePasExpr(Obj,TBoolConstExpr(El),pekBoolConst,eopNone,aContext);
  2540. end
  2541. else
  2542. begin
  2543. Obj.Add('Type','Bool');
  2544. WriteBoolConstExpr(Obj,TBoolConstExpr(El),aContext);
  2545. end;
  2546. end
  2547. else if C=TNilExpr then
  2548. begin
  2549. Obj.Add('Type','Nil');
  2550. WritePasExpr(Obj,TNilExpr(El),pekNil,eopNone,aContext);
  2551. end
  2552. else if C=TInheritedExpr then
  2553. begin
  2554. Obj.Add('Type','Inherited');
  2555. WritePasExpr(Obj,TInheritedExpr(El),pekInherited,eopNone,aContext);
  2556. end
  2557. else if C=TSelfExpr then
  2558. begin
  2559. Obj.Add('Type','Self');
  2560. WritePasExpr(Obj,TSelfExpr(El),pekSelf,eopNone,aContext);
  2561. end
  2562. else if C=TParamsExpr then
  2563. begin
  2564. case TParamsExpr(El).Kind of
  2565. pekArrayParams: Obj.Add('Type','A[]');
  2566. pekFuncParams: Obj.Add('Type','F()');
  2567. pekSet: Obj.Add('Type','[]');
  2568. end;
  2569. WriteParamsExpr(Obj,TParamsExpr(El),aContext);
  2570. end
  2571. else if C=TRecordValues then
  2572. begin
  2573. Obj.Add('Type','RecValues');
  2574. WriteRecordValues(Obj,TRecordValues(El),aContext);
  2575. end
  2576. else if C=TArrayValues then
  2577. begin
  2578. Obj.Add('Type','ArrValues');
  2579. WriteArrayValues(Obj,TArrayValues(El),aContext);
  2580. end
  2581. else if C=TPasResString then
  2582. begin
  2583. Obj.Add('Type','ResString');
  2584. WriteResString(Obj,TPasResString(El),aContext);
  2585. end
  2586. else if C=TPasAliasType then
  2587. begin
  2588. Obj.Add('Type','Alias');
  2589. WriteAliasType(Obj,TPasAliasType(El),aContext);
  2590. end
  2591. else if C=TPasPointerType then
  2592. begin
  2593. Obj.Add('Type','Pointer');
  2594. WritePointerType(Obj,TPasPointerType(El),aContext);
  2595. end
  2596. else if C=TPasTypeAliasType then
  2597. begin
  2598. Obj.Add('Type','TypeAlias');
  2599. WriteAliasType(Obj,TPasTypeAliasType(El),aContext);
  2600. end
  2601. else if C=TPasClassOfType then
  2602. begin
  2603. Obj.Add('Type','ClassOf');
  2604. WriteAliasType(Obj,TPasClassOfType(El),aContext);
  2605. end
  2606. else if C=TPasSpecializeType then
  2607. begin
  2608. Obj.Add('Type','Specialize');
  2609. WriteSpecializeType(Obj,TPasSpecializeType(El),aContext);
  2610. end
  2611. else if C=TInlineSpecializeExpr then
  2612. begin
  2613. Obj.Add('Type','InlineSpecialize');
  2614. WriteInlineSpecializeExpr(Obj,TInlineSpecializeExpr(El),aContext);
  2615. end
  2616. else if C=TPasRangeType then
  2617. begin
  2618. Obj.Add('Type','RangeType');
  2619. WriteRangeType(Obj,TPasRangeType(El),aContext);
  2620. end
  2621. else if C=TPasArrayType then
  2622. begin
  2623. Obj.Add('Type','ArrType');
  2624. WriteArrayType(Obj,TPasArrayType(El),aContext);
  2625. end
  2626. else if C=TPasFileType then
  2627. begin
  2628. Obj.Add('Type','File');
  2629. WriteFileType(Obj,TPasFileType(El),aContext);
  2630. end
  2631. else if C=TPasEnumValue then
  2632. begin
  2633. Obj.Add('Type','EnumV');
  2634. WriteEnumValue(Obj,TPasEnumValue(El),aContext);
  2635. end
  2636. else if C=TPasEnumType then
  2637. begin
  2638. Obj.Add('Type','EnumType');
  2639. WriteEnumType(Obj,TPasEnumType(El),aContext);
  2640. end
  2641. else if C=TPasSetType then
  2642. begin
  2643. Obj.Add('Type','SetType');
  2644. WriteSetType(Obj,TPasSetType(El),aContext);
  2645. end
  2646. else if C=TPasVariant then
  2647. begin
  2648. Obj.Add('Type','RecVariant');
  2649. WriteRecordVariant(Obj,TPasVariant(El),aContext);
  2650. end
  2651. else if C=TPasRecordType then
  2652. begin
  2653. Obj.Add('Type','Record');
  2654. WriteRecordType(Obj,TPasRecordType(El),aContext);
  2655. end
  2656. else if C=TPasClassType then
  2657. begin
  2658. Obj.Add('Type',PCUObjKindNames[TPasClassType(El).ObjKind]);
  2659. WriteClassType(Obj,TPasClassType(El),aContext);
  2660. end
  2661. else if C=TPasArgument then
  2662. begin
  2663. Obj.Add('Type','Arg');
  2664. WriteArgument(Obj,TPasArgument(El),aContext);
  2665. end
  2666. else if C=TPasProcedureType then
  2667. begin
  2668. Obj.Add('Type','ProcType');
  2669. WriteProcedureType(Obj,TPasProcedureType(El),aContext);
  2670. end
  2671. else if C=TPasResultElement then
  2672. begin
  2673. Obj.Add('Type','Result');
  2674. WriteResultElement(Obj,TPasResultElement(El),aContext);
  2675. end
  2676. else if C=TPasFunctionType then
  2677. begin
  2678. Obj.Add('Type','FuncType');
  2679. WriteFunctionType(Obj,TPasFunctionType(El),aContext);
  2680. end
  2681. else if C=TPasStringType then
  2682. begin
  2683. Obj.Add('Type','StringType');
  2684. WriteStringType(Obj,TPasStringType(El),aContext);
  2685. end
  2686. else if C=TPasVariable then
  2687. begin
  2688. Obj.Add('Type','Var');
  2689. WriteVariable(Obj,TPasVariable(El),aContext);
  2690. end
  2691. else if C=TPasExportSymbol then
  2692. begin
  2693. Obj.Add('Type','Export');
  2694. WriteExportSymbol(Obj,TPasExportSymbol(El),aContext);
  2695. end
  2696. else if C=TPasConst then
  2697. begin
  2698. Obj.Add('Type','Const');
  2699. WriteConst(Obj,TPasConst(El),aContext);
  2700. end
  2701. else if C=TPasProperty then
  2702. begin
  2703. Obj.Add('Type','Property');
  2704. WriteProperty(Obj,TPasProperty(El),aContext);
  2705. end
  2706. else if C=TPasMethodResolution then
  2707. begin
  2708. Obj.Add('Type','MethodRes');
  2709. WriteMethodResolution(Obj,TPasMethodResolution(El),aContext);
  2710. end
  2711. else if C.InheritsFrom(TPasProcedure) then
  2712. begin
  2713. if C.InheritsFrom(TPasOperator) then
  2714. begin
  2715. if C=TPasOperator then
  2716. Obj.Add('Type','Operator')
  2717. else if C=TPasClassOperator then
  2718. Obj.Add('Type','ClassOperator')
  2719. else
  2720. RaiseMsg(20180210130142,El);
  2721. WriteOperator(Obj,TPasOperator(El),aContext);
  2722. exit;
  2723. end;
  2724. if C=TPasProcedure then
  2725. Obj.Add('Type','Procedure')
  2726. else if C=TPasClassProcedure then
  2727. Obj.Add('Type','ClassProcedure')
  2728. else if C=TPasFunction then
  2729. Obj.Add('Type','Function')
  2730. else if C=TPasClassFunction then
  2731. Obj.Add('Type','ClassFunction')
  2732. else if C=TPasConstructor then
  2733. Obj.Add('Type','Constructor')
  2734. else if C=TPasClassConstructor then
  2735. Obj.Add('Type','ClassConstructor')
  2736. else if C=TPasDestructor then
  2737. Obj.Add('Type','Destructor')
  2738. else if C=TPasClassDestructor then
  2739. Obj.Add('Type','Class Destructor')
  2740. else
  2741. RaiseMsg(20180210130202,El);
  2742. WriteProcedure(Obj,TPasProcedure(El),aContext);
  2743. end
  2744. else
  2745. begin
  2746. {$IFDEF VerbosePCUFiler}
  2747. writeln('TPCUWriter.WriteElement ',GetObjName(El));
  2748. {$ENDIF}
  2749. RaiseMsg(20180205154041,El,GetObjName(El));
  2750. end;
  2751. end;
  2752. procedure TPCUWriter.WriteElType(Obj: TJSONObject; El: TPasElement;
  2753. const PropName: string; aType: TPasType; aContext: TPCUWriterContext);
  2754. begin
  2755. if aType=nil then exit;
  2756. if (aType.Name='') or (aType.Parent=El) then
  2757. begin
  2758. // anonymous type
  2759. WriteElementProperty(Obj,El,PropName,aType,aContext);
  2760. end
  2761. else
  2762. begin
  2763. // reference
  2764. AddReferenceToObj(Obj,PropName,aType);
  2765. end;
  2766. end;
  2767. procedure TPCUWriter.WriteVarModifiers(Obj: TJSONObject;
  2768. const PropName: string; const Value, DefaultValue: TVariableModifiers);
  2769. var
  2770. Arr: TJSONArray;
  2771. f: TVariableModifier;
  2772. begin
  2773. if Value=DefaultValue then exit;
  2774. Arr:=nil;
  2775. for f in TVariableModifier do
  2776. if (f in Value)<>(f in DefaultValue) then
  2777. AddArrayFlag(Obj,Arr,PropName,PCUVarModifierNames[f],f in Value);
  2778. end;
  2779. procedure TPCUWriter.WriteResolvedRefFlags(Obj: TJSONObject;
  2780. const PropName: string; const Value, DefaultValue: TResolvedReferenceFlags);
  2781. var
  2782. Arr: TJSONArray;
  2783. f: TResolvedReferenceFlag;
  2784. begin
  2785. if Value=DefaultValue then exit;
  2786. Arr:=nil;
  2787. for f in TResolvedReferenceFlag do
  2788. if (f in Value)<>(f in DefaultValue) then
  2789. AddArrayFlag(Obj,Arr,PropName,PCUResolvedReferenceFlagNames[f],f in Value);
  2790. end;
  2791. procedure TPCUWriter.WriteResolvedReference(Obj: TJSONObject;
  2792. Ref: TResolvedReference; ErrorEl: TPasElement);
  2793. begin
  2794. WriteResolvedRefFlags(Obj,'RefFlags',Ref.Flags,[]);
  2795. if Ref.Access<>rraRead then
  2796. Obj.Add('RefAccess',PCUResolvedRefAccessNames[Ref.Access]);
  2797. if Ref.WithExprScope<>nil then
  2798. RaiseMsg(20180215132828,ErrorEl);
  2799. if Ref.Context<>nil then
  2800. RaiseMsg(20180215132849,ErrorEl,GetObjName(Ref.Context));
  2801. AddReferenceToObj(Obj,'RefDecl',Ref.Declaration);
  2802. end;
  2803. procedure TPCUWriter.WriteExprCustomData(Obj: TJSONObject; Expr: TPasExpr;
  2804. aContext: TPCUWriterContext);
  2805. procedure CheckNext(Data: TObject);
  2806. var
  2807. Value: TResEvalValue;
  2808. DefHasEvalValue: Boolean;
  2809. begin
  2810. DefHasEvalValue:=GetDefaultExprHasEvalValue(Expr);
  2811. //writeln('TPCUWriter.WriteExprCustomData.CheckNext Expr=',GetObjName(Expr),' Parent=',GetObjName(Expr.Parent),' Def=',DefHasEvalValue,' Data=',GetObjName(Data));
  2812. if Data=nil then
  2813. begin
  2814. if DefHasEvalValue then
  2815. Obj.Add('Eval',false);
  2816. end
  2817. else if Data is TResEvalValue then
  2818. begin
  2819. Value:=TResEvalValue(Data);
  2820. if not DefHasEvalValue then
  2821. Obj.Add('Eval',true);
  2822. // value is not stored
  2823. if Value.CustomData<>nil then
  2824. RaiseMsg(20180215143045,Expr,GetObjName(Data));
  2825. end
  2826. else
  2827. RaiseMsg(20180215143108,Expr,GetObjName(Data));
  2828. end;
  2829. var
  2830. Ref: TResolvedReference;
  2831. begin
  2832. if Expr.CustomData is TResolvedReference then
  2833. begin
  2834. Ref:=TResolvedReference(Expr.CustomData);
  2835. WriteResolvedReference(Obj,Ref,Expr);
  2836. CheckNext(Ref.CustomData);
  2837. end
  2838. else
  2839. CheckNext(Expr.CustomData);
  2840. if aContext<>nil then ;
  2841. end;
  2842. procedure TPCUWriter.WriteExpr(Obj: TJSONObject; Parent: TPasElement;
  2843. const PropName: string; Expr: TPasExpr; aContext: TPCUWriterContext);
  2844. var
  2845. SubObj: TJSONObject;
  2846. begin
  2847. if Expr=nil then exit;
  2848. if Parent<>Expr.Parent then
  2849. RaiseMsg(20180208221051,Parent,PropName+' Expr='+GetObjName(Expr)+' Parent='+GetObjName(Parent)+'<>'+GetObjName(Expr.Parent)+'=Expr.Parent');
  2850. // ToDo: write simple expressions in a compact format
  2851. SubObj:=TJSONObject.Create;
  2852. Obj.Add(PropName,SubObj);
  2853. WriteElement(SubObj,Expr,aContext);
  2854. WriteExprCustomData(SubObj,Expr,aContext);
  2855. end;
  2856. procedure TPCUWriter.WritePasExpr(Obj: TJSONObject; Expr: TPasExpr;
  2857. DefaultKind: TPasExprKind; DefaultOpCode: TExprOpCode;
  2858. aContext: TPCUWriterContext);
  2859. begin
  2860. WritePasElement(Obj,Expr,aContext);
  2861. if Expr.Kind<>DefaultKind then
  2862. Obj.Add('Kind',PCUExprKindNames[Expr.Kind]);
  2863. if Expr.OpCode<>DefaultOpCode then
  2864. Obj.Add('Op',PCUExprOpCodeNames[Expr.OpCode]);
  2865. WriteExpr(Obj,Expr,'Format1',Expr.format1,aContext);
  2866. WriteExpr(Obj,Expr,'Format2',Expr.format2,aContext);
  2867. end;
  2868. procedure TPCUWriter.WritePasExprArray(Obj: TJSONObject; Parent: TPasElement;
  2869. const PropName: string; const ExprArr: TPasExprArray;
  2870. aContext: TPCUWriterContext);
  2871. var
  2872. Arr: TJSONArray;
  2873. i: Integer;
  2874. Expr: TPasExpr;
  2875. SubObj: TJSONObject;
  2876. begin
  2877. if length(ExprArr)=0 then exit;
  2878. Arr:=TJSONArray.Create;
  2879. Obj.Add(PropName,Arr);
  2880. for i:=0 to length(ExprArr)-1 do
  2881. begin
  2882. Expr:=ExprArr[i];
  2883. if Expr.Parent<>Parent then
  2884. RaiseMsg(20180209191444,Expr,GetObjName(Parent)+'<>'+GetObjName(Expr.Parent));
  2885. SubObj:=TJSONObject.Create;
  2886. Arr.Add(SubObj);
  2887. WriteElement(SubObj,Expr,aContext);
  2888. WriteExprCustomData(SubObj,Expr,aContext);
  2889. end;
  2890. end;
  2891. procedure TPCUWriter.WriteScopeReferences(Obj: TJSONObject;
  2892. References: TPasScopeReferences; const PropName: string;
  2893. aContext: TPCUWriterContext);
  2894. var
  2895. Refs: TFPList;
  2896. Arr: TJSONArray;
  2897. i: Integer;
  2898. PSRef: TPasScopeReference;
  2899. SubObj: TJSONObject;
  2900. begin
  2901. if References=nil then exit;
  2902. Refs:=References.GetList;
  2903. try
  2904. if Refs.Count>0 then
  2905. begin
  2906. Arr:=TJSONArray.Create;
  2907. Obj.Add(PropName,Arr);
  2908. for i:=0 to Refs.Count-1 do
  2909. begin
  2910. PSRef:=TPasScopeReference(Refs[i]);
  2911. SubObj:=TJSONObject.Create;
  2912. Arr.Add(SubObj);
  2913. if PSRef.Access<>PCUDefaultPSRefAccess then
  2914. SubObj.Add('Access',PCUPSRefAccessNames[PSRef.Access]);
  2915. AddReferenceToObj(SubObj,'Id',PSRef.Element);
  2916. end;
  2917. end;
  2918. finally
  2919. Refs.Free;
  2920. end;
  2921. if aContext=nil then ;
  2922. end;
  2923. procedure TPCUWriter.WriteUnaryExpr(Obj: TJSONObject; Expr: TUnaryExpr;
  2924. aContext: TPCUWriterContext);
  2925. begin
  2926. WritePasExpr(Obj,Expr,pekUnary,eopAdd,aContext);
  2927. WriteExpr(Obj,Expr,'Operand',Expr.Operand,aContext);
  2928. end;
  2929. procedure TPCUWriter.WriteBinaryExpr(Obj: TJSONObject; Expr: TBinaryExpr;
  2930. aContext: TPCUWriterContext);
  2931. begin
  2932. WritePasExpr(Obj,Expr,pekBinary,eopAdd,aContext);
  2933. WriteExpr(Obj,Expr,'Left',Expr.left,aContext);
  2934. WriteExpr(Obj,Expr,'Right',Expr.right,aContext);
  2935. end;
  2936. procedure TPCUWriter.WritePrimitiveExpr(Obj: TJSONObject; Expr: TPrimitiveExpr;
  2937. aContext: TPCUWriterContext);
  2938. begin
  2939. WritePasExpr(Obj,Expr,Expr.Kind,eopNone,aContext);
  2940. if Expr.Value<>'' then
  2941. Obj.Add('Value',Expr.Value);
  2942. end;
  2943. procedure TPCUWriter.WriteBoolConstExpr(Obj: TJSONObject; Expr: TBoolConstExpr;
  2944. aContext: TPCUWriterContext);
  2945. begin
  2946. WritePasExpr(Obj,Expr,pekBoolConst,eopNone,aContext);
  2947. if Expr.Value then
  2948. Obj.Add('Value',true);
  2949. end;
  2950. procedure TPCUWriter.WriteParamsExpr(Obj: TJSONObject; Expr: TParamsExpr;
  2951. aContext: TPCUWriterContext);
  2952. begin
  2953. WritePasExpr(Obj,Expr,Expr.Kind,eopNone,aContext);
  2954. WriteExpr(Obj,Expr,'Value',Expr.Value,aContext);
  2955. WritePasExprArray(Obj,Expr,'Params',Expr.Params,aContext);
  2956. end;
  2957. procedure TPCUWriter.WriteRecordValues(Obj: TJSONObject; Expr: TRecordValues;
  2958. aContext: TPCUWriterContext);
  2959. var
  2960. Arr: TJSONArray;
  2961. i: Integer;
  2962. SubObj: TJSONObject;
  2963. RecValue: TRecordValuesItem;
  2964. begin
  2965. WritePasExpr(Obj,Expr,pekListOfExp,eopNone,aContext);
  2966. if length(Expr.Fields)>0 then
  2967. begin
  2968. Arr:=TJSONArray.Create;
  2969. Obj.Add('Fields',Arr);
  2970. for i:=0 to length(Expr.Fields)-1 do
  2971. begin
  2972. RecValue:=Expr.Fields[i];
  2973. SubObj:=TJSONObject.Create;
  2974. Arr.Add(SubObj);
  2975. SubObj.Add('Name',RecValue.Name);
  2976. if (RecValue.ValueExp<>nil) and (RecValue.ValueExp.Name<>'') then
  2977. RaiseMsg(20180209192240,RecValue.ValueExp);
  2978. WriteElement(SubObj,RecValue.ValueExp,aContext);
  2979. end;
  2980. end;
  2981. end;
  2982. procedure TPCUWriter.WriteArrayValues(Obj: TJSONObject; Expr: TArrayValues;
  2983. aContext: TPCUWriterContext);
  2984. begin
  2985. WritePasExpr(Obj,Expr,pekListOfExp,eopNone,aContext);
  2986. WritePasExprArray(Obj,Expr,'Values',Expr.Values,aContext);
  2987. end;
  2988. procedure TPCUWriter.WriteResString(Obj: TJSONObject; El: TPasResString;
  2989. aContext: TPCUWriterContext);
  2990. begin
  2991. WritePasElement(Obj,El,aContext);
  2992. WriteExpr(Obj,El,'Expr',El.Expr,aContext);
  2993. end;
  2994. procedure TPCUWriter.WriteAliasType(Obj: TJSONObject; El: TPasAliasType;
  2995. aContext: TPCUWriterContext);
  2996. begin
  2997. WritePasElement(Obj,El,aContext);
  2998. WriteElType(Obj,El,'Dest',El.DestType,aContext);
  2999. WriteExpr(Obj,El,'Expr',El.Expr,aContext);
  3000. end;
  3001. procedure TPCUWriter.WritePointerType(Obj: TJSONObject; El: TPasPointerType;
  3002. aContext: TPCUWriterContext);
  3003. begin
  3004. WritePasElement(Obj,El,aContext);
  3005. WriteElType(Obj,El,'Dest',El.DestType,aContext);
  3006. end;
  3007. procedure TPCUWriter.WriteSpecializeType(Obj: TJSONObject;
  3008. El: TPasSpecializeType; aContext: TPCUWriterContext);
  3009. begin
  3010. WriteAliasType(Obj,El,aContext);
  3011. WriteElementList(Obj,El,'Params',El.Params,aContext);
  3012. end;
  3013. procedure TPCUWriter.WriteInlineTypeExpr(Obj: TJSONObject; Expr: TInlineTypeExpr;
  3014. aContext: TPCUWriterContext);
  3015. begin
  3016. WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
  3017. WriteElType(Obj,Expr,'Dest',Expr.DestType,aContext);
  3018. end;
  3019. procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
  3020. Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext);
  3021. begin
  3022. WriteInlineTypeExpr(Obj,Expr,aContext);
  3023. end;
  3024. procedure TPCUWriter.WriteRangeType(Obj: TJSONObject; El: TPasRangeType;
  3025. aContext: TPCUWriterContext);
  3026. begin
  3027. WritePasElement(Obj,El,aContext);
  3028. WriteExpr(Obj,El,'Range',El.RangeExpr,aContext);
  3029. end;
  3030. procedure TPCUWriter.WriteArrayType(Obj: TJSONObject; El: TPasArrayType;
  3031. aContext: TPCUWriterContext);
  3032. begin
  3033. WritePasElement(Obj,El,aContext);
  3034. WritePasExprArray(Obj,El,'Ranges',El.Ranges,aContext);
  3035. if El.PackMode<>pmNone then
  3036. Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
  3037. WriteElType(Obj,El,'ElType',El.ElType,aContext);
  3038. end;
  3039. procedure TPCUWriter.WriteFileType(Obj: TJSONObject; El: TPasFileType;
  3040. aContext: TPCUWriterContext);
  3041. begin
  3042. WritePasElement(Obj,El,aContext);
  3043. WriteElType(Obj,El,'ElType',El.ElType,aContext);
  3044. end;
  3045. procedure TPCUWriter.WriteEnumValue(Obj: TJSONObject; El: TPasEnumValue;
  3046. aContext: TPCUWriterContext);
  3047. begin
  3048. WritePasElement(Obj,El,aContext);
  3049. WriteExpr(Obj,El,'Value',El.Value,aContext);
  3050. end;
  3051. procedure TPCUWriter.WriteEnumTypeScope(Obj: TJSONObject;
  3052. Scope: TPasEnumTypeScope; aContext: TPCUWriterContext);
  3053. begin
  3054. WriteIdentifierScope(Obj,Scope,aContext);
  3055. WriteElType(Obj,Scope.Element,'CanonicalSet',Scope.CanonicalSet,aContext);
  3056. end;
  3057. procedure TPCUWriter.WriteEnumType(Obj: TJSONObject; El: TPasEnumType;
  3058. aContext: TPCUWriterContext);
  3059. begin
  3060. WritePasElement(Obj,El,aContext);
  3061. WriteElementList(Obj,El,'Values',El.Values,aContext);
  3062. WriteEnumTypeScope(Obj,EL.CustomData as TPasEnumTypeScope,aContext);
  3063. end;
  3064. procedure TPCUWriter.WriteSetType(Obj: TJSONObject; El: TPasSetType;
  3065. aContext: TPCUWriterContext);
  3066. begin
  3067. WritePasElement(Obj,El,aContext);
  3068. WriteElType(Obj,El,'EnumType',El.EnumType,aContext);
  3069. if El.IsPacked then
  3070. Obj.Add('Packed',true);
  3071. end;
  3072. procedure TPCUWriter.WriteRecordVariant(Obj: TJSONObject; El: TPasVariant;
  3073. aContext: TPCUWriterContext);
  3074. begin
  3075. WritePasElement(Obj,El,aContext);
  3076. WriteElementList(Obj,El,'Values',El.Values,aContext);
  3077. WriteElType(Obj,El,'Members',El.Members,aContext);
  3078. end;
  3079. procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
  3080. Scope: TPasRecordScope; aContext: TPCUWriterContext);
  3081. begin
  3082. AddReferenceToObj(Obj,'DefaultProperty',Scope.DefaultProperty);
  3083. WriteIdentifierScope(Obj,Scope,aContext);
  3084. end;
  3085. procedure TPCUWriter.WriteRecordType(Obj: TJSONObject; El: TPasRecordType;
  3086. aContext: TPCUWriterContext);
  3087. begin
  3088. WritePasElement(Obj,El,aContext);
  3089. if El.PackMode<>pmNone then
  3090. Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
  3091. WriteElementList(Obj,El,'Members',El.Members,aContext);
  3092. // VariantEl: TPasElement can be TPasVariable or TPasType
  3093. if El.VariantEl is TPasType then
  3094. WriteElType(Obj,El,'VariantEl',TPasType(El.VariantEl),aContext)
  3095. else
  3096. WriteElementProperty(Obj,El,'VariantEl',El.VariantEl,aContext);
  3097. WriteElementList(Obj,El,'Variants',El.Variants,aContext);
  3098. WriteRecordTypeScope(Obj,El.CustomData as TPasRecordScope,aContext);
  3099. end;
  3100. procedure TPCUWriter.WriteClassScopeFlags(Obj: TJSONObject;
  3101. const PropName: string; const Value, DefaultValue: TPasClassScopeFlags);
  3102. var
  3103. Arr: TJSONArray;
  3104. f: TPasClassScopeFlag;
  3105. begin
  3106. if Value=DefaultValue then exit;
  3107. Arr:=nil;
  3108. for f in TPasClassScopeFlag do
  3109. if (f in Value)<>(f in DefaultValue) then
  3110. AddArrayFlag(Obj,Arr,PropName,PCUClassScopeFlagNames[f],f in Value);
  3111. end;
  3112. procedure TPCUWriter.WriteClassIntfMapProcs(Obj: TJSONObject;
  3113. Map: TPasClassIntfMap);
  3114. var
  3115. Procs: TFPList;
  3116. Arr: TJSONArray;
  3117. i: Integer;
  3118. begin
  3119. Procs:=Map.Procs;
  3120. if Procs<>nil then
  3121. begin
  3122. Arr:=TJSONArray.Create;
  3123. Obj.Add('Procs',Arr);
  3124. for i:=0 to Procs.Count-1 do
  3125. AddReferenceToArray(Arr,TPasProcedure(Procs[i]));
  3126. end;
  3127. end;
  3128. procedure TPCUWriter.WriteClassScope(Obj: TJSONObject;
  3129. Scope: TPas2JSClassScope; aContext: TPCUWriterContext);
  3130. procedure WriteMap(SubObj: TJSONObject; Map: TPasClassIntfMap);
  3131. var
  3132. AncObj: TJSONObject;
  3133. begin
  3134. if Map.Element=nil then
  3135. RaiseMsg(20180325131134,Scope.Element);
  3136. if Map.Intf=nil then
  3137. RaiseMsg(20180325131135,Scope.Element);
  3138. AddReferenceToObj(SubObj,'Intf',Map.Intf);
  3139. WriteClassIntfMapProcs(SubObj,Map);
  3140. if Map.AncestorMap<>nil then
  3141. begin
  3142. AncObj:=TJSONObject.Create;
  3143. SubObj.Add('AncestorMap',AncObj);
  3144. WriteMap(AncObj,Map.AncestorMap);
  3145. end;
  3146. end;
  3147. var
  3148. Arr: TJSONArray;
  3149. i: Integer;
  3150. aClass: TPasClassType;
  3151. CanonicalClassOf: TPasClassOfType;
  3152. ScopeIntf: TFPList;
  3153. o: TObject;
  3154. SubObj: TJSONObject;
  3155. begin
  3156. WriteIdentifierScope(Obj,Scope,aContext);
  3157. aClass:=Scope.Element as TPasClassType;
  3158. AddReferenceToObj(Obj,'NewInstanceFunction',Scope.NewInstanceFunction);
  3159. // AncestorScope can be derived from DirectAncestor
  3160. // CanonicalClassOf is autogenerated
  3161. CanonicalClassOf:=Scope.CanonicalClassOf;
  3162. if aClass.ObjKind=okClass then
  3163. begin
  3164. if CanonicalClassOf=nil then
  3165. RaiseMsg(20180217143821,aClass);
  3166. if CanonicalClassOf.Name<>'Self' then
  3167. RaiseMsg(20180217143822,aClass);
  3168. if CanonicalClassOf.DestType<>aClass then
  3169. RaiseMsg(20180217143834,aClass);
  3170. if CanonicalClassOf.Visibility<>visStrictPrivate then
  3171. RaiseMsg(20180217143844,aClass);
  3172. if CanonicalClassOf.SourceFilename<>aClass.SourceFilename then
  3173. RaiseMsg(20180217143857,aClass);
  3174. if CanonicalClassOf.SourceLinenumber<>aClass.SourceLinenumber then
  3175. RaiseMsg(20180217143905,aClass);
  3176. end
  3177. else if CanonicalClassOf<>nil then
  3178. RaiseMsg(20180329110817,aClass,GetObjName(CanonicalClassOf));
  3179. AddReferenceToObj(Obj,'DirectAncestor',Scope.DirectAncestor);
  3180. AddReferenceToObj(Obj,'DefaultProperty',Scope.DefaultProperty);
  3181. WriteClassScopeFlags(Obj,'SFlags',Scope.Flags,GetDefaultClassScopeFlags(Scope));
  3182. if length(Scope.AbstractProcs)>0 then
  3183. begin
  3184. Arr:=TJSONArray.Create;
  3185. Obj.Add('AbstractProcs',Arr);
  3186. for i:=0 to length(Scope.AbstractProcs)-1 do
  3187. AddReferenceToArray(Arr,Scope.AbstractProcs[i]);
  3188. end;
  3189. if Scope.GUID<>'' then
  3190. Obj.Add('SGUID',Scope.GUID);
  3191. ScopeIntf:=Scope.Interfaces;
  3192. if (ScopeIntf<>nil) and (ScopeIntf.Count>0) then
  3193. begin
  3194. Arr:=TJSONArray.Create;
  3195. Obj.Add('SInterfaces',Arr);
  3196. for i:=0 to ScopeIntf.Count-1 do
  3197. begin
  3198. o:=TObject(ScopeIntf[i]);
  3199. if o is TPasProperty then
  3200. begin
  3201. // delegation
  3202. AddReferenceToArray(Arr,TPasProperty(o));
  3203. end
  3204. else if o is TPasClassIntfMap then
  3205. begin
  3206. // method resolution
  3207. SubObj:=TJSONObject.Create;
  3208. Arr.Add(SubObj);
  3209. WriteMap(SubObj,TPasClassIntfMap(o));
  3210. end
  3211. else
  3212. RaiseMsg(20180325111939,aClass,IntToStr(i)+':'+GetObjName(TObject(aClass.Interfaces[i]))+' '+GetObjName(o));
  3213. end;
  3214. end;
  3215. end;
  3216. procedure TPCUWriter.WriteClassType(Obj: TJSONObject; El: TPasClassType;
  3217. aContext: TPCUWriterContext);
  3218. var
  3219. Arr: TJSONArray;
  3220. i: Integer;
  3221. Ref: TResolvedReference;
  3222. Scope: TPas2JSClassScope;
  3223. begin
  3224. WritePasElement(Obj,El,aContext);
  3225. if El.PackMode<>pmNone then
  3226. Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
  3227. // ObjKind is the 'Type'
  3228. if El.InterfaceType<>citCom then
  3229. Obj.Add('IntfType',PCUClassInterfaceTypeNames[El.InterfaceType]);
  3230. WriteElType(Obj,El,'Ancestor',El.AncestorType,aContext);
  3231. WriteElType(Obj,El,'HelperFor',El.HelperForType,aContext);
  3232. if El.IsForward then
  3233. Obj.Add('Forward',true);
  3234. if El.IsExternal then
  3235. Obj.Add('External',true);
  3236. // not needed IsShortDefinition: Boolean; -> class(anchestor); without end
  3237. WriteExpr(Obj,El,'GUID',El.GUIDExpr,aContext);
  3238. if El.Modifiers.Count>0 then
  3239. begin
  3240. Arr:=TJSONArray.Create;
  3241. Obj.Add('Modifiers',Arr);
  3242. for i:=0 to El.Modifiers.Count-1 do
  3243. Arr.Add(El.Modifiers[i]);
  3244. end;
  3245. if El.ExternalNameSpace<>'' then
  3246. Obj.Add('ExternalNameSpace',El.ExternalNameSpace);
  3247. if El.ExternalName<>'' then
  3248. Obj.Add('ExternalName',El.ExternalName);
  3249. if El.IsForward then
  3250. begin
  3251. Ref:=TResolvedReference(El.CustomData);
  3252. WriteResolvedReference(Obj,Ref,El);
  3253. end
  3254. else
  3255. begin
  3256. Scope:=El.CustomData as TPas2JSClassScope;
  3257. WriteElementList(Obj,El,'Interfaces',El.Interfaces,aContext,true);
  3258. WriteElementList(Obj,El,'Members',El.Members,aContext);
  3259. if Scope<>nil then
  3260. WriteClassScope(Obj,Scope,aContext)
  3261. else
  3262. Obj.Add('Scope',false); // msIgnoreInterfaces
  3263. end;
  3264. end;
  3265. procedure TPCUWriter.WriteArgument(Obj: TJSONObject; El: TPasArgument;
  3266. aContext: TPCUWriterContext);
  3267. begin
  3268. WritePasElement(Obj,El,aContext);
  3269. if El.Access<>argDefault then
  3270. Obj.Add('Access',PCUArgumentAccessNames[El.Access]);
  3271. if El.ArgType<>nil then
  3272. begin
  3273. if El.ArgType.Parent=El then
  3274. WriteElementProperty(Obj,El,'ArgType',El.ArgType,aContext)
  3275. else
  3276. AddReferenceToObj(Obj,'ArgType',El.ArgType);
  3277. end;
  3278. WriteExpr(Obj,El,'Value',El.ValueExpr,aContext)
  3279. end;
  3280. procedure TPCUWriter.WriteProcTypeModifiers(Obj: TJSONObject;
  3281. const PropName: string; const Value, DefaultValue: TProcTypeModifiers);
  3282. var
  3283. Arr: TJSONArray;
  3284. f: TProcTypeModifier;
  3285. begin
  3286. if Value=DefaultValue then exit;
  3287. Arr:=nil;
  3288. for f in TProcTypeModifier do
  3289. if (f in Value)<>(f in DefaultValue) then
  3290. AddArrayFlag(Obj,Arr,PropName,PCUProcTypeModifierNames[f],f in Value);
  3291. end;
  3292. procedure TPCUWriter.WriteProcedureType(Obj: TJSONObject;
  3293. El: TPasProcedureType; aContext: TPCUWriterContext);
  3294. begin
  3295. WritePasElement(Obj,El,aContext);
  3296. WriteElementList(Obj,El,'Args',El.Args,aContext);
  3297. if El.CallingConvention<>ccDefault then
  3298. Obj.Add('Call',PCUCallingConventionNames[El.CallingConvention]);
  3299. WriteProcTypeModifiers(Obj,'Modifiers',El.Modifiers,GetDefaultProcTypeModifiers(El));
  3300. end;
  3301. procedure TPCUWriter.WriteResultElement(Obj: TJSONObject;
  3302. El: TPasResultElement; aContext: TPCUWriterContext);
  3303. begin
  3304. WritePasElement(Obj,El,aContext);
  3305. WriteElType(Obj,El,'Result',El.ResultType,aContext);
  3306. end;
  3307. procedure TPCUWriter.WriteFunctionType(Obj: TJSONObject; El: TPasFunctionType;
  3308. aContext: TPCUWriterContext);
  3309. begin
  3310. WriteProcedureType(Obj,El,aContext);
  3311. WriteElementProperty(Obj,El,'Result',El.ResultEl,aContext);
  3312. end;
  3313. procedure TPCUWriter.WriteStringType(Obj: TJSONObject; El: TPasStringType;
  3314. aContext: TPCUWriterContext);
  3315. begin
  3316. WritePasElement(Obj,El,aContext);
  3317. Obj.Add('Length',El.LengthExpr);
  3318. end;
  3319. procedure TPCUWriter.WriteVariable(Obj: TJSONObject; El: TPasVariable;
  3320. aContext: TPCUWriterContext);
  3321. begin
  3322. WritePasElement(Obj,El,aContext);
  3323. if El.VarType<>nil then
  3324. begin
  3325. if El.VarType.Parent=El then
  3326. // anonymous type
  3327. WriteElementProperty(Obj,El,'VarType',El.VarType,aContext)
  3328. else
  3329. // reference
  3330. AddReferenceToObj(Obj,'VarType',El.VarType);
  3331. end;
  3332. WriteVarModifiers(Obj,'VarMods',El.VarModifiers,[]);
  3333. WriteExpr(Obj,El,'Library',El.LibraryName,aContext);
  3334. WriteExpr(Obj,El,'Export',El.ExportName,aContext);
  3335. WriteExpr(Obj,El,'Absolute',El.AbsoluteExpr,aContext);
  3336. WriteExpr(Obj,El,'Expr',El.Expr,aContext);
  3337. end;
  3338. procedure TPCUWriter.WriteExportSymbol(Obj: TJSONObject; El: TPasExportSymbol;
  3339. aContext: TPCUWriterContext);
  3340. begin
  3341. WritePasElement(Obj,El,aContext);
  3342. WriteExpr(Obj,El,'ExportName',El.ExportName,aContext);
  3343. WriteExpr(Obj,El,'ExportIndex',El.ExportIndex,aContext);
  3344. end;
  3345. procedure TPCUWriter.WriteConst(Obj: TJSONObject; El: TPasConst;
  3346. aContext: TPCUWriterContext);
  3347. begin
  3348. WriteVariable(Obj,El,aContext);
  3349. if El.IsConst<>(El.VarType=nil) then
  3350. Obj.Add('IsConst',El.IsConst);
  3351. end;
  3352. procedure TPCUWriter.WritePropertyScope(Obj: TJSONObject;
  3353. Scope: TPasPropertyScope; aContext: TPCUWriterContext);
  3354. begin
  3355. WriteIdentifierScope(Obj,Scope,aContext);
  3356. AddReferenceToObj(Obj,'AncestorProp',Scope.AncestorProp);
  3357. end;
  3358. procedure TPCUWriter.WriteProperty(Obj: TJSONObject; El: TPasProperty;
  3359. aContext: TPCUWriterContext);
  3360. var
  3361. Scope: TPasPropertyScope;
  3362. begin
  3363. Scope:=El.CustomData as TPasPropertyScope;
  3364. WriteVariable(Obj,El,aContext);
  3365. WriteExpr(Obj,El,'Index',El.IndexExpr,aContext);
  3366. WriteExpr(Obj,El,'Read',El.ReadAccessor,aContext);
  3367. WriteExpr(Obj,El,'Write',El.WriteAccessor,aContext);
  3368. WritePasExprArray(Obj,El,'Implements',El.Implements,aContext);
  3369. WriteExpr(Obj,El,'DispId',El.DispIDExpr,aContext);
  3370. WriteExpr(Obj,El,'Stored',El.StoredAccessor,aContext);
  3371. WriteExpr(Obj,El,'DefaultValue',El.DefaultExpr,aContext);
  3372. WriteElementList(Obj,El,'Args',El.Args,aContext);
  3373. //ReadAccessorName: string; // not used by resolver
  3374. //WriteAccessorName: string; // not used by resolver
  3375. //ImplementsName: string; // not used by resolver
  3376. //StoredAccessorName: string; // not used by resolver
  3377. if El.DispIDReadOnly then
  3378. Obj.Add('ReadOnly',true);
  3379. if El.isDefault then
  3380. Obj.Add('Default',true);
  3381. if El.IsNodefault then
  3382. Obj.Add('NoDefault',true);
  3383. if Scope<>nil then
  3384. WritePropertyScope(Obj,Scope,aContext)
  3385. else
  3386. Obj.Add('Scope',false); // msIgnoreInterfaces
  3387. end;
  3388. procedure TPCUWriter.WriteMethodResolution(Obj: TJSONObject;
  3389. El: TPasMethodResolution; aContext: TPCUWriterContext);
  3390. begin
  3391. WritePasElement(Obj,El,aContext);
  3392. if El.ProcClass=TPasProcedure then
  3393. Obj.Add('ProcClass','procedure')
  3394. else if El.ProcClass=TPasFunction then
  3395. // default value
  3396. else
  3397. RaiseMsg(20180329104205,El);
  3398. WriteExpr(Obj,El,'InterfaceName',El.InterfaceName,aContext);
  3399. WriteExpr(Obj,El,'InterfaceProc',El.InterfaceProc,aContext);
  3400. WriteExpr(Obj,El,'ImplementationProc',El.ImplementationProc,aContext);
  3401. end;
  3402. procedure TPCUWriter.WriteProcedureModifiers(Obj: TJSONObject;
  3403. const PropName: string; const Value, DefaultValue: TProcedureModifiers);
  3404. var
  3405. Arr: TJSONArray;
  3406. f: TProcedureModifier;
  3407. begin
  3408. if Value=DefaultValue then exit;
  3409. Arr:=nil;
  3410. for f in TProcedureModifier do
  3411. if (f in Value)<>(f in DefaultValue) then
  3412. AddArrayFlag(Obj,Arr,PropName,PCUProcedureModifierNames[f],f in Value);
  3413. end;
  3414. procedure TPCUWriter.WriteProcScopeFlags(Obj: TJSONObject;
  3415. const PropName: string; const Value, DefaultValue: TPasProcedureScopeFlags);
  3416. var
  3417. Arr: TJSONArray;
  3418. f: TPasProcedureScopeFlag;
  3419. begin
  3420. if Value=DefaultValue then exit;
  3421. Arr:=nil;
  3422. for f in TPasProcedureScopeFlag do
  3423. if (f in Value)<>(f in DefaultValue) then
  3424. AddArrayFlag(Obj,Arr,PropName,PCUProcedureScopeFlagNames[f],f in Value);
  3425. end;
  3426. procedure TPCUWriter.WriteProcedureScope(Obj: TJSONObject;
  3427. Scope: TPas2JSProcedureScope; aContext: TPCUWriterContext);
  3428. begin
  3429. // Not needed, contains only local stuff: WriteIdentifierScope(Obj,Scope,aContext);
  3430. if Scope.ResultVarName<>'' then
  3431. Obj.Add('ResultVarName',Scope.ResultVarName);
  3432. // Scope.OverloadName is stored as 'Name' and ReadProcedureScope reverts it
  3433. if Scope.DeclarationProc<>nil then
  3434. RaiseMsg(20180219135933,Scope.Element);
  3435. AddReferenceToObj(Obj,'ImplProc',Scope.ImplProc);
  3436. AddReferenceToObj(Obj,'Overridden',Scope.OverriddenProc);
  3437. // ClassOrRecordScope: TPasClassScope; auto derived
  3438. if Scope.SelfArg<>nil then
  3439. RaiseMsg(20180211180457,Scope.Element); // SelfArg only valid for method implementation
  3440. // Mode: TModeSwitch: auto derived
  3441. WriteProcScopeFlags(Obj,'SFlags',Scope.Flags,[]);
  3442. WriteBoolSwitches(Obj,'BoolSwitches',Scope.BoolSwitches,aContext.BoolSwitches);
  3443. WriteModeSwitches(Obj,'ModeSwitches',Scope.ModeSwitches,aContext.ModeSwitches);
  3444. end;
  3445. procedure TPCUWriter.WriteProcedure(Obj: TJSONObject; El: TPasProcedure;
  3446. aContext: TPCUWriterContext);
  3447. var
  3448. DefProcMods: TProcedureModifiers;
  3449. Scope: TPas2JSProcedureScope;
  3450. Arr: TJSONArray;
  3451. i: Integer;
  3452. DeclProc: TPasProcedure;
  3453. DeclScope: TPas2JsProcedureScope;
  3454. begin
  3455. WritePasElement(Obj,El,aContext);
  3456. Scope:=El.CustomData as TPas2JSProcedureScope;
  3457. //writeln('TPCUWriter.WriteProcedure ',GetObjName(El),' ',GetObjName(Scope),' ',Resolver.GetElementSourcePosStr(El));
  3458. if Scope.DeclarationProc=nil then
  3459. begin
  3460. WriteElementProperty(Obj,El,'ProcType',El.ProcType,aContext);
  3461. WriteExpr(Obj,El,'Public',El.PublicName,aContext);
  3462. // e.g. external LibraryExpr name LibrarySymbolName;
  3463. WriteExpr(Obj,El,'Lib',El.LibraryExpr,aContext);
  3464. WriteExpr(Obj,El,'LibName',El.LibrarySymbolName,aContext);
  3465. WriteExpr(Obj,El,'DispId',El.DispIDExpr,aContext);
  3466. if El.AliasName<>'' then
  3467. Obj.Add('Alias',El.AliasName);
  3468. DefProcMods:=GetDefaultProcModifiers(El);
  3469. WriteProcedureModifiers(Obj,'PMods',El.Modifiers,DefProcMods);
  3470. if (El.MessageName<>'') or (El.MessageType<>pmtNone) then
  3471. begin
  3472. Obj.Add('Message',El.MessageName);
  3473. if El.MessageType<>pmtInteger then
  3474. Obj.Add('MessageType',PCUProcedureMessageTypeNames[El.MessageType]);
  3475. end;
  3476. WriteProcedureScope(Obj,Scope,aContext);
  3477. end
  3478. else
  3479. begin
  3480. AddReferenceToObj(Obj,'DeclarationProc',Scope.DeclarationProc);
  3481. end;
  3482. if (Scope.ImplProc=nil) and (El.Body<>nil) then
  3483. begin
  3484. // Note: although the References are in the declaration scope,
  3485. // they are stored with the implementation scope, so that
  3486. // all references can be resolved immediately by the reader
  3487. DeclProc:=Scope.DeclarationProc;
  3488. if DeclProc=nil then
  3489. DeclProc:=El;
  3490. DeclScope:=NoNil(DeclProc.CustomData) as TPas2JSProcedureScope;
  3491. WriteScopeReferences(Obj,DeclScope.References,'Refs',aContext);
  3492. // precompiled body
  3493. if Scope.BodyJS<>'' then
  3494. begin
  3495. if Scope.GlobalJS<>nil then
  3496. begin
  3497. Arr:=TJSONArray.Create;
  3498. Obj.Add('Globals',Arr);
  3499. for i:=0 to Scope.GlobalJS.Count-1 do
  3500. Arr.Add(Scope.GlobalJS[i]);
  3501. end;
  3502. Obj.Add('Body',Scope.BodyJS);
  3503. Obj.Add('Empty',Scope.EmptyJS);
  3504. end;
  3505. end;
  3506. if (Scope.BodyJS<>'') and (Scope.ImplProc<>nil) then
  3507. RaiseMsg(20180228142831,El);
  3508. end;
  3509. procedure TPCUWriter.WriteOperator(Obj: TJSONObject; El: TPasOperator;
  3510. aContext: TPCUWriterContext);
  3511. begin
  3512. WriteProcedure(Obj,El,aContext);
  3513. Obj.Add('Operator',PCUOperatorTypeNames[El.OperatorType]);
  3514. if El.TokenBased then
  3515. Obj.Add('TokenBased',El.TokenBased);
  3516. end;
  3517. procedure TPCUWriter.WriteExtRefSignature(Ref: TPCUFilerElementRef;
  3518. aContext: TPCUWriterContext);
  3519. procedure WriteMemberIndex(Members: TFPList; Member: TPasElement; Obj: TJSONObject);
  3520. var
  3521. i, Index: Integer;
  3522. begin
  3523. for i:=0 to Members.Count-1 do
  3524. if TPasElement(Members[i])=Member then
  3525. begin
  3526. Index:=i;
  3527. break;
  3528. end;
  3529. if Index<0 then
  3530. RaiseMsg(20180309184111,Member);
  3531. Obj.Add('MId',Index);
  3532. end;
  3533. var
  3534. Parent, El: TPasElement;
  3535. C: TClass;
  3536. begin
  3537. //writeln('TPCUWriter.WriteExtRefSignature START ',GetObjName(Ref.Element));
  3538. if aContext=nil then ;
  3539. // write member index
  3540. El:=Ref.Element;
  3541. Parent:=El.Parent;
  3542. C:=Parent.ClassType;
  3543. if C.InheritsFrom(TPasDeclarations) then
  3544. WriteMemberIndex(TPasDeclarations(Parent).Declarations,Ref.Element,Ref.Obj)
  3545. else if (C=TPasClassType)
  3546. or (C=TPasRecordType) then
  3547. WriteMemberIndex(TPasMembersType(Parent).Members,Ref.Element,Ref.Obj)
  3548. else if C=TPasEnumType then
  3549. WriteMemberIndex(TPasEnumType(Parent).Values,Ref.Element,Ref.Obj)
  3550. else if C.InheritsFrom(TPasModule) then
  3551. begin
  3552. if Ref.Element is TInterfaceSection then
  3553. else
  3554. RaiseMsg(20180310104857,Parent,GetObjName(Ref.Element));
  3555. end
  3556. else
  3557. RaiseMsg(20180310104810,Parent,GetObjName(Ref.Element));
  3558. //writeln('TPCUWriter.WriteExtRefSignature END ',GetObjName(Ref.Element));
  3559. end;
  3560. function TPCUWriter.WriteExternalReference(El: TPasElement;
  3561. aContext: TPCUWriterContext): TPCUFilerElementRef;
  3562. var
  3563. ParentRef, Ref: TPCUFilerElementRef;
  3564. Parent: TPasElement;
  3565. Name: String;
  3566. begin
  3567. Result:=nil;
  3568. if El=nil then exit;
  3569. // check if already written
  3570. Ref:=GetElementReference(El);
  3571. if Ref.Obj<>nil then
  3572. exit(Ref);
  3573. //writeln('TPCUWriter.WriteExternalReference ',GetObjName(El));
  3574. // check that is written
  3575. Parent:=El.Parent;
  3576. ParentRef:=WriteExternalReference(Parent,aContext);
  3577. if ParentRef=nil then
  3578. if not (El is TPasModule) then
  3579. RaiseMsg(20180308174440,El,GetObjName(El));
  3580. // check name
  3581. Name:=Resolver.GetOverloadName(El);
  3582. if Name='' then
  3583. begin
  3584. Name:=GetDefaultRefName(El);
  3585. if Name='' then
  3586. RaiseMsg(20180308174850,El,GetObjName(El));
  3587. end;
  3588. // write
  3589. Ref.Obj:=TJSONObject.Create;
  3590. Ref.Obj.Add('Name',Name);
  3591. if ParentRef<>nil then
  3592. begin
  3593. Ref.ParentRef:=ParentRef;
  3594. // add to parent
  3595. if ParentRef.Elements=nil then
  3596. begin
  3597. ParentRef.Elements:=TJSONArray.Create;
  3598. ParentRef.Obj.Add('El',ParentRef.Elements);
  3599. end;
  3600. ParentRef.Elements.Add(Ref.Obj);
  3601. //writeln('TPCUWriter.WriteExternalReference ',GetObjName(El),' WriteExtRefSignature...');
  3602. WriteExtRefSignature(Ref,aContext);
  3603. end
  3604. else if (El.ClassType=TPasModule) or (El is TPasUnitModule) then
  3605. begin
  3606. // indirect used unit
  3607. if aContext.IndirectUsesArr=nil then
  3608. begin
  3609. if aContext.SectionObj=nil then
  3610. RaiseMsg(20180314154428,El);
  3611. //writeln('TPCUWriter.WriteExternalReference ',Resolver.RootElement.Name,' Section=',GetObjName(aContext.Section),' IndirectUses=',El.Name);
  3612. aContext.IndirectUsesArr:=TJSONArray.Create;
  3613. aContext.SectionObj.Add('IndirectUses',aContext.IndirectUsesArr);
  3614. end;
  3615. aContext.IndirectUsesArr.Add(Ref.Obj);
  3616. end
  3617. else
  3618. RaiseMsg(20180314153224,El);
  3619. Result:=Ref;
  3620. end;
  3621. procedure TPCUWriter.WriteExternalReferences(aContext: TPCUWriterContext);
  3622. var
  3623. Ref: TPCUFilerElementRef;
  3624. El: TPasElement;
  3625. begin
  3626. {$IFDEF VerbosePCUFiler}
  3627. writeln('TPCUWriter.WriteExternalReferences START aContext.Section=',GetObjName(aContext.Section));
  3628. {$ENDIF}
  3629. while FFirstNewExt<>nil do
  3630. begin
  3631. Ref:=FFirstNewExt;
  3632. FFirstNewExt:=Ref.NextNewExt;
  3633. if FFirstNewExt=nil then
  3634. FLastNewExt:=nil;
  3635. if Ref.Pending=nil then
  3636. continue; // not used, e.g. when a child is written, its parents are
  3637. // written too, which might still be in the queue
  3638. El:=Ref.Element;
  3639. //writeln('TPCUWriter.WriteExternalReferences ',GetObjName(El),' ',GetElementFullPath(El));
  3640. {$IF defined(VerbosePJUFiler) or defined(VerbosePCUFiler) or defined(VerboseUnitQueue)}
  3641. if El.CustomData is TResElDataBuiltInSymbol then
  3642. RaiseMsg(20180314120554,El);
  3643. if El.GetModule=Resolver.RootElement then
  3644. RaiseMsg(20180318120511,El);
  3645. {$ENDIF}
  3646. // external element
  3647. if Ref.Obj=nil then
  3648. WriteExternalReference(El,aContext);
  3649. // Ref.Id is written in ResolvePendingElRefs
  3650. ResolvePendingElRefs(Ref);
  3651. end;
  3652. {$IFDEF VerbosePCUFiler}
  3653. writeln('TPCUWriter.WriteExternalReferences END aContext.Section=',GetObjName(aContext.Section));
  3654. {$ENDIF}
  3655. end;
  3656. constructor TPCUWriter.Create;
  3657. begin
  3658. inherited Create;
  3659. end;
  3660. destructor TPCUWriter.Destroy;
  3661. begin
  3662. inherited Destroy;
  3663. end;
  3664. procedure TPCUWriter.Clear;
  3665. begin
  3666. FFirstNewExt:=nil;
  3667. FLastNewExt:=nil;
  3668. FInitialFlags:=nil;
  3669. FElementIdCounter:=0;
  3670. FSourceFilesSorted:=nil;
  3671. FInImplementation:=false;
  3672. inherited Clear;
  3673. end;
  3674. procedure TPCUWriter.WritePCU(aResolver: TPas2JSResolver;
  3675. aConverter: TPasToJSConverter; InitFlags: TPCUInitialFlags; aStream: TStream;
  3676. Compressed: boolean);
  3677. var
  3678. TargetStream: TStream;
  3679. var
  3680. aJSON: TJSONObject;
  3681. Comp: Tcompressionstream;
  3682. begin
  3683. aJSON:=WriteJSON(aResolver,aConverter,InitFlags);
  3684. TargetStream:=aStream;
  3685. try
  3686. if Compressed then
  3687. TargetStream:=TMemoryStream.Create;
  3688. {$IFDEF VerbosePCUFiler}
  3689. writeln('TPCUWriter.WritePCU create js');
  3690. {$ENDIF}
  3691. Pas2jsFiler.WriteJSON(aJSON,TargetStream,Compressed);
  3692. if Compressed then
  3693. try
  3694. {$IFDEF VerbosePCUFiler}
  3695. writeln('TPCUWriter.WritePCU zip...');
  3696. {$ENDIF}
  3697. Comp:=Tcompressionstream.create(cldefault,aStream);
  3698. try
  3699. Comp.WriteDWord(TargetStream.Size);
  3700. Comp.Write(TMemoryStream(TargetStream).Memory^,TargetStream.Size);
  3701. finally
  3702. Comp.Free;
  3703. end;
  3704. except
  3705. on E: Ecompressionerror do
  3706. RaiseMsg(20180704163113,'compression error: '+E.Message);
  3707. end;
  3708. {$IFDEF VerbosePCUFiler}
  3709. writeln('TPCUWriter.WritePCU END');
  3710. {$ENDIF}
  3711. finally
  3712. if TargetStream<>aStream then
  3713. TargetStream.Free;
  3714. aJSON.Free;
  3715. end;
  3716. end;
  3717. function TPCUWriter.WriteJSON(aResolver: TPas2JSResolver;
  3718. aConverter: TPasToJSConverter; InitFlags: TPCUInitialFlags): TJSONObject;
  3719. var
  3720. Obj, JSMod: TJSONObject;
  3721. aContext: TPCUWriterContext;
  3722. begin
  3723. Result:=nil;
  3724. FConverter:=aConverter;
  3725. FResolver:=aResolver;
  3726. FParser:=Resolver.CurrentParser;
  3727. FScanner:=FParser.Scanner;
  3728. FInitialFlags:=InitFlags;
  3729. aContext:=nil;
  3730. Obj:=TJSONObject.Create;
  3731. try
  3732. FJSON:=Obj;
  3733. {$IFDEF VerbosePCUFiler}
  3734. writeln('TPCUWriter.WriteJSON header ...');
  3735. {$ENDIF}
  3736. WriteHeaderMagic(Obj);
  3737. WriteHeaderVersion(Obj);
  3738. WriteGUID(Obj);
  3739. WriteInitialFlags(Obj);
  3740. WriteSrcFiles(Obj);
  3741. // ToDo: WriteUsedModulesPrecompiledChecksums
  3742. {$IFDEF VerbosePCUFiler}
  3743. writeln('TPCUWriter.WriteJSON module ...');
  3744. {$ENDIF}
  3745. aContext:=TPCUWriterContext.Create;
  3746. aContext.ModeSwitches:=InitialFlags.ModeSwitches;
  3747. aContext.BoolSwitches:=InitialFlags.BoolSwitches;
  3748. JSMod:=TJSONObject.Create;
  3749. Obj.Add('Module',JSMod);
  3750. WriteModule(JSMod,aResolver.RootElement,aContext);
  3751. {$IFDEF VerbosePCUFiler}
  3752. writeln('TPCUWriter.WriteJSON footer ...');
  3753. {$ENDIF}
  3754. WriteFinalFlags(Obj);
  3755. Result:=Obj;
  3756. finally
  3757. FJSON:=nil;
  3758. aContext.Free;
  3759. if Result=nil then
  3760. Obj.Free;
  3761. end;
  3762. {$IFDEF VerbosePCUFiler}
  3763. writeln('TPCUWriter.WriteJSON END');
  3764. {$ENDIF}
  3765. end;
  3766. function TPCUWriter.IndexOfSourceFile(const Filename: string): integer;
  3767. var
  3768. l, r, m, cmp: Integer;
  3769. begin
  3770. l:=0;
  3771. r:=length(FSourceFilesSorted)-1;
  3772. while l<=r do
  3773. begin
  3774. m:=(l+r) div 2;
  3775. cmp:=CompareStr(Filename,FSourceFilesSorted[m].Filename);
  3776. if cmp<0 then
  3777. r:=m-1
  3778. else if cmp>0 then
  3779. l:=m+1
  3780. else
  3781. exit(FSourceFilesSorted[m].Index);
  3782. end;
  3783. Result:=-1;
  3784. end;
  3785. { TPCUReader }
  3786. procedure TPCUReader.Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
  3787. var
  3788. El: TPasVariable absolute Data;
  3789. begin
  3790. if RefEl is TPasType then
  3791. begin
  3792. El.VarType:=TPasType(RefEl);
  3793. if RefEl.Parent<>El then
  3794. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
  3795. end
  3796. else
  3797. RaiseMsg(20180211121809,El,GetObjName(RefEl));
  3798. end;
  3799. procedure TPCUReader.Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
  3800. var
  3801. El: TPasAliasType absolute Data;
  3802. begin
  3803. if RefEl is TPasType then
  3804. begin
  3805. El.DestType:=TPasType(RefEl);
  3806. if RefEl.Parent<>El then
  3807. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasAliasType.DestType'){$ENDIF};
  3808. end
  3809. else
  3810. RaiseMsg(20180211121801,El,GetObjName(RefEl));
  3811. end;
  3812. procedure TPCUReader.Set_PointerType_DestType(RefEl: TPasElement; Data: TObject
  3813. );
  3814. var
  3815. El: TPasPointerType absolute Data;
  3816. begin
  3817. if RefEl is TPasType then
  3818. begin
  3819. El.DestType:=TPasType(RefEl);
  3820. if RefEl.Parent<>El then
  3821. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasPointerType.DestType'){$ENDIF};
  3822. end
  3823. else
  3824. RaiseMsg(20180211121757,El,GetObjName(RefEl));
  3825. end;
  3826. procedure TPCUReader.Set_InlineTypeExpr_DestType(RefEl: TPasElement;
  3827. Data: TObject);
  3828. var
  3829. El: TInlineTypeExpr absolute Data;
  3830. begin
  3831. if RefEl is TPasType then
  3832. begin
  3833. El.DestType:=TPasType(RefEl);
  3834. if RefEl.Parent<>El then
  3835. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TInlineTypeExpr.DestType'){$ENDIF};
  3836. end
  3837. else
  3838. RaiseMsg(20180211121750,El,GetObjName(RefEl));
  3839. end;
  3840. procedure TPCUReader.Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
  3841. var
  3842. El: TPasArrayType absolute Data;
  3843. begin
  3844. if RefEl is TPasType then
  3845. begin
  3846. El.ElType:=TPasType(RefEl);
  3847. if RefEl.Parent<>El then
  3848. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArrayType.ElType'){$ENDIF};
  3849. end
  3850. else
  3851. RaiseMsg(20180211121732,El,GetObjName(RefEl));
  3852. end;
  3853. procedure TPCUReader.Set_FileType_ElType(RefEl: TPasElement; Data: TObject);
  3854. var
  3855. El: TPasFileType absolute Data;
  3856. begin
  3857. if RefEl is TPasType then
  3858. begin
  3859. El.ElType:=TPasType(RefEl);
  3860. if RefEl.Parent<>El then
  3861. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasFileType.ElType'){$ENDIF};
  3862. end
  3863. else
  3864. RaiseMsg(20180211121726,El,GetObjName(RefEl));
  3865. end;
  3866. procedure TPCUReader.Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
  3867. var
  3868. El: TPasSetType absolute Data;
  3869. begin
  3870. if RefEl is TPasType then
  3871. begin
  3872. El.EnumType:=TPasType(RefEl);
  3873. if RefEl.Parent<>El then
  3874. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasSetType.EnumType'){$ENDIF};
  3875. end
  3876. else
  3877. RaiseMsg(20180211121714,El,GetObjName(RefEl));
  3878. end;
  3879. procedure TPCUReader.Set_Variant_Members(RefEl: TPasElement; Data: TObject);
  3880. var
  3881. El: TPasVariant absolute Data;
  3882. begin
  3883. if RefEl is TPasRecordType then
  3884. begin
  3885. El.Members:=TPasRecordType(RefEl);
  3886. if RefEl.Parent<>El then
  3887. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariant.Members'){$ENDIF};
  3888. end
  3889. else
  3890. RaiseMsg(20180211121657,El,GetObjName(RefEl));
  3891. end;
  3892. procedure TPCUReader.Set_RecordType_VariantEl(RefEl: TPasElement; Data: TObject
  3893. );
  3894. var
  3895. El: TPasRecordType absolute Data;
  3896. begin
  3897. if (RefEl is TPasType) or (RefEl.ClassType=TPasVariable) then
  3898. begin
  3899. El.VariantEl:=RefEl;
  3900. if RefEl.Parent<>El then
  3901. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasRecordType.VariantEl'){$ENDIF};
  3902. end
  3903. else
  3904. RaiseMsg(20180210205031,El,GetObjName(RefEl));
  3905. end;
  3906. procedure TPCUReader.Set_RecordScope_DefaultProperty(RefEl: TPasElement;
  3907. Data: TObject);
  3908. var
  3909. Scope: TPasRecordScope absolute Data;
  3910. begin
  3911. if RefEl is TPasProperty then
  3912. Scope.DefaultProperty:=TPasProperty(RefEl) // no AddRef
  3913. else
  3914. RaiseMsg(20190106213412,Scope.Element,GetObjName(RefEl));
  3915. end;
  3916. procedure TPCUReader.Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
  3917. var
  3918. El: TPasArgument absolute Data;
  3919. begin
  3920. if RefEl is TPasType then
  3921. begin
  3922. El.ArgType:=TPasType(RefEl);
  3923. if RefEl.Parent<>El then
  3924. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  3925. end
  3926. else
  3927. RaiseMsg(20180211121643,El,GetObjName(RefEl));
  3928. end;
  3929. procedure TPCUReader.Set_ClassScope_NewInstanceFunction(RefEl: TPasElement;
  3930. Data: TObject);
  3931. var
  3932. Scope: TPas2JSClassScope absolute Data;
  3933. begin
  3934. if RefEl is TPasClassFunction then
  3935. Scope.NewInstanceFunction:=TPasClassFunction(RefEl)
  3936. else
  3937. RaiseMsg(20180214114043,Scope.Element,GetObjName(RefEl));
  3938. end;
  3939. procedure TPCUReader.Set_ClassScope_DirectAncestor(RefEl: TPasElement;
  3940. Data: TObject);
  3941. var
  3942. Scope: TPas2JSClassScope absolute Data;
  3943. AncestorScope: TPas2JSClassScope;
  3944. aClassAncestor: TPasType;
  3945. begin
  3946. if not (RefEl is TPasType) then
  3947. RaiseMsg(20180214114823,Scope.Element,GetObjName(RefEl));
  3948. Scope.DirectAncestor:=TPasType(RefEl);
  3949. if Scope.DirectAncestor=nil then exit;
  3950. // set AncestorScope
  3951. aClassAncestor:=Resolver.ResolveAliasType(Scope.DirectAncestor);
  3952. if not (aClassAncestor is TPasClassType) then
  3953. RaiseMsg(20180214114322,Scope.Element,GetObjName(RefEl));
  3954. AncestorScope:=aClassAncestor.CustomData as TPas2JSClassScope;
  3955. Scope.AncestorScope:=AncestorScope;
  3956. if (AncestorScope<>nil) and (pcsfPublished in Scope.AncestorScope.Flags) then
  3957. Include(Scope.Flags,pcsfPublished);
  3958. end;
  3959. procedure TPCUReader.Set_ClassScope_DefaultProperty(RefEl: TPasElement;
  3960. Data: TObject);
  3961. var
  3962. Scope: TPas2JSClassScope absolute Data;
  3963. begin
  3964. if RefEl is TPasProperty then
  3965. Scope.DefaultProperty:=TPasProperty(RefEl) // no AddRef
  3966. else
  3967. RaiseMsg(20180214115044,Scope.Element,GetObjName(RefEl));
  3968. end;
  3969. procedure TPCUReader.Set_ClassIntfMap_Intf(RefEl: TPasElement; Data: TObject);
  3970. var
  3971. Map: TPasClassIntfMap absolute Data;
  3972. begin
  3973. if RefEl is TPasClassType then
  3974. Map.Intf:=TPasClassType(RefEl) // no AddRef
  3975. else
  3976. RaiseMsg(20180325125418,Map.Element,GetObjName(RefEl));
  3977. end;
  3978. procedure TPCUReader.Set_ClassType_AncestorType(RefEl: TPasElement;
  3979. Data: TObject);
  3980. var
  3981. El: TPasClassType absolute Data;
  3982. begin
  3983. if RefEl is TPasType then
  3984. begin
  3985. El.AncestorType:=TPasType(RefEl);
  3986. if RefEl.Parent<>El then
  3987. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasClassType.AncestorType'){$ENDIF};
  3988. end
  3989. else
  3990. RaiseMsg(20180211121632,El,GetObjName(RefEl));
  3991. end;
  3992. procedure TPCUReader.Set_ClassType_HelperForType(RefEl: TPasElement;
  3993. Data: TObject);
  3994. var
  3995. El: TPasClassType absolute Data;
  3996. begin
  3997. if RefEl is TPasType then
  3998. begin
  3999. El.HelperForType:=TPasType(RefEl);
  4000. if RefEl.Parent<>El then
  4001. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasClassType.HelperForType'){$ENDIF};
  4002. end
  4003. else
  4004. RaiseMsg(20180211121612,El,GetObjName(RefEl));
  4005. end;
  4006. procedure TPCUReader.Set_ResultElement_ResultType(RefEl: TPasElement; Data: TObject
  4007. );
  4008. var
  4009. El: TPasResultElement absolute Data;
  4010. begin
  4011. if RefEl is TPasType then
  4012. begin
  4013. El.ResultType:=TPasType(RefEl);
  4014. if RefEl.Parent<>El then
  4015. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasResultElement.ResultType'){$ENDIF};
  4016. end
  4017. else
  4018. RaiseMsg(20180211121537,El,GetObjName(RefEl));
  4019. end;
  4020. procedure TPCUReader.Set_PasScope_VisibilityContext(RefEl: TPasElement;
  4021. Data: TObject);
  4022. var
  4023. Scope: TPasScope absolute Data;
  4024. begin
  4025. Scope.VisibilityContext:=RefEl;
  4026. end;
  4027. procedure TPCUReader.Set_ModScope_AssertClass(RefEl: TPasElement; Data: TObject
  4028. );
  4029. var
  4030. Scope: TPas2JSModuleScope absolute Data;
  4031. begin
  4032. if RefEl is TPasClassType then
  4033. Scope.AssertClass:=TPasClassType(RefEl)
  4034. else
  4035. RaiseMsg(20180211121441,Scope.Element,GetObjName(RefEl));
  4036. end;
  4037. procedure TPCUReader.Set_ModScope_AssertDefConstructor(RefEl: TPasElement;
  4038. Data: TObject);
  4039. var
  4040. Scope: TPas2JSModuleScope absolute Data;
  4041. begin
  4042. if RefEl is TPasConstructor then
  4043. Scope.AssertDefConstructor:=TPasConstructor(RefEl)
  4044. else
  4045. RaiseMsg(20180211123001,Scope.Element,GetObjName(RefEl));
  4046. end;
  4047. procedure TPCUReader.Set_ModScope_AssertMsgConstructor(RefEl: TPasElement;
  4048. Data: TObject);
  4049. var
  4050. Scope: TPas2JSModuleScope absolute Data;
  4051. begin
  4052. if RefEl is TPasConstructor then
  4053. Scope.AssertMsgConstructor:=TPasConstructor(RefEl)
  4054. else
  4055. RaiseMsg(20180211123020,Scope.Element,GetObjName(RefEl));
  4056. end;
  4057. procedure TPCUReader.Set_ModScope_RangeErrorClass(RefEl: TPasElement;
  4058. Data: TObject);
  4059. var
  4060. Scope: TPas2JSModuleScope absolute Data;
  4061. begin
  4062. if RefEl is TPasClassType then
  4063. Scope.RangeErrorClass:=TPasClassType(RefEl)
  4064. else
  4065. RaiseMsg(20180211123041,Scope.Element,GetObjName(RefEl));
  4066. end;
  4067. procedure TPCUReader.Set_ModScope_RangeErrorConstructor(RefEl: TPasElement;
  4068. Data: TObject);
  4069. var
  4070. Scope: TPas2JSModuleScope absolute Data;
  4071. begin
  4072. if RefEl is TPasConstructor then
  4073. Scope.RangeErrorConstructor:=TPasConstructor(RefEl)
  4074. else
  4075. RaiseMsg(20180211123100,Scope.Element,GetObjName(RefEl));
  4076. end;
  4077. procedure TPCUReader.Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement;
  4078. Data: TObject);
  4079. var
  4080. El: TPasEnumType absolute Data;
  4081. Scope: TPasEnumTypeScope;
  4082. begin
  4083. if RefEl is TPasSetType then
  4084. begin
  4085. Scope:=El.CustomData as TPasEnumTypeScope;
  4086. Scope.CanonicalSet:=TPasSetType(RefEl);
  4087. if RefEl.Parent<>El then
  4088. RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  4089. end
  4090. else
  4091. RaiseMsg(20180316215238,Scope.Element,GetObjName(RefEl));
  4092. end;
  4093. procedure TPCUReader.Set_PropertyScope_AncestorProp(RefEl: TPasElement;
  4094. Data: TObject);
  4095. var
  4096. Scope: TPasPropertyScope absolute Data;
  4097. begin
  4098. if RefEl is TPasProperty then
  4099. Scope.AncestorProp:=TPasProperty(RefEl)
  4100. else
  4101. RaiseMsg(20180213214723,Scope.Element,GetObjName(RefEl));
  4102. end;
  4103. procedure TPCUReader.Set_ProcedureScope_ImplProc(RefEl: TPasElement;
  4104. Data: TObject);
  4105. var
  4106. Scope: TPas2JSProcedureScope absolute Data;
  4107. begin
  4108. if RefEl is TPasProcedure then
  4109. Scope.ImplProc:=TPasProcedure(RefEl) // no AddRef
  4110. else
  4111. RaiseMsg(20180219140043,Scope.Element,GetObjName(RefEl));
  4112. end;
  4113. procedure TPCUReader.Set_ProcedureScope_Overridden(RefEl: TPasElement;
  4114. Data: TObject);
  4115. var
  4116. Scope: TPas2JSProcedureScope absolute Data;
  4117. begin
  4118. if RefEl is TPasProcedure then
  4119. Scope.OverriddenProc:=TPasProcedure(RefEl) // no AddRef
  4120. else
  4121. RaiseMsg(20180213215959,Scope.Element,GetObjName(RefEl));
  4122. end;
  4123. procedure TPCUReader.Set_ResolvedReference_Declaration(RefEl: TPasElement;
  4124. Data: TObject);
  4125. var
  4126. Ref: TResolvedReference absolute Data;
  4127. begin
  4128. Ref.Declaration:=RefEl;
  4129. end;
  4130. procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
  4131. var
  4132. E: EPas2JsReadError;
  4133. begin
  4134. E:=EPas2JsReadError.Create('['+IntToStr(Id)+'] '+Msg);
  4135. E.Owner:=Self;
  4136. {$IFDEF VerbosePCUFiler}
  4137. writeln('TPCUReader.RaiseMsg ',E.Message);
  4138. {$ENDIF}
  4139. raise E;
  4140. end;
  4141. function TPCUReader.CheckJSONArray(Data: TJSONData; El: TPasElement;
  4142. const PropName: string): TJSONArray;
  4143. begin
  4144. if Data is TJSONArray then exit(TJSONArray(Data));
  4145. if Data=nil then
  4146. RaiseMsg(20180205140943,El,PropName+': nil')
  4147. else
  4148. RaiseMsg(20180205140358,El,PropName+': '+Data.ClassName);
  4149. Result:=nil;
  4150. end;
  4151. function TPCUReader.CheckJSONObject(Data: TJSONData; Id: int64): TJSONObject;
  4152. begin
  4153. if Data is TJSONObject then exit(TJSONObject(Data));
  4154. RaiseMsg(Id);
  4155. Result:=nil;
  4156. end;
  4157. function TPCUReader.CheckJSONString(Data: TJSONData; Id: int64): String;
  4158. begin
  4159. if Data is TJSONString then
  4160. exit(String(Data.AsString));
  4161. RaiseMsg(Id);
  4162. Result:='';
  4163. end;
  4164. function TPCUReader.ReadString(Obj: TJSONObject; const PropName: string; out
  4165. s: string; El: TPasElement): boolean;
  4166. var
  4167. C: TClass;
  4168. Data: TJSONData;
  4169. begin
  4170. s:='';
  4171. Data:=Obj.Find(PropName);
  4172. if Data=nil then exit(false);
  4173. C:=Data.ClassType;
  4174. if C=TJSONString then
  4175. begin
  4176. s:=String(Data.AsString);
  4177. exit(true);
  4178. end;
  4179. RaiseMsg(20180205133227,El,PropName+':'+Data.ClassName);
  4180. Result:=false;
  4181. end;
  4182. function TPCUReader.ReadInteger(Obj: TJSONObject; const PropName: string; out
  4183. i: integer; El: TPasElement): boolean;
  4184. var
  4185. C: TClass;
  4186. Data: TJSONData;
  4187. begin
  4188. i:=0;
  4189. Data:=Obj.Find(PropName);
  4190. if Data=nil then exit(false);
  4191. C:=Data.ClassType;
  4192. if C=TJSONIntegerNumber then
  4193. begin
  4194. i:=Data.AsInteger;
  4195. exit(true);
  4196. end;
  4197. RaiseMsg(20180205133132,El,PropName+':'+Data.ClassName);
  4198. Result:=false;
  4199. end;
  4200. function TPCUReader.ReadBoolean(Obj: TJSONObject; const PropName: string; out
  4201. b: boolean; El: TPasElement): boolean;
  4202. var
  4203. C: TClass;
  4204. Data: TJSONData;
  4205. begin
  4206. b:=false;
  4207. Data:=Obj.Find(PropName);
  4208. if Data=nil then exit(false);
  4209. C:=Data.ClassType;
  4210. if C=TJSONBoolean then
  4211. begin
  4212. b:=Data.AsBoolean;
  4213. exit(true);
  4214. end;
  4215. RaiseMsg(20180207183730,El,PropName+':'+Data.ClassName);
  4216. Result:=false;
  4217. end;
  4218. function TPCUReader.ReadArray(Obj: TJSONObject; const PropName: string; out
  4219. Arr: TJSONArray; El: TPasElement): boolean;
  4220. var
  4221. Data: TJSONData;
  4222. begin
  4223. Arr:=nil;
  4224. Data:=Obj.Find(PropName);
  4225. if Data=nil then exit(false);
  4226. if not (Data is TJSONArray) then
  4227. RaiseMsg(20180207144507,El,PropName+':'+Data.ClassName);
  4228. Arr:=TJSONArray(Data);
  4229. Result:=true;
  4230. end;
  4231. function TPCUReader.ReadObject(Obj: TJSONObject; const PropName: string; out
  4232. SubObj: TJSONObject; El: TPasElement): boolean;
  4233. var
  4234. Data: TJSONData;
  4235. begin
  4236. SubObj:=nil;
  4237. Data:=Obj.Find(PropName);
  4238. if Data=nil then exit(false);
  4239. if not (Data is TJSONObject) then
  4240. RaiseMsg(20180210212719,El,PropName+':'+Data.ClassName);
  4241. SubObj:=TJSONObject(Data);
  4242. Result:=true;
  4243. end;
  4244. function TPCUReader.CreateContext: TPCUReaderContext;
  4245. begin
  4246. Result:=TPCUReaderContext.Create;
  4247. Result.ModeSwitches:=InitialFlags.ModeSwitches;
  4248. Result.BoolSwitches:=InitialFlags.BoolSwitches;
  4249. end;
  4250. function TPCUReader.GetElReference(Id: integer; ErrorEl: TPasElement
  4251. ): TPCUFilerElementRef;
  4252. begin
  4253. if Id<=0 then
  4254. RaiseMsg(20180221171721,ErrorEl);
  4255. if Id>=length(FElementRefsArray) then
  4256. RaiseMsg(20180221171741,ErrorEl);
  4257. Result:=FElementRefsArray[Id];
  4258. end;
  4259. function TPCUReader.AddElReference(Id: integer; ErrorEl: TPasElement;
  4260. El: TPasElement): TPCUFilerElementRef;
  4261. var
  4262. Ref: TPCUFilerElementRef;
  4263. RefItem: TPCUFilerPendingElRef;
  4264. PendingElRef: TPCUReaderPendingElRef;
  4265. PendingElListRef: TPCUReaderPendingElListRef;
  4266. {$IF defined(VerbosePCUFiler) or defined(memcheck)}
  4267. Node: TAVLTreeNode;
  4268. {$ENDIF}
  4269. begin
  4270. if Id<=0 then
  4271. RaiseMsg(20180207151233,ErrorEl);
  4272. if Id>1000000 then
  4273. RaiseMsg(20180316090216,ErrorEl,IntToStr(Id));
  4274. if Id>=length(FElementRefsArray) then
  4275. GrowIdToRefsArray(FElementRefsArray,Id);
  4276. Ref:=FElementRefsArray[Id];
  4277. {$IFDEF VerbosePCUFiler}
  4278. writeln('TPCUReader.AddElReference Id=',Id,' El=',GetObjName(El),' ErrorEl=',GetObjName(ErrorEl),' OldRef=',GetObjName(Ref));
  4279. {$ENDIF}
  4280. if Ref=nil then
  4281. begin
  4282. // new target element
  4283. if El<>nil then
  4284. begin
  4285. Ref:=GetElementReference(El,true);
  4286. if Ref.Id=0 then
  4287. Ref.Id:=Id
  4288. else if Ref.Id<>Id then
  4289. RaiseMsg(20180207152251,ErrorEl,IntToStr(Ref.Id)+'<>'+IntToStr(Id));
  4290. end
  4291. else
  4292. begin
  4293. Ref:=TPCUFilerElementRef.Create;
  4294. Ref.Id:=Id;
  4295. end;
  4296. {$IF defined(VerbosePCUFiler) or defined(memcheck)}
  4297. if FElementRefsArray[Id]<>nil then
  4298. RaiseMsg(20180711212859,ErrorEl,IntToStr(Id)+' is not FElementRefsArray[Id]');
  4299. {$ENDIF}
  4300. FElementRefsArray[Id]:=Ref;
  4301. end;
  4302. Result:=Ref;
  4303. if El=nil then
  4304. exit
  4305. else if Ref.Element=nil then
  4306. begin
  4307. Ref.Element:=El;
  4308. {$IF defined(VerbosePCUFiler) or defined(memcheck)}
  4309. Node:=FElementRefs.FindKey(El,@CompareElWithPCUFilerElementRef);
  4310. if Node<>nil then
  4311. RaiseMsg(20180711231646,El,GetObjName(TPCUFilerElementRef(Node.Data).Element));
  4312. {$ENDIF}
  4313. FElementRefs.Add(Ref);
  4314. if Ref.Pending<>nil then
  4315. begin
  4316. // resolve pending references
  4317. while Ref.Pending<>nil do
  4318. begin
  4319. RefItem:=Ref.Pending;
  4320. if RefItem is TPCUReaderPendingElRef then
  4321. begin
  4322. PendingElRef:=TPCUReaderPendingElRef(RefItem);
  4323. PendingElRef.Setter(Ref.Element,PendingElRef.Data);
  4324. end
  4325. else if RefItem is TPCUReaderPendingElListRef then
  4326. begin
  4327. PendingElListRef:=TPCUReaderPendingElListRef(RefItem);
  4328. PendingElListRef.List[PendingElListRef.Index]:=Ref.Element;
  4329. if PendingElListRef.AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
  4330. Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(PendingElListRef.AddRef){$ENDIF};
  4331. end
  4332. else
  4333. RaiseMsg(20180207153056,ErrorEl,RefItem.ClassName);
  4334. Ref.Pending:=RefItem.Next;
  4335. RefItem.Next:=nil;
  4336. RefItem.Free;
  4337. end;
  4338. end;
  4339. end
  4340. else if El<>Ref.Element then
  4341. RaiseMsg(20180207194919,ErrorEl,'Duplicate Id='+IntToStr(Id)+' El='+GetObjName(El)+' Ref.Element='+GetObjName(Ref.Element));
  4342. end;
  4343. procedure TPCUReader.PromiseSetElReference(Id: integer;
  4344. const Setter: TOnSetElReference; Data: TObject; ErrorEl: TPasElement);
  4345. var
  4346. Ref: TPCUFilerElementRef;
  4347. PendingItem: TPCUReaderPendingElRef;
  4348. begin
  4349. Ref:=AddElReference(Id,ErrorEl,nil);
  4350. if Ref.Element<>nil then
  4351. begin
  4352. // element was already created -> execute Setter immediately
  4353. Setter(Ref.Element,Data);
  4354. end
  4355. else
  4356. begin
  4357. // element was not yet created -> store Setter
  4358. PendingItem:=TPCUReaderPendingElRef.Create;
  4359. PendingItem.Setter:=Setter;
  4360. PendingItem.Data:=Data;
  4361. PendingItem.ErrorEl:=ErrorEl;
  4362. Ref.AddPending(PendingItem);
  4363. end;
  4364. end;
  4365. procedure TPCUReader.PromiseSetElListReference(Id: integer; List: TFPList;
  4366. Index: integer; AddRef: TPCUAddRef; ErrorEl: TPasElement);
  4367. var
  4368. Ref: TPCUFilerElementRef;
  4369. PendingItem: TPCUReaderPendingElListRef;
  4370. begin
  4371. Ref:=AddElReference(Id,ErrorEl,nil);
  4372. if Ref.Element<>nil then
  4373. begin
  4374. // element was already created -> set list item immediately
  4375. List[Index]:=Ref.Element;
  4376. if AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
  4377. Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(AddRef){$ENDIF};
  4378. end
  4379. else
  4380. begin
  4381. // element was not yet created -> store
  4382. PendingItem:=TPCUReaderPendingElListRef.Create;
  4383. PendingItem.List:=List;
  4384. PendingItem.Index:=Index;
  4385. PendingItem.AddRef:=AddRef;
  4386. PendingItem.ErrorEl:=ErrorEl;
  4387. Ref.AddPending(PendingItem);
  4388. end;
  4389. end;
  4390. procedure TPCUReader.ReadHeaderMagic(Obj: TJSONObject);
  4391. begin
  4392. {$IFDEF VerbosePCUFiler}
  4393. writeln('TPCUReader.ReadHeaderMagic ',Obj.Get('FileType',''));
  4394. {$ENDIF}
  4395. if Obj.Get('FileType','')<>PCUMagic then
  4396. RaiseMsg(20180130201710,'not a PCU file');
  4397. end;
  4398. procedure TPCUReader.ReadHeaderVersion(Obj: TJSONObject);
  4399. begin
  4400. FFileVersion:=Obj.Get('Version',0);
  4401. {$IFDEF VerbosePCUFiler}
  4402. writeln('TPCUReader.ReadHeaderVersion ',FFileVersion);
  4403. {$ENDIF}
  4404. if FFileVersion<1 then
  4405. RaiseMsg(20180130201801,'invalid PCU file version');
  4406. if FFileVersion>PCUVersion then
  4407. RaiseMsg(20180130201822,'pcu file was created by a newer compiler.');
  4408. end;
  4409. procedure TPCUReader.ReadGUID(Obj: TJSONObject);
  4410. var
  4411. s: string;
  4412. begin
  4413. if ReadString(Obj,'GUID',s,nil) then
  4414. FGUID:=StringToGUID(s);
  4415. end;
  4416. procedure TPCUReader.ReadHeaderItem(const PropName: string; Data: TJSONData);
  4417. begin
  4418. RaiseMsg(20180202151706,'unknown property "'+PropName+'" '+GetObjName(Data));
  4419. end;
  4420. procedure TPCUReader.ReadArrayFlags(Data: TJSONData; El: TPasElement;
  4421. const PropName: string; out Names: TStringDynArray; out
  4422. Enable: TBooleanDynArray);
  4423. const
  4424. IdentStart = ['a'..'z','A'..'Z','_'];
  4425. var
  4426. Arr: TJSONArray;
  4427. Cnt, i: Integer;
  4428. s: String;
  4429. begin
  4430. Names:=nil;
  4431. Enable:=nil;
  4432. if Data=nil then exit;
  4433. Arr:=CheckJSONArray(Data,El,PropName);
  4434. Cnt:=Arr.Count;
  4435. if Cnt=0 then exit;
  4436. SetLength(Names,Cnt);
  4437. SetLength(Enable,Cnt);
  4438. for i:=0 to Cnt-1 do
  4439. begin
  4440. Data:=Arr[i];
  4441. if not (Data is TJSONString) then
  4442. RaiseMsg(20180202132350,El,PropName+' elements must be string');
  4443. s:=String(TJSONString(Data).AsString);
  4444. if s='' then
  4445. RaiseMsg(20180202133605,El,PropName+' elements must be string');
  4446. if s[1]='-' then
  4447. begin
  4448. Enable[i]:=false;
  4449. system.Delete(s,1,1);
  4450. end
  4451. else
  4452. Enable[i]:=true;
  4453. if not (s[1] in IdentStart) then
  4454. RaiseMsg(20180202133605,El,PropName+' elements must be identifiers');
  4455. Names[i]:=s;
  4456. end;
  4457. end;
  4458. function TPCUReader.ReadParserOptions(Obj: TJSONObject; El: TPasElement;
  4459. const PropName: string; const DefaultValue: TPOptions): TPOptions;
  4460. var
  4461. Names: TStringDynArray;
  4462. Enable: TBooleanDynArray;
  4463. s: String;
  4464. f: TPOption;
  4465. Found: Boolean;
  4466. i: Integer;
  4467. Data: TJSONData;
  4468. begin
  4469. Result:=DefaultValue;
  4470. {$IFDEF VerbosePCUFiler}
  4471. writeln('TPCUReader.ReadParserOptions START');
  4472. {$ENDIF}
  4473. Data:=Obj.Find(PropName);
  4474. if Data=nil then exit;
  4475. ReadArrayFlags(Data,El,PropName,Names,Enable);
  4476. for i:=0 to length(Names)-1 do
  4477. begin
  4478. s:=Names[i];
  4479. Found:=false;
  4480. for f in TPOption do
  4481. if s=PCUParserOptionNames[f] then
  4482. begin
  4483. if Enable[i] then
  4484. Include(Result,f)
  4485. else
  4486. Exclude(Result,f);
  4487. Found:=true;
  4488. break;
  4489. end;
  4490. if not Found then
  4491. RaiseMsg(20180202144009,El,'unknown ParserOption "'+s+'"');
  4492. end;
  4493. end;
  4494. function TPCUReader.ReadModeSwitches(Obj: TJSONObject; El: TPasElement;
  4495. const PropName: string; const DefaultValue: TModeSwitches): TModeSwitches;
  4496. var
  4497. Names: TStringDynArray;
  4498. Enable: TBooleanDynArray;
  4499. s: String;
  4500. f: TModeSwitch;
  4501. Found: Boolean;
  4502. i: Integer;
  4503. Data: TJSONData;
  4504. begin
  4505. Result:=DefaultValue;
  4506. {$IFDEF VerbosePCUFiler}
  4507. writeln('TPCUReader.ReadModeSwitches START');
  4508. {$ENDIF}
  4509. Data:=Obj.Find(PropName);
  4510. if Data=nil then exit;
  4511. ReadArrayFlags(Data,El,PropName,Names,Enable);
  4512. for i:=0 to length(Names)-1 do
  4513. begin
  4514. s:=Names[i];
  4515. Found:=false;
  4516. for f in TModeSwitch do
  4517. if s=PCUModeSwitchNames[f] then
  4518. begin
  4519. if Enable[i] then
  4520. Include(Result,f)
  4521. else
  4522. Exclude(Result,f);
  4523. Found:=true;
  4524. break;
  4525. end;
  4526. if not Found then
  4527. begin
  4528. if (FileVersion<2) and (SameText(s,'ignoreinterfaces')) then
  4529. // ignore old switch
  4530. else
  4531. RaiseMsg(20180202144054,El,'unknown ModeSwitch "'+s+'"');
  4532. end;
  4533. end;
  4534. end;
  4535. function TPCUReader.ReadBoolSwitches(Obj: TJSONObject; El: TPasElement;
  4536. const PropName: string; const DefaultValue: TBoolSwitches): TBoolSwitches;
  4537. var
  4538. Names: TStringDynArray;
  4539. Enable: TBooleanDynArray;
  4540. s: String;
  4541. f: TBoolSwitch;
  4542. i: Integer;
  4543. Found: Boolean;
  4544. Data: TJSONData;
  4545. begin
  4546. Result:=DefaultValue;
  4547. {$IFDEF VerbosePCUFiler}
  4548. writeln('TPCUReader.ReadBoolSwitches START');
  4549. {$ENDIF}
  4550. Data:=Obj.Find(PropName);
  4551. if Data=nil then exit;
  4552. ReadArrayFlags(Data,El,PropName,Names,Enable);
  4553. for i:=0 to length(Names)-1 do
  4554. begin
  4555. s:=Names[i];
  4556. Found:=false;
  4557. for f in TBoolSwitch do
  4558. if s=PCUBoolSwitchNames[f] then
  4559. begin
  4560. if Enable[i] then
  4561. Include(Result,f)
  4562. else
  4563. Exclude(Result,f);
  4564. Found:=true;
  4565. break;
  4566. end;
  4567. if not Found then
  4568. RaiseMsg(20180202144116,El,'unknown BoolSwitch "'+s+'"');
  4569. end;
  4570. end;
  4571. function TPCUReader.ReadConverterOptions(Obj: TJSONObject; El: TPasElement;
  4572. const PropName: string; const DefaultValue: TPasToJsConverterOptions
  4573. ): TPasToJsConverterOptions;
  4574. var
  4575. Names: TStringDynArray;
  4576. Enable: TBooleanDynArray;
  4577. s: String;
  4578. f: TPasToJsConverterOption;
  4579. i: Integer;
  4580. Found: Boolean;
  4581. Data: TJSONData;
  4582. begin
  4583. Result:=DefaultValue;
  4584. {$IFDEF VerbosePCUFiler}
  4585. writeln('TPCUReader.ReadConverterOptions START');
  4586. {$ENDIF}
  4587. Data:=Obj.Find(PropName);
  4588. if Data=nil then exit;
  4589. ReadArrayFlags(Data,El,PropName,Names,Enable);
  4590. for i:=0 to length(Names)-1 do
  4591. begin
  4592. s:=Names[i];
  4593. Found:=false;
  4594. for f in TPasToJsConverterOption do
  4595. if s=PCUConverterOptions[f] then
  4596. begin
  4597. if Enable[i] then
  4598. Include(Result,f)
  4599. else
  4600. Exclude(Result,f);
  4601. Found:=true;
  4602. break;
  4603. end;
  4604. if not Found then
  4605. RaiseMsg(20180202144136,'unknown ConverterOption "'+s+'"');
  4606. end;
  4607. end;
  4608. procedure TPCUReader.ReadTargetPlatform(Data: TJSONData);
  4609. var
  4610. p: TPasToJsPlatform;
  4611. s: String;
  4612. begin
  4613. {$IFDEF VerbosePCUFiler}
  4614. writeln('TPCUReader.ReadTargetPlatform START');
  4615. {$ENDIF}
  4616. s:=CheckJSONString(Data,20180203100215);
  4617. for p in TPasToJsPlatform do
  4618. if s=PCUTargetPlatformNames[p] then
  4619. begin
  4620. InitialFlags.TargetPlatform:=p;
  4621. exit;
  4622. end;
  4623. RaiseMsg(20180202145542,'invalid TargetPlatform');
  4624. end;
  4625. procedure TPCUReader.ReadTargetProcessor(Data: TJSONData);
  4626. var
  4627. p: TPasToJsProcessor;
  4628. s: String;
  4629. begin
  4630. {$IFDEF VerbosePCUFiler}
  4631. writeln('TPCUReader.ReadTargetProcessor START');
  4632. {$ENDIF}
  4633. s:=CheckJSONString(Data,20180203100235);
  4634. for p in TPasToJsProcessor do
  4635. if s=PCUTargetProcessorNames[p] then
  4636. begin
  4637. InitialFlags.TargetProcessor:=p;
  4638. exit;
  4639. end;
  4640. RaiseMsg(20180202145623,'invalid TargetProcessor');
  4641. end;
  4642. procedure TPCUReader.ReadSrcFiles(Data: TJSONData);
  4643. var
  4644. SourcesArr: TJSONArray;
  4645. i, j: Integer;
  4646. Src: TJSONObject;
  4647. CurFile: TPCUSourceFile;
  4648. Found: Boolean;
  4649. ft: TPCUSourceFileType;
  4650. s: TJSONStringType;
  4651. CurFilename, PropName: string;
  4652. begin
  4653. {$IFDEF VerbosePCUFiler}
  4654. writeln('TPCUReader.ReadSrcFiles START ');
  4655. {$ENDIF}
  4656. SourcesArr:=CheckJSONArray(Data,nil,'Sources');
  4657. for i:=0 to SourcesArr.Count-1 do
  4658. begin
  4659. Src:=CheckJSONObject(SourcesArr[i],20180203100307);
  4660. CurFile:=TPCUSourceFile.Create;
  4661. FSourceFiles.Add(CurFile);
  4662. if i=0 then
  4663. CurFile.FileType:=sftUnit
  4664. else
  4665. CurFile.FileType:=sftInclude;
  4666. for j:=0 to Src.Count-1 do
  4667. begin
  4668. PropName:=Src.Names[j];
  4669. Data:=Src.Elements[PropName];
  4670. case PropName of
  4671. 'Type':
  4672. begin
  4673. s:=CheckJSONString(Data,20180203101322);
  4674. Found:=false;
  4675. for ft in TPCUSourceFileType do
  4676. if s=PCUSourceFileTypeNames[ft] then
  4677. begin
  4678. Found:=true;
  4679. CurFile.FileType:=ft;
  4680. break;
  4681. end;
  4682. if not Found then
  4683. RaiseMsg(20180202144347,'unknown filetype "'+s+'"');
  4684. end;
  4685. 'File':
  4686. begin
  4687. CurFilename:=CheckJSONString(Data,20180203100410);
  4688. if CurFilename='' then
  4689. RaiseMsg(20180130203605);
  4690. if length(CurFilename)>MAX_PATH then
  4691. RaiseMsg(20180130203624);
  4692. DoDirSeparators(CurFilename);
  4693. if CurFilename<>ResolveDots(CurFilename) then
  4694. RaiseMsg(20180130203841);
  4695. if ExtractFilenameOnly(CurFilename)='' then
  4696. RaiseMsg(20180130203924);
  4697. CurFile.Filename:=CurFilename;
  4698. end;
  4699. 'CheckSum':
  4700. CurFile.Checksum:=Data.AsInt64;
  4701. else
  4702. RaiseMsg(20180202152628,'unknown file property "'+PropName+'"');
  4703. end;
  4704. end;
  4705. end;
  4706. end;
  4707. function TPCUReader.ReadMemberHints(Obj: TJSONObject; El: TPasElement;
  4708. const DefaultValue: TPasMemberHints): TPasMemberHints;
  4709. var
  4710. Names: TStringDynArray;
  4711. Enable: TBooleanDynArray;
  4712. s: String;
  4713. f: TPasMemberHint;
  4714. i: Integer;
  4715. Found: Boolean;
  4716. Data: TJSONData;
  4717. begin
  4718. Result:=DefaultValue;
  4719. {$IFDEF VerbosePCUFiler}
  4720. writeln('TPCUReader.ReadMemberHints START');
  4721. {$ENDIF}
  4722. Data:=Obj.Find('Hints');
  4723. if Data=nil then exit;
  4724. ReadArrayFlags(Data,El,'Hints',Names,Enable);
  4725. for i:=0 to length(Names)-1 do
  4726. begin
  4727. s:=Names[i];
  4728. Found:=false;
  4729. for f in TPasMemberHint do
  4730. if s=PCUMemberHintNames[f] then
  4731. begin
  4732. if Enable[i] then
  4733. Include(Result,f)
  4734. else
  4735. Exclude(Result,f);
  4736. Found:=true;
  4737. break;
  4738. end;
  4739. if not Found then
  4740. RaiseMsg(20180205134551,'unknown element Hints "'+s+'"');
  4741. end;
  4742. end;
  4743. procedure TPCUReader.ReadSrcPos(Obj: TJSONObject; El: TPasElement;
  4744. aContext: TPCUReaderContext);
  4745. var
  4746. i, LastLine, LastCol: integer;
  4747. s: string;
  4748. CurLine, CurCol: LongInt;
  4749. p: SizeInt;
  4750. begin
  4751. if aContext=nil then ;
  4752. if ReadInteger(Obj,'File',i,El) then
  4753. begin
  4754. if i>=0 then
  4755. El.SourceFilename:=SourceFiles[i].Filename
  4756. else
  4757. El.SourceFilename:='';
  4758. end
  4759. else if El.Parent<>nil then
  4760. El.SourceFilename:=El.Parent.SourceFilename
  4761. else
  4762. El.SourceFilename:='';
  4763. if El.Parent<>nil then
  4764. Resolver.UnmangleSourceLineNumber(El.Parent.SourceLinenumber,LastLine,LastCol)
  4765. else
  4766. begin
  4767. LastLine:=1;
  4768. LastCol:=1;
  4769. end;
  4770. if ReadString(Obj,'Pos',s,El) then
  4771. begin
  4772. p:=Pos(',',s);
  4773. if p>0 then
  4774. begin
  4775. CurLine:=StrToIntDef(LeftStr(s,p-1),LastLine);
  4776. CurCol:=StrToIntDef(copy(s,p+1,length(s)),LastCol);
  4777. end
  4778. else
  4779. begin
  4780. CurLine:=StrToIntDef(s,LastLine);
  4781. CurCol:=LastCol;
  4782. end;
  4783. El.SourceLinenumber:=Resolver.MangleSourceLineNumber(CurLine,CurCol);
  4784. end
  4785. else
  4786. El.SourceLinenumber:=Resolver.MangleSourceLineNumber(LastLine,LastCol);
  4787. end;
  4788. procedure TPCUReader.ReadPasElement(Obj: TJSONObject; El: TPasElement;
  4789. aContext: TPCUReaderContext);
  4790. function StrToMemberVisibility(const s: string): TPasMemberVisibility;
  4791. var
  4792. vis: TPasMemberVisibility;
  4793. begin
  4794. for vis in TPasMemberVisibility do
  4795. if PCUMemberVisibilityNames[vis]=s then
  4796. exit(vis);
  4797. RaiseMsg(20180205134334,El,s);
  4798. end;
  4799. var
  4800. Id: integer;
  4801. s: string;
  4802. DefHints: TPasMemberHints;
  4803. begin
  4804. if ReadInteger(Obj,'Id',Id,El) then
  4805. AddElReference(Id,El,El);
  4806. ReadSrcPos(Obj,El,aContext);
  4807. if ReadString(Obj,'Visibility',s,El) then
  4808. El.Visibility:=StrToMemberVisibility(s)
  4809. else
  4810. El.Visibility:=GetDefaultMemberVisibility(El);
  4811. DefHints:=[];
  4812. if El.Parent<>nil then
  4813. DefHints:=El.Parent.Hints;
  4814. El.Hints:=ReadMemberHints(Obj,El,DefHints);
  4815. if ReadString(Obj,'HintMessage',s,El) then
  4816. El.HintMessage:=s;
  4817. if aContext<>nil then ;
  4818. end;
  4819. procedure TPCUReader.ReadExternalMembers(El: TPasElement; Arr: TJSONArray;
  4820. Members: TFPList);
  4821. var
  4822. i, Index: Integer;
  4823. Data: TJSONData;
  4824. SubObj: TJSONObject;
  4825. Name: string;
  4826. ChildEl: TPasElement;
  4827. begin
  4828. for i:=0 to Arr.Count-1 do
  4829. begin
  4830. Data:=Arr[i];
  4831. if not (Data is TJSONObject) then
  4832. RaiseMsg(20180309173351,El);
  4833. SubObj:=TJSONObject(Data);
  4834. // search element
  4835. if not ReadString(SubObj,'Name',Name,El) then
  4836. RaiseMsg(20180309180233,El,IntToStr(i));
  4837. if not ReadInteger(SubObj,'MId',Index,El) then
  4838. RaiseMsg(20180309184629,El,IntToStr(i));
  4839. if (Index<0) or (Index>=Members.Count) then
  4840. RaiseMsg(20180309184718,El,IntToStr(Index)+' out of bounds 0-'+IntToStr(Members.Count));
  4841. ChildEl:=TPasElement(Members[Index]);
  4842. if Resolver.GetOverloadName(ChildEl)<>Name then
  4843. RaiseMsg(20180309200800,El,'Expected="'+Name+'", but found "'+Resolver.GetOverloadName(ChildEl)+'" ('+ChildEl.Name+')');
  4844. // read child declarations
  4845. ReadExternalReferences(SubObj,ChildEl);
  4846. end;
  4847. end;
  4848. procedure TPCUReader.ReadExternalReferences(Obj: TJSONObject; El: TPasElement);
  4849. var
  4850. Arr: TJSONArray;
  4851. Id: Integer;
  4852. Data: TJSONData;
  4853. SubObj: TJSONObject;
  4854. Intf: TInterfaceSection;
  4855. Name: string;
  4856. Ref: TPCUFilerElementRef;
  4857. begin
  4858. {$IFDEF VerbosePCUFiler}
  4859. writeln('TPCUReader.ReadExtRefs ',GetObjName(El));
  4860. {$ENDIF}
  4861. if ReadInteger(Obj,'Id',Id,El) then
  4862. begin
  4863. Ref:=AddElReference(Id,El,El);
  4864. Ref.Obj:=Obj;
  4865. end;
  4866. if ReadArray(Obj,'El',Arr,El) then
  4867. begin
  4868. if El is TPasDeclarations then
  4869. ReadExternalMembers(El,Arr,TPasDeclarations(El).Declarations)
  4870. else if El is TPasMembersType then
  4871. ReadExternalMembers(El,Arr,TPasMembersType(El).Members)
  4872. else if El is TPasEnumType then
  4873. ReadExternalMembers(El,Arr,TPasEnumType(El).Values)
  4874. else if El is TPasModule then
  4875. begin
  4876. // a Module has only the Interface as child
  4877. if Arr.Count<>1 then
  4878. RaiseMsg(20180309180715,El,IntToStr(Arr.Count));
  4879. Data:=Arr[0];
  4880. if not (Data is TJSONObject) then
  4881. RaiseMsg(20180309180745,El);
  4882. SubObj:=TJSONObject(Data);
  4883. if not ReadString(SubObj,'Name',Name,El) then
  4884. RaiseMsg(20180309180749,El);
  4885. if Name<>'Interface' then
  4886. RaiseMsg(20180309180806,El);
  4887. Intf:=TPasModule(El).InterfaceSection;
  4888. if Intf=nil then
  4889. RaiseMsg(20180309180856,El);
  4890. ReadExternalReferences(SubObj,Intf);
  4891. end
  4892. else
  4893. RaiseMsg(20180309180610,El);
  4894. end;
  4895. end;
  4896. procedure TPCUReader.ReadUsedUnitsInit(Obj: TJSONObject; Section: TPasSection;
  4897. aContext: TPCUReaderContext);
  4898. // Note: can be called twice for each section if there are pending used interfaces
  4899. var
  4900. Arr: TJSONArray;
  4901. i, Id: Integer;
  4902. Data: TJSONData;
  4903. UsesObj: TJSONObject;
  4904. Name, InFilename, ModuleName: string;
  4905. Use: TPasUsesUnit;
  4906. Module: TPasModule;
  4907. begin
  4908. // fetch used units
  4909. if ReadArray(Obj,'Uses',Arr,Section) then
  4910. begin
  4911. SetLength(Section.UsesClause,Arr.Count);
  4912. for i:=0 to length(Section.UsesClause)-1 do
  4913. Section.UsesClause[i]:=nil;
  4914. for i:=0 to Arr.Count-1 do
  4915. begin
  4916. Data:=Arr[i];
  4917. if not (Data is TJSONObject) then
  4918. RaiseMsg(20180307103518,Section,GetObjName(Data));
  4919. UsesObj:=TJSONObject(Data);
  4920. if not ReadString(UsesObj,'Name',Name,Section) then
  4921. RaiseMsg(20180307103629,Section);
  4922. if not IsValidIdent(Name,true,true) then
  4923. RaiseMsg(20180307103937,Section,Name);
  4924. ReadString(UsesObj,'In',InFilename,Section);
  4925. ReadString(UsesObj,'UnitName',ModuleName,Section);
  4926. {$IFDEF VerbosePCUFiler}
  4927. writeln('TPCUReader.ReadUsedUnits ',i,' Name="',Name,'" In="',InFilename,'" ModuleName="',ModuleName,'"');
  4928. {$ENDIF}
  4929. Use:=TPasUsesUnit(CreateElement(TPasUsesUnit,Name,Section));
  4930. Section.UsesClause[i]:=Use;
  4931. // Use.Expr is not needed
  4932. if InFilename<>'' then
  4933. begin
  4934. Use.InFilename:=TPrimitiveExpr(CreateElement(TPrimitiveExpr,'',Use));
  4935. Use.InFilename.Kind:=pekString;
  4936. Use.InFilename.Value:=InFilename;
  4937. end;
  4938. if ModuleName='' then ModuleName:=Name;
  4939. Module:=Resolver.FindModule(Name,Use.Expr,Use.InFilename);
  4940. if Module=nil then
  4941. RaiseMsg(20180307231247,Use);
  4942. Use.Module:=Module;
  4943. Module.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF};
  4944. if ReadInteger(UsesObj,'Id',Id,Use) then
  4945. AddElReference(Id,Use,Use);
  4946. end;
  4947. Resolver.CheckPendingUsedInterface(Section);
  4948. end;
  4949. if aContext=nil then ;
  4950. end;
  4951. procedure TPCUReader.ReadUsedUnitsFinish(Obj: TJSONObject;
  4952. Section: TPasSection; aContext: TPCUReaderContext);
  4953. var
  4954. Arr: TJSONArray;
  4955. Scope, UsedScope: TPas2JSSectionScope;
  4956. i: Integer;
  4957. Use: TPasUsesUnit;
  4958. Module: TPasModule;
  4959. Data: TJSONData;
  4960. UsesObj, ModuleObj: TJSONObject;
  4961. Name: string;
  4962. begin
  4963. Scope:=Section.CustomData as TPas2JSSectionScope;
  4964. // read external refs from used units
  4965. if ReadArray(Obj,'Uses',Arr,Section) then
  4966. begin
  4967. Scope:=Section.CustomData as TPas2JSSectionScope;
  4968. if Scope.UsesFinished then
  4969. RaiseMsg(20180313133931,Section);
  4970. if Section.PendingUsedIntf<>nil then
  4971. RaiseMsg(20180313134142,Section,GetObjName(Section.PendingUsedIntf));
  4972. if Arr.Count<>length(Section.UsesClause) then
  4973. RaiseMsg(20180313134338,IntToStr(Arr.Count)+'<>'+IntToStr(length(Section.UsesClause)));
  4974. for i:=0 to Arr.Count-1 do
  4975. begin
  4976. Data:=Arr[i];
  4977. if not (Data is TJSONObject) then
  4978. RaiseMsg(20180313134409,Section,GetObjName(Data));
  4979. UsesObj:=TJSONObject(Data);
  4980. Use:=Section.UsesClause[i];
  4981. Module:=Use.Module as TPasModule;
  4982. UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope;
  4983. Scope.UsesScopes.Add(UsedScope);
  4984. if ReadObject(UsesObj,'Module',ModuleObj,Use) then
  4985. ReadExternalReferences(ModuleObj,Module);
  4986. end;
  4987. end;
  4988. // read external refs from indirectly used units
  4989. if ReadArray(Obj,'IndirectUses',Arr,Section) then
  4990. begin
  4991. for i:=0 to Arr.Count-1 do
  4992. begin
  4993. Data:=Arr[i];
  4994. if not (Data is TJSONObject) then
  4995. RaiseMsg(20180314155716,Section,GetObjName(Data));
  4996. UsesObj:=TJSONObject(Data);
  4997. if not ReadString(UsesObj,'Name',Name,Section) then
  4998. RaiseMsg(20180314155756,Section);
  4999. if not IsValidIdent(Name,true,true) then
  5000. RaiseMsg(20180314155800,Section,Name);
  5001. Module:=Resolver.FindModule(Name,nil,nil);
  5002. if Module=nil then
  5003. RaiseMsg(20180314155840,Section,Name);
  5004. if Module.InterfaceSection=nil then
  5005. RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"');
  5006. UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope;
  5007. if not UsedScope.Finished then
  5008. RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"');
  5009. ReadExternalReferences(UsesObj,Module);
  5010. end;
  5011. end;
  5012. Scope.UsesFinished:=true;
  5013. if aContext=nil then ;
  5014. end;
  5015. procedure TPCUReader.ReadSectionScope(Obj: TJSONObject;
  5016. Scope: TPas2JSSectionScope; aContext: TPCUReaderContext);
  5017. begin
  5018. ReadIdentifierScope(Obj,Scope,aContext);
  5019. // not needed: Scope ElevatedLocals
  5020. // not needed: Scope Helpers, autogenerated in ReadClassType
  5021. Scope.BoolSwitches:=ReadBoolSwitches(Obj,Scope.Element,'BoolSwitches',aContext.BoolSwitches);
  5022. Scope.ModeSwitches:=ReadModeSwitches(Obj,Scope.Element,'ModeSwitches',aContext.ModeSwitches);
  5023. end;
  5024. procedure TPCUReader.ReadSection(Obj: TJSONObject; Section: TPasSection;
  5025. aContext: TPCUReaderContext);
  5026. // Note: can be called twice for each section if there are pending used interfaces
  5027. var
  5028. Scope: TPas2JSSectionScope;
  5029. begin
  5030. {$IFDEF VerbosePCUFiler}
  5031. writeln('TPCUReader.ReadSection ',GetObjName(Section));
  5032. {$ENDIF}
  5033. if Section.CustomData=nil then
  5034. begin
  5035. ReadPasElement(Obj,Section,aContext);
  5036. Scope:=TPas2JSSectionScope(Resolver.CreateScope(Section,TPas2JSSectionScope));
  5037. ReadUsedUnitsInit(Obj,Section,aContext);
  5038. if Section.PendingUsedIntf<>nil then exit;
  5039. end
  5040. else
  5041. begin
  5042. Scope:=Section.CustomData as TPas2JSSectionScope;
  5043. if Scope.Finished then
  5044. RaiseMsg(20180308160336,Section);
  5045. if Section.PendingUsedIntf<>nil then
  5046. RaiseMsg(20180308160639,Section,GetObjName(Section.PendingUsedIntf));
  5047. end;
  5048. // read external references
  5049. ReadUsedUnitsFinish(Obj,Section,aContext);
  5050. // read scope, needs external refs
  5051. ReadSectionScope(Obj,Scope,aContext);
  5052. aContext.BoolSwitches:=Scope.BoolSwitches;
  5053. aContext.ModeSwitches:=Scope.ModeSwitches;
  5054. // read declarations, needs external refs
  5055. ReadDeclarations(Obj,Section,aContext);
  5056. Scope.Finished:=true;
  5057. if Section is TInterfaceSection then
  5058. begin
  5059. ResolvePending;
  5060. Resolver.NotifyPendingUsedInterfaces;
  5061. end;
  5062. end;
  5063. procedure TPCUReader.ReadDeclarations(Obj: TJSONObject; Section: TPasSection;
  5064. aContext: TPCUReaderContext);
  5065. var
  5066. Arr: TJSONArray;
  5067. i: Integer;
  5068. Data: TJSONData;
  5069. El: TPasElement;
  5070. C: TClass;
  5071. begin
  5072. if not ReadArray(Obj,'Declarations',Arr,Section) then exit;
  5073. {$IFDEF VerbosePCUFiler}
  5074. writeln('TPCUReader.ReadDeclarations ',GetObjName(Section),' ',Arr.Count);
  5075. {$ENDIF}
  5076. for i:=0 to Arr.Count-1 do
  5077. begin
  5078. Data:=Arr[i];
  5079. if not (Data is TJSONObject) then
  5080. RaiseMsg(20180207182304,Section,IntToStr(i)+' '+GetObjName(Data));
  5081. El:=ReadElement(TJSONObject(Data),Section,aContext);
  5082. Section.Declarations.Add(El);
  5083. C:=El.ClassType;
  5084. if C=TPasResString then
  5085. Section.ResStrings.Add(El)
  5086. else if C=TPasConst then
  5087. Section.Consts.Add(El)
  5088. else if (C=TPasClassType) or (C=TPasRecordType) then
  5089. Section.Classes.Add(El)
  5090. else if C.InheritsFrom(TPasType) then
  5091. // not TPasClassType, TPasRecordType !
  5092. Section.Types.Add(El)
  5093. else if C.InheritsFrom(TPasProcedure) then
  5094. Section.Functions.Add(El)
  5095. else if C=TPasVariable then
  5096. Section.Variables.Add(El)
  5097. else if C=TPasProperty then
  5098. Section.Properties.Add(El)
  5099. else if C=TPasExportSymbol then
  5100. Section.ExportSymbols.Add(El);
  5101. end;
  5102. end;
  5103. function TPCUReader.CreateElement(AClass: TPTreeElement; const AName: String;
  5104. AParent: TPasElement): TPasElement;
  5105. begin
  5106. Result:=AClass.Create(AName,AParent);
  5107. Result.SourceFilename:=SourceFilename;
  5108. {$IFDEF CheckPasTreeRefCount}Result.RefIds.Add('CreateElement');{$ENDIF}
  5109. end;
  5110. function TPCUReader.ReadElement(Obj: TJSONObject; Parent: TPasElement;
  5111. aContext: TPCUReaderContext): TPasElement;
  5112. procedure ReadPrimitive(Kind: TPasExprKind);
  5113. var
  5114. Prim: TPrimitiveExpr;
  5115. Value: string;
  5116. begin
  5117. ReadString(Obj,'Value',Value,Parent);
  5118. Prim:=TPrimitiveExpr(CreateElement(TPrimitiveExpr,'',Parent));
  5119. Prim.Kind:=Kind;
  5120. Prim.Value:=Value;
  5121. Result:=Prim;
  5122. Prim.Name:='';
  5123. ReadPasExpr(Obj,Prim,Kind,aContext);
  5124. end;
  5125. procedure ReadParams(Kind: TPasExprKind);
  5126. begin
  5127. Result:=CreateElement(TParamsExpr,'',Parent);
  5128. TParamsExpr(Result).Kind:=Kind;
  5129. ReadParamsExpr(Obj,TParamsExpr(Result),aContext);
  5130. end;
  5131. procedure CreateClassType(Kind: TPasObjKind; const aName: string);
  5132. begin
  5133. Result:=CreateElement(TPasClassType,aName,Parent);
  5134. TPasClassType(Result).ObjKind:=Kind;
  5135. ReadClassType(Obj,TPasClassType(Result),aContext);
  5136. end;
  5137. procedure ReadProc(aClass: TPasProcedureClass; const aName: string);
  5138. begin
  5139. Result:=CreateElement(aClass,aName,Parent);
  5140. ReadProcedure(Obj,TPasProcedure(Result),aContext);
  5141. end;
  5142. procedure ReadOper(aClass: TPasProcedureClass; const aName: string);
  5143. begin
  5144. Result:=CreateElement(aClass,aName,Parent);
  5145. ReadOperator(Obj,TPasOperator(Result),aContext);
  5146. end;
  5147. var
  5148. aType, Name: string;
  5149. ok: Boolean;
  5150. begin
  5151. Result:=nil;
  5152. if not ReadString(Obj,'Type',aType,Parent) then
  5153. RaiseMsg(20180210143327,Parent);
  5154. if not ReadString(Obj,'Name',Name,Parent) then
  5155. Name:='';
  5156. {$IFDEF VerbosePCUFiler}
  5157. writeln('TPCUReader.ReadElement ',GetObjName(Parent),' Type="',aType,'" Name="',Name,'"');
  5158. {$ENDIF}
  5159. ok:=false;
  5160. try
  5161. case aType of
  5162. 'Unary':
  5163. begin
  5164. Result:=CreateElement(TUnaryExpr,Name,Parent);
  5165. ReadUnaryExpr(Obj,TUnaryExpr(Result),aContext);
  5166. end;
  5167. 'Binary':
  5168. begin
  5169. Result:=CreateElement(TBinaryExpr,Name,Parent);
  5170. TBinaryExpr(Result).Kind:=pekBinary;
  5171. TBinaryExpr(Result).OpCode:=eopAdd;
  5172. ReadBinaryExpr(Obj,TBinaryExpr(Result),aContext);
  5173. end;
  5174. 'Ident': ReadPrimitive(pekIdent);
  5175. 'Number': ReadPrimitive(pekNumber);
  5176. 'String': ReadPrimitive(pekString);
  5177. 'Bool':
  5178. begin
  5179. Result:=CreateElement(TBoolConstExpr,'',Parent);
  5180. TBoolConstExpr(Result).Kind:=pekBoolConst;
  5181. TBoolConstExpr(Result).Value:=false;
  5182. ReadBoolConstExpr(Obj,TBoolConstExpr(Result),aContext);
  5183. end;
  5184. 'False','True':
  5185. begin
  5186. Result:=CreateElement(TBoolConstExpr,'',Parent);
  5187. TBoolConstExpr(Result).Kind:=pekBoolConst;
  5188. TBoolConstExpr(Result).Value:=aType='True';
  5189. ReadPasExpr(Obj,TBoolConstExpr(Result),pekBoolConst,aContext);
  5190. end;
  5191. 'Nil':
  5192. begin
  5193. Result:=CreateElement(TNilExpr,'nil',Parent);
  5194. TNilExpr(Result).Kind:=pekNil;
  5195. ReadPasExpr(Obj,TNilExpr(Result),pekNil,aContext);
  5196. end;
  5197. 'Inherited':
  5198. begin
  5199. Result:=CreateElement(TInheritedExpr,'',Parent);
  5200. TInheritedExpr(Result).Kind:=pekInherited;
  5201. ReadPasExpr(Obj,TInheritedExpr(Result),pekInherited,aContext);
  5202. end;
  5203. 'Self':
  5204. begin
  5205. Result:=CreateElement(TSelfExpr,'',Parent);
  5206. TSelfExpr(Result).Kind:=pekSelf;
  5207. ReadPasExpr(Obj,TSelfExpr(Result),pekSelf,aContext);
  5208. end;
  5209. 'A[]':
  5210. ReadParams(pekArrayParams);
  5211. 'F()':
  5212. ReadParams(pekFuncParams);
  5213. '[]':
  5214. ReadParams(pekSet);
  5215. 'RecValues':
  5216. begin
  5217. Result:=CreateElement(TRecordValues,'',Parent);
  5218. TRecordValues(Result).Kind:=pekListOfExp;
  5219. ReadRecordValues(Obj,TRecordValues(Result),aContext);
  5220. end;
  5221. 'ArrValues':
  5222. begin
  5223. Result:=CreateElement(TArrayValues,'',Parent);
  5224. TArrayValues(Result).Kind:=pekListOfExp;
  5225. ReadArrayValues(Obj,TArrayValues(Result),aContext);
  5226. end;
  5227. 'ResString':
  5228. begin
  5229. Result:=CreateElement(TPasResString,Name,Parent);
  5230. ReadResString(Obj,TPasResString(Result),aContext);
  5231. end;
  5232. 'Alias':
  5233. begin
  5234. Result:=CreateElement(TPasAliasType,Name,Parent);
  5235. ReadAliasType(Obj,TPasAliasType(Result),aContext);
  5236. end;
  5237. 'Pointer':
  5238. begin
  5239. Result:=CreateElement(TPasPointerType,Name,Parent);
  5240. ReadPointerType(Obj,TPasPointerType(Result),aContext);
  5241. end;
  5242. 'TypeAlias':
  5243. begin
  5244. Result:=CreateElement(TPasTypeAliasType,Name,Parent);
  5245. ReadAliasType(Obj,TPasTypeAliasType(Result),aContext);
  5246. end;
  5247. 'ClassOf':
  5248. begin
  5249. Result:=CreateElement(TPasClassOfType,Name,Parent);
  5250. ReadAliasType(Obj,TPasClassOfType(Result),aContext);
  5251. end;
  5252. 'Specialize':
  5253. begin
  5254. Result:=CreateElement(TPasSpecializeType,Name,Parent);
  5255. ReadSpecializeType(Obj,TPasSpecializeType(Result),aContext);
  5256. end;
  5257. 'InlineSpecialize':
  5258. begin
  5259. Result:=CreateElement(TInlineSpecializeExpr,Name,Parent);
  5260. ReadInlineSpecializeExpr(Obj,TInlineSpecializeExpr(Result),aContext);
  5261. end;
  5262. 'RangeType':
  5263. begin
  5264. Result:=CreateElement(TPasRangeType,Name,Parent);
  5265. ReadRangeType(Obj,TPasRangeType(Result),aContext);
  5266. end;
  5267. 'ArrType':
  5268. begin
  5269. Result:=CreateElement(TPasArrayType,Name,Parent);
  5270. ReadArrayType(Obj,TPasArrayType(Result),aContext);
  5271. end;
  5272. 'File':
  5273. begin
  5274. Result:=CreateElement(TPasFileType,Name,Parent);
  5275. ReadFileType(Obj,TPasFileType(Result),aContext);
  5276. end;
  5277. 'EnumV':
  5278. begin
  5279. Result:=CreateElement(TPasEnumValue,Name,Parent);
  5280. ReadEnumValue(Obj,TPasEnumValue(Result),aContext);
  5281. end;
  5282. 'EnumType':
  5283. begin
  5284. Result:=CreateElement(TPasEnumType,Name,Parent);
  5285. ReadEnumType(Obj,TPasEnumType(Result),aContext);
  5286. end;
  5287. 'SetType':
  5288. begin
  5289. Result:=CreateElement(TPasSetType,Name,Parent);
  5290. ReadSetType(Obj,TPasSetType(Result),aContext);
  5291. end;
  5292. 'RecVariant':
  5293. begin
  5294. Result:=CreateElement(TPasVariant,Name,Parent);
  5295. ReadRecordVariant(Obj,TPasVariant(Result),aContext);
  5296. end;
  5297. 'Record':
  5298. begin
  5299. Result:=CreateElement(TPasRecordType,Name,Parent);
  5300. ReadRecordType(Obj,TPasRecordType(Result),aContext);
  5301. end;
  5302. 'Object': CreateClassType(okObject,Name);
  5303. 'Class': CreateClassType(okClass,Name);
  5304. 'Interface': CreateClassType(okInterface,Name);
  5305. 'ClassHelper': CreateClassType(okClassHelper,Name);
  5306. 'RecordHelper': CreateClassType(okRecordHelper,Name);
  5307. 'TypeHelper': CreateClassType(okTypeHelper,Name);
  5308. 'DispInterface': CreateClassType(okDispInterface,Name);
  5309. 'Arg':
  5310. begin
  5311. Result:=CreateElement(TPasArgument,Name,Parent);
  5312. ReadArgument(Obj,TPasArgument(Result),aContext);
  5313. end;
  5314. 'ProcType':
  5315. begin
  5316. Result:=CreateElement(TPasProcedureType,Name,Parent);
  5317. ReadProcedureType(Obj,TPasProcedureType(Result),aContext);
  5318. end;
  5319. 'Result':
  5320. begin
  5321. Result:=CreateElement(TPasResultElement,Name,Parent);
  5322. ReadResultElement(Obj,TPasResultElement(Result),aContext);
  5323. end;
  5324. 'FuncType':
  5325. begin
  5326. Result:=CreateElement(TPasFunctionType,Name,Parent);
  5327. ReadFunctionType(Obj,TPasFunctionType(Result),aContext);
  5328. end;
  5329. 'StringType':
  5330. begin
  5331. Result:=CreateElement(TPasStringType,Name,Parent);
  5332. ReadStringType(Obj,TPasStringType(Result),aContext);
  5333. end;
  5334. 'Var':
  5335. begin
  5336. Result:=CreateElement(TPasVariable,Name,Parent);
  5337. ReadVariable(Obj,TPasVariable(Result),aContext);
  5338. end;
  5339. 'Export':
  5340. begin
  5341. Result:=CreateElement(TPasExportSymbol,Name,Parent);
  5342. ReadExportSymbol(Obj,TPasExportSymbol(Result),aContext);
  5343. end;
  5344. 'Const':
  5345. begin
  5346. Result:=CreateElement(TPasConst,Name,Parent);
  5347. ReadConst(Obj,TPasConst(Result),aContext);
  5348. end;
  5349. 'Property':
  5350. begin
  5351. Result:=CreateElement(TPasProperty,Name,Parent);
  5352. ReadProperty(Obj,TPasProperty(Result),aContext);
  5353. end;
  5354. 'MethodRes':
  5355. begin
  5356. Result:=CreateElement(TPasMethodResolution,Name,Parent);
  5357. ReadMethodResolution(Obj,TPasMethodResolution(Result),aContext);
  5358. end;
  5359. 'Procedure': ReadProc(TPasProcedure,Name);
  5360. 'ClassProcedure': ReadProc(TPasClassProcedure,Name);
  5361. 'Function': ReadProc(TPasFunction,Name);
  5362. 'ClassFunction': ReadProc(TPasClassFunction,Name);
  5363. 'Constructor': ReadProc(TPasConstructor,Name);
  5364. 'ClassConstructor': ReadProc(TPasClassConstructor,Name);
  5365. 'Destructor': ReadProc(TPasDestructor,Name);
  5366. 'ClassDestructor': ReadProc(TPasClassDestructor,Name);
  5367. 'Operator': ReadOper(TPasConstructor,Name);
  5368. 'ClassOperator': ReadOper(TPasClassConstructor,Name);
  5369. else
  5370. RaiseMsg(20180210143758,Parent,'unknown type "'+LeftStr(aType,100)+'"');
  5371. end;
  5372. ok:=true;
  5373. finally
  5374. if not ok then
  5375. if Result<>nil then
  5376. begin
  5377. Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  5378. Result:=nil;
  5379. end;
  5380. end;
  5381. end;
  5382. function TPCUReader.ReadElementProperty(Obj: TJSONObject; Parent: TPasElement;
  5383. const PropName: string; BaseClass: TPTreeElement; aContext: TPCUReaderContext
  5384. ): TPasElement;
  5385. var
  5386. SubObj: TJSONObject;
  5387. s: String;
  5388. begin
  5389. if not ReadObject(Obj,PropName,SubObj,Parent) then exit;
  5390. Result:=ReadElement(SubObj,Parent,aContext);
  5391. if (Result is BaseClass) then exit;
  5392. s:=GetObjName(Result);
  5393. Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};;
  5394. Result:=nil;
  5395. RaiseMsg(20180211105744,Parent,PropName+' is '+s);
  5396. end;
  5397. procedure TPCUReader.ReadElementReference(Obj: TJSONObject;
  5398. Instance: TPasElementBase; const PropName: string;
  5399. const Setter: TOnSetElReference);
  5400. var
  5401. Data: TJSONData;
  5402. ErrorEl: TPasElement;
  5403. Id: Integer;
  5404. begin
  5405. Data:=Obj.Find(PropName);
  5406. if Data=nil then exit;
  5407. if Instance is TPasElement then
  5408. ErrorEl:=TPasElement(Instance)
  5409. else if Instance is TResolveData then
  5410. ErrorEl:=TResolveData(Instance).Element
  5411. else
  5412. RaiseMsg(20180211120642,GetObjName(Instance)+'.'+PropName);
  5413. if Data is TJSONIntegerNumber then
  5414. begin
  5415. Id:=Data.AsInteger;
  5416. PromiseSetElReference(Id,Setter,Instance,ErrorEl);
  5417. end
  5418. else
  5419. RaiseMsg(20180211120300,ErrorEl,PropName+' is '+GetObjName(Data));
  5420. end;
  5421. procedure TPCUReader.ReadElementList(Obj: TJSONObject; Parent: TPasElement;
  5422. const PropName: string; ListOfElements: TFPList; AddRef: TPCUAddRef;
  5423. aContext: TPCUReaderContext);
  5424. var
  5425. Arr: TJSONArray;
  5426. i, Id: Integer;
  5427. Data: TJSONData;
  5428. SubObj: TJSONObject;
  5429. SubEl: TPasElement;
  5430. begin
  5431. if not ReadArray(Obj,PropName,Arr,Parent) then exit;
  5432. for i:=0 to Arr.Count-1 do
  5433. begin
  5434. Data:=Arr[i];
  5435. if Data is TJSONIntegerNumber then
  5436. begin
  5437. // reference
  5438. Id:=Data.AsInteger;
  5439. ListOfElements.Add(nil);
  5440. PromiseSetElListReference(Id,ListOfElements,ListOfElements.Count-1,AddRef,Parent);
  5441. end
  5442. else if Data is TJSONObject then
  5443. begin
  5444. SubObj:=TJSONObject(Data);
  5445. SubEl:=ReadElement(SubObj,Parent,aContext);
  5446. ListOfElements.Add(SubEl);
  5447. end
  5448. else
  5449. RaiseMsg(20180210201001,Parent,'['+IntToStr(i)+'] is '+GetObjName(Data));
  5450. end;
  5451. end;
  5452. procedure TPCUReader.ReadElType(Obj: TJSONObject; const PropName: string;
  5453. El: TPasElement; const Setter: TOnSetElReference; aContext: TPCUReaderContext
  5454. );
  5455. var
  5456. Data: TJSONData;
  5457. Id: Integer;
  5458. SubEl: TPasElement;
  5459. s: String;
  5460. begin
  5461. if aContext=nil then ;
  5462. Data:=Obj.Find(PropName);
  5463. if Data=nil then exit;
  5464. if Data is TJSONIntegerNumber then
  5465. begin
  5466. // reference
  5467. Id:=Data.AsInteger;
  5468. PromiseSetElReference(Id,Setter,El,El);
  5469. end
  5470. else if Data is TJSONObject then
  5471. begin
  5472. // anonymous type
  5473. SubEl:=ReadElement(TJSONObject(Data),El,aContext);
  5474. if not (SubEl is TPasType) then
  5475. begin
  5476. s:=GetObjName(SubEl);
  5477. if SubEl<>nil then
  5478. SubEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  5479. RaiseMsg(20180210150730,El,PropName+', expected type, but got '+s);
  5480. end;
  5481. Setter(SubEl,El);
  5482. end
  5483. else
  5484. RaiseMsg(20180207185313,El,PropName+':'+GetObjName(Data));
  5485. end;
  5486. function TPCUReader.ReadResolvedRefFlags(Obj: TJSONObject; El: TPasElement;
  5487. const PropName: string; const DefaultValue: TResolvedReferenceFlags
  5488. ): TResolvedReferenceFlags;
  5489. var
  5490. Names: TStringDynArray;
  5491. Enable: TBooleanDynArray;
  5492. s: String;
  5493. f: TResolvedReferenceFlag;
  5494. i: Integer;
  5495. Found: Boolean;
  5496. Data: TJSONData;
  5497. begin
  5498. Result:=DefaultValue;
  5499. {$IFDEF VerbosePCUFiler}
  5500. writeln('TPCUReader.ReadResolvedRefFlags START');
  5501. {$ENDIF}
  5502. Data:=Obj.Find(PropName);
  5503. if Data=nil then exit;
  5504. ReadArrayFlags(Data,El,PropName,Names,Enable);
  5505. for i:=0 to length(Names)-1 do
  5506. begin
  5507. s:=Names[i];
  5508. Found:=false;
  5509. for f in TResolvedReferenceFlag do
  5510. if s=PCUResolvedReferenceFlagNames[f] then
  5511. begin
  5512. if Enable[i] then
  5513. Include(Result,f)
  5514. else
  5515. Exclude(Result,f);
  5516. Found:=true;
  5517. break;
  5518. end;
  5519. if not Found then
  5520. RaiseMsg(20180215134501,'unknown resolvedreference flag "'+s+'"');
  5521. end;
  5522. end;
  5523. procedure TPCUReader.ReadResolvedReference(Obj: TJSONObject;
  5524. Ref: TResolvedReference; ErrorEl: TPasElement);
  5525. var
  5526. Found: Boolean;
  5527. s: string;
  5528. a: TResolvedRefAccess;
  5529. begin
  5530. ReadElementReference(Obj,Ref,'RefDecl',@Set_ResolvedReference_Declaration);
  5531. Ref.Flags:=ReadResolvedRefFlags(Obj,ErrorEl,'RefFlags',[]);
  5532. Ref.Access:=rraRead;
  5533. if ReadString(Obj,'RefAccess',s,ErrorEl) then
  5534. begin
  5535. Found:=false;
  5536. for a in TResolvedRefAccess do
  5537. if s=PCUResolvedRefAccessNames[a] then
  5538. begin
  5539. Ref.Access:=a;
  5540. Found:=true;
  5541. break;
  5542. end;
  5543. if not Found then
  5544. RaiseMsg(20180215134804,ErrorEl,s);
  5545. end;
  5546. end;
  5547. procedure TPCUReader.ReadPasExpr(Obj: TJSONObject; Expr: TPasExpr;
  5548. DefKind: TPasExprKind; aContext: TPCUReaderContext);
  5549. var
  5550. Kind: TPasExprKind;
  5551. s: string;
  5552. Op: TExprOpCode;
  5553. Found: Boolean;
  5554. begin
  5555. Expr.Kind:=DefKind;
  5556. if ReadString(Obj,'Kind',s,Expr) then
  5557. begin
  5558. Found:=false;
  5559. for Kind in TPasExprKind do
  5560. if s=PCUExprKindNames[Kind] then
  5561. begin
  5562. Expr.Kind:=Kind;
  5563. Found:=true;
  5564. break;
  5565. end;
  5566. if not Found then
  5567. RaiseMsg(20180208074859,Expr,s);
  5568. end;
  5569. if ReadString(Obj,'Op',s,Expr) then
  5570. begin
  5571. Found:=false;
  5572. for Op in TExprOpCode do
  5573. if s=PCUExprOpCodeNames[Op] then
  5574. begin
  5575. Expr.OpCode:=Op;
  5576. Found:=true;
  5577. break;
  5578. end;
  5579. if not Found then
  5580. RaiseMsg(20180208074950,Expr,s);
  5581. end;
  5582. Expr.format1:=ReadExpr(Obj,Expr,'format1',aContext);
  5583. Expr.format2:=ReadExpr(Obj,Expr,'format2',aContext);
  5584. ReadPasElement(Obj,Expr,aContext);
  5585. end;
  5586. procedure TPCUReader.ReadExprCustomData(Obj: TJSONObject; Expr: TPasExpr;
  5587. aContext: TPCUReaderContext);
  5588. var
  5589. Ref: TResolvedReference;
  5590. NeedEvalValue: Boolean;
  5591. Value: TResEvalValue;
  5592. begin
  5593. Ref:=TResolvedReference(Expr.CustomData);
  5594. if Obj.Find('RefDecl')<>nil then
  5595. begin
  5596. Ref:=TResolvedReference.Create;
  5597. Resolver.AddResolveData(Expr,Ref,lkModule);
  5598. ReadResolvedReference(Obj,Ref,Expr);
  5599. end;
  5600. if not ReadBoolean(Obj,'Eval',NeedEvalValue,Expr) then
  5601. NeedEvalValue:=GetDefaultExprHasEvalValue(Expr);
  5602. //writeln('TPCUReader.ReadExprCustomData ',GetElementFullPath(Expr),' ',GetObjName(Expr),' NeedEvalValue=',NeedEvalValue);
  5603. if NeedEvalValue then
  5604. begin
  5605. Value:=Resolver.Eval(Expr,[refAutoConst]);
  5606. if Value<>nil then
  5607. ReleaseEvalValue(Value);
  5608. end;
  5609. if aContext=nil then ;
  5610. end;
  5611. function TPCUReader.ReadExpr(Obj: TJSONObject; Parent: TPasElement;
  5612. const PropName: string; aContext: TPCUReaderContext): TPasExpr;
  5613. var
  5614. Data: TJSONData;
  5615. s: string;
  5616. SubObj: TJSONObject;
  5617. El: TPasElement;
  5618. begin
  5619. Data:=Obj.Find(PropName);
  5620. if Data=nil then exit(nil);
  5621. if Data is TJSONObject then
  5622. begin
  5623. SubObj:=TJSONObject(Data);
  5624. El:=ReadElement(SubObj,Parent,aContext);
  5625. if not (El is TPasExpr) then
  5626. begin
  5627. s:=GetObjName(El);
  5628. if El<>nil then
  5629. El.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  5630. RaiseMsg(20180210152134,Parent,PropName+' got '+s);
  5631. end;
  5632. Result:=TPasExpr(El);
  5633. ReadExprCustomData(SubObj,Result,aContext);
  5634. end
  5635. else
  5636. RaiseMsg(20180207190200,Parent,PropName+':'+GetObjName(Data));
  5637. end;
  5638. procedure TPCUReader.ReadPasExprArray(Obj: TJSONObject; Parent: TPasElement;
  5639. const PropName: string; var ExprArr: TPasExprArray;
  5640. aContext: TPCUReaderContext);
  5641. var
  5642. Arr: TJSONArray;
  5643. i: Integer;
  5644. Data: TJSONData;
  5645. SubEl: TPasElement;
  5646. SubObj: TJSONObject;
  5647. Expr: TPasExpr;
  5648. begin
  5649. if not ReadArray(Obj,PropName,Arr,Parent) then exit;
  5650. SetLength(ExprArr,Arr.Count);
  5651. for i:=0 to Arr.Count-1 do
  5652. begin
  5653. Data:=Arr[i];
  5654. if not (Data is TJSONObject) then
  5655. RaiseMsg(20180210173026,Parent,'['+IntToStr(i)+'] is '+GetObjName(Data));
  5656. SubObj:=TJSONObject(Data);
  5657. SubEl:=ReadElement(SubObj,Parent,aContext);
  5658. if not (SubEl is TPasExpr) then
  5659. RaiseMsg(20180210173026,Parent,'['+IntToStr(i)+'] is '+GetObjName(SubEl));
  5660. Expr:=TPasExpr(SubEl);
  5661. ExprArr[i]:=Expr;
  5662. ReadExprCustomData(SubObj,Expr,aContext);
  5663. end;
  5664. end;
  5665. procedure TPCUReader.ReadPasScope(Obj: TJSONObject; Scope: TPasScope;
  5666. aContext: TPCUReaderContext);
  5667. var
  5668. Data: TJSONData;
  5669. Id: Integer;
  5670. begin
  5671. Data:=Obj.Find('VisibilityContext');
  5672. if Data=nil then
  5673. Scope.VisibilityContext:=GetDefaultPasScopeVisibilityContext(Scope)
  5674. else
  5675. begin
  5676. Id:=Data.AsInteger;
  5677. if Id=0 then
  5678. Scope.VisibilityContext:=nil
  5679. else
  5680. ReadElementReference(Obj,Scope,'VisibilityContext',@Set_PasScope_VisibilityContext);
  5681. end;
  5682. if aContext=nil then ;
  5683. end;
  5684. procedure TPCUReader.ReadScopeReferences(Obj: TJSONObject; Scope: TPasScope;
  5685. const PropName: string; var References: TPasScopeReferences);
  5686. var
  5687. Arr: TJSONArray;
  5688. i, Id: Integer;
  5689. Data: TJSONData;
  5690. SubObj: TJSONObject;
  5691. Ref: TPCUFilerElementRef;
  5692. s: string;
  5693. Found: Boolean;
  5694. Access: TPSRefAccess;
  5695. El: TPasElement;
  5696. begin
  5697. El:=Scope.Element;
  5698. if References<>nil then
  5699. RaiseMsg(20180302145101,El);
  5700. if not ReadArray(Obj,PropName,Arr,El) then exit;
  5701. References:=TPasScopeReferences.Create(Scope);
  5702. for i:=0 to Arr.Count-1 do
  5703. begin
  5704. Data:=Arr[i];
  5705. if not (Data is TJSONObject) then
  5706. RaiseMsg(20180221164800,El,GetObjName(Data));
  5707. SubObj:=TJSONObject(Data);
  5708. Data:=SubObj.Find('Id');
  5709. if not (Data is TJSONIntegerNumber) then
  5710. RaiseMsg(20180221171546,El,GetObjName(Data));
  5711. Id:=Data.AsInteger;
  5712. Ref:=GetElReference(Id,El);
  5713. if Ref=nil then
  5714. RaiseMsg(20180221171940,El,IntToStr(Id));
  5715. if Ref.Element=nil then
  5716. RaiseMsg(20180221171940,El,IntToStr(Id));
  5717. if ReadString(SubObj,'Access',s,El) then
  5718. begin
  5719. Found:=false;
  5720. for Access in TPSRefAccess do
  5721. if s=PCUPSRefAccessNames[Access] then
  5722. begin
  5723. Found:=true;
  5724. break;
  5725. end;
  5726. if not Found then
  5727. RaiseMsg(20180221172333,El,'Access "'+s+'"');
  5728. end
  5729. else
  5730. Access:=PCUDefaultPSRefAccess;
  5731. References.Add(Ref.Element,Access);
  5732. end;
  5733. end;
  5734. procedure TPCUReader.ReadIdentifierScopeArray(Arr: TJSONArray;
  5735. Scope: TPasIdentifierScope);
  5736. // called after reading module, i.e. all elements are created
  5737. function GetElRef(Id: integer; out DefKind: TPasIdentifierKind;
  5738. out DefName: string): TPCUFilerElementRef;
  5739. begin
  5740. Result:=GetElReference(Id,Scope.Element);
  5741. if (Result=nil) or (Result.Element=nil) then
  5742. RaiseMsg(20180207161358,Scope.Element,'Id not found: '+IntToStr(Id));
  5743. GetDefaultsPasIdentifierProps(Result.Element,DefKind,DefName);
  5744. end;
  5745. var
  5746. i, Id: Integer;
  5747. Data: TJSONData;
  5748. ItemObj: TJSONObject;
  5749. s, Name, DefName: string;
  5750. Kind, DefKind: TPasIdentifierKind;
  5751. Ref: TPCUFilerElementRef;
  5752. begin
  5753. {$IFDEF VerbosePCUFiler}
  5754. writeln('TPCUReader.ReadIdentifierScope ',Arr.Count);
  5755. {$ENDIF}
  5756. for i:=0 to Arr.Count-1 do
  5757. begin
  5758. Data:=Arr[i];
  5759. if Data is TJSONIntegerNumber then
  5760. begin
  5761. Id:=Data.AsInteger;
  5762. Ref:=GetElRef(Id,DefKind,DefName);
  5763. {$IFDEF VerbosePCUFiler}
  5764. writeln('TPCUReader.ReadIdentifierScope Id=',Id,' ',DefName,' ',DefKind,' ',GetObjName(Ref.Element));
  5765. {$ENDIF}
  5766. Scope.AddIdentifier(DefName,Ref.Element,DefKind);
  5767. end
  5768. else if Data is TJSONObject then
  5769. begin
  5770. ItemObj:=TJSONObject(Data);
  5771. if not ReadInteger(ItemObj,'El',Id,Scope.Element) then
  5772. RaiseMsg(20180207162015,Scope.Element,'missing El:integer');
  5773. Ref:=GetElRef(Id,DefKind,DefName);
  5774. if ReadString(ItemObj,'Kind',s,Scope.Element) then
  5775. Kind:=StrToPasIdentifierKind(s)
  5776. else
  5777. Kind:=DefKind;
  5778. if not ReadString(ItemObj,'Name',Name,Scope.Element) then
  5779. Name:=DefName;
  5780. if Name='' then
  5781. RaiseMsg(20180207162358,Scope.Element,IntToStr(Id));
  5782. Scope.AddIdentifier(Name,Ref.Element,Kind);
  5783. end
  5784. else
  5785. RaiseMsg(20180207154839,Scope.Element,GetObjName(Data));
  5786. end;
  5787. end;
  5788. procedure TPCUReader.ReadIdentifierScope(Obj: TJSONObject;
  5789. Scope: TPasIdentifierScope; aContext: TPCUReaderContext);
  5790. var
  5791. Arr: TJSONArray;
  5792. Pending: TPCUReaderPendingIdentifierScope;
  5793. begin
  5794. if ReadArray(Obj,'SItems',Arr,Scope.Element) then
  5795. begin
  5796. Pending:=TPCUReaderPendingIdentifierScope.Create;
  5797. Pending.Scope:=Scope;
  5798. Pending.Arr:=Arr;
  5799. FPendingIdentifierScopes.Add(Pending);
  5800. end;
  5801. ReadPasScope(Obj,Scope,aContext);
  5802. end;
  5803. function TPCUReader.ReadModuleScopeFlags(Obj: TJSONObject; El: TPasElement;
  5804. const DefaultValue: TPasModuleScopeFlags): TPasModuleScopeFlags;
  5805. var
  5806. Names: TStringDynArray;
  5807. Enable: TBooleanDynArray;
  5808. s: String;
  5809. f: TPasModuleScopeFlag;
  5810. i: Integer;
  5811. Found: Boolean;
  5812. Data: TJSONData;
  5813. begin
  5814. Result:=DefaultValue;
  5815. {$IFDEF VerbosePCUFiler}
  5816. writeln('TPCUReader.ReadModuleScopeFlags START');
  5817. {$ENDIF}
  5818. Data:=Obj.Find('ScopeFlags');
  5819. if Data=nil then exit;
  5820. ReadArrayFlags(Data,El,'ScopeFlags',Names,Enable);
  5821. for i:=0 to length(Names)-1 do
  5822. begin
  5823. s:=Names[i];
  5824. Found:=false;
  5825. for f in TPasModuleScopeFlag do
  5826. if s=PCUModuleScopeFlagNames[f] then
  5827. begin
  5828. if Enable[i] then
  5829. Include(Result,f)
  5830. else
  5831. Exclude(Result,f);
  5832. Found:=true;
  5833. break;
  5834. end;
  5835. if not Found then
  5836. RaiseMsg(20180206114404,'unknown ModuleScopeFlag "'+s+'"');
  5837. end;
  5838. end;
  5839. procedure TPCUReader.ReadModuleScope(Obj: TJSONObject;
  5840. Scope: TPas2JSModuleScope; aContext: TPCUReaderContext);
  5841. var
  5842. aModule: TPasModule;
  5843. begin
  5844. aModule:=Scope.Element as TPasModule;
  5845. Scope.FirstName:=FirstDottedIdentifier(aModule.Name);
  5846. Scope.Flags:=ReadModuleScopeFlags(Obj,aModule,PCUDefaultModuleScopeFlags);
  5847. Scope.BoolSwitches:=ReadBoolSwitches(Obj,aModule,'BoolSwitches',aContext.BoolSwitches);
  5848. ReadElementReference(Obj,Scope,'AssertClass',@Set_ModScope_AssertClass);
  5849. ReadElementReference(Obj,Scope,'AssertDefConstructor',@Set_ModScope_AssertDefConstructor);
  5850. ReadElementReference(Obj,Scope,'AssertMsgConstructor',@Set_ModScope_AssertMsgConstructor);
  5851. ReadElementReference(Obj,Scope,'RangeErrorClass',@Set_ModScope_RangeErrorClass);
  5852. ReadElementReference(Obj,Scope,'RangeErrorConstructor',@Set_ModScope_RangeErrorConstructor);
  5853. ReadPasScope(Obj,Scope,aContext);
  5854. end;
  5855. procedure TPCUReader.ReadModuleHeader(Data: TJSONData);
  5856. var
  5857. Obj: TJSONObject;
  5858. aName, aType: String;
  5859. aModule: TPasModule;
  5860. ModScope: TPas2JSModuleScope;
  5861. aContext: TPCUReaderContext;
  5862. begin
  5863. {$IFDEF VerbosePCUFiler}
  5864. writeln('TPCUReader.ReadModuleHeader START');
  5865. {$ENDIF}
  5866. CheckJSONObject(Data,20180308140357);
  5867. Obj:=TJSONObject(Data);
  5868. aName:=String(Obj.Get('Name',''));
  5869. aType:=String(Obj.Get('Type',''));
  5870. case aType of
  5871. 'Unit': aModule:=TPasModule(CreateElement(TPasModule,aName,nil));
  5872. 'Program': aModule:=TPasProgram(CreateElement(TPasProgram,aName,nil));
  5873. 'Library': aModule:=TPasLibrary(CreateElement(TPasLibrary,aName,nil));
  5874. else
  5875. {$IFDEF VerbosePCUFiler}
  5876. writeln('TPCUReader.ReadModuleHeader Type="',aType,'"');
  5877. {$ENDIF}
  5878. RaiseMsg(20180203100748);
  5879. end;
  5880. Resolver.RootElement:=aModule;
  5881. aContext:=CreateContext;
  5882. try
  5883. ReadPasElement(Obj,aModule,aContext);
  5884. ModScope:=TPas2JSModuleScope(Resolver.CreateScope(aModule,Resolver.ScopeClass_Module));
  5885. ReadModuleScope(Obj,ModScope,aContext);
  5886. ReadBuiltInSymbols(Obj,aModule);
  5887. finally
  5888. aContext.Free;
  5889. end;
  5890. {$IFDEF VerbosePCUFiler}
  5891. writeln('TPCUReader.ReadModuleHeader END');
  5892. {$ENDIF}
  5893. end;
  5894. function TPCUReader.ReadModule(Obj: TJSONObject; aContext: TPCUReaderContext
  5895. ): boolean;
  5896. var
  5897. aModule: TPasModule;
  5898. function CreateOrContinueSection(const PropName: string; var Section: TPasSection;
  5899. SectionClass: TPasSectionClass): boolean;
  5900. var
  5901. SubObj: TJSONObject;
  5902. begin
  5903. if not ReadObject(Obj,PropName,SubObj,aModule) then
  5904. RaiseMsg(20180308142146,aModule);
  5905. if Section=nil then
  5906. Section:=TPasSection(CreateElement(SectionClass,'',aModule));
  5907. ReadSection(SubObj,Section,aContext);
  5908. Result:=Section.PendingUsedIntf=nil;
  5909. end;
  5910. procedure ReadInitialFinal(Obj: TJSONObject; Block: TPasImplBlock;
  5911. const PropPrefix: string);
  5912. var
  5913. Scope: TPas2JSInitialFinalizationScope;
  5914. s: string;
  5915. begin
  5916. Scope:=TPas2JSInitialFinalizationScope(Resolver.CreateScope(Block,Resolver.ScopeClass_InitialFinalization));
  5917. Block.CustomData:=Scope;
  5918. if not ReadString(Obj,PropPrefix+'JS',s,Block) then exit;
  5919. Scope.JS:=s;
  5920. ReadScopeReferences(Obj,Scope,PropPrefix+'Refs',Scope.References);
  5921. end;
  5922. var
  5923. ModScope: TPas2JSModuleScope;
  5924. OldBoolSwitches: TBoolSwitches;
  5925. Prog: TPasProgram;
  5926. Lib: TPasLibrary;
  5927. OldModeSwitches: TModeSwitches;
  5928. begin
  5929. Result:=false;
  5930. {$IFDEF VerbosePCUFiler}
  5931. writeln('TPCUReader.ReadModule START ');
  5932. {$ENDIF}
  5933. aModule:=Resolver.RootElement;
  5934. ModScope:=aModule.CustomData as TPas2JSModuleScope;
  5935. OldBoolSwitches:=aContext.BoolSwitches;
  5936. aContext.BoolSwitches:=ModScope.BoolSwitches;
  5937. OldModeSwitches:=aContext.ModeSwitches;
  5938. try
  5939. // read sections
  5940. if aModule.ClassType=TPasProgram then
  5941. begin
  5942. // start or continue ProgramSection
  5943. Prog:=TPasProgram(aModule);
  5944. if not CreateOrContinueSection('Program',TPasSection(Prog.ProgramSection),
  5945. TProgramSection) then
  5946. exit; // pending uses interfaces -> pause
  5947. end
  5948. else if aModule.ClassType=TPasLibrary then
  5949. begin
  5950. // start or continue LibrarySection
  5951. Lib:=TPasLibrary(aModule);
  5952. if not CreateOrContinueSection('Library',TPasSection(Lib.LibrarySection),
  5953. TLibrarySection) then
  5954. exit; // pending uses interfaces -> pause
  5955. end
  5956. else
  5957. begin
  5958. // unit
  5959. if aModule.ImplementationSection=nil then
  5960. begin
  5961. // start or continue unit Interface
  5962. if not CreateOrContinueSection('Interface',TPasSection(aModule.InterfaceSection),
  5963. TInterfaceSection) then
  5964. exit; // pending uses interfaces -> pause
  5965. end;
  5966. // start or continue unit Implementation
  5967. if not CreateOrContinueSection('Implementation',TPasSection(aModule.ImplementationSection),
  5968. TImplementationSection) then
  5969. exit; // pending uses interfaces -> pause
  5970. end;
  5971. if Obj.Find('InitJS')<>nil then
  5972. begin
  5973. aModule.InitializationSection:=TInitializationSection(CreateElement(TInitializationSection,'',aModule));
  5974. ReadInitialFinal(Obj,aModule.InitializationSection,'Init');
  5975. end;
  5976. if Obj.Find('FinalJS')<>nil then
  5977. begin
  5978. aModule.FinalizationSection:=TFinalizationSection(CreateElement(TFinalizationSection,'',aModule));
  5979. ReadInitialFinal(Obj,aModule.FinalizationSection,'Final');
  5980. end;
  5981. finally
  5982. aContext.BoolSwitches:=OldBoolSwitches;
  5983. aContext.ModeSwitches:=OldModeSwitches;
  5984. end;
  5985. ResolvePending;
  5986. Result:=true;
  5987. end;
  5988. procedure TPCUReader.ReadUnaryExpr(Obj: TJSONObject; Expr: TUnaryExpr;
  5989. aContext: TPCUReaderContext);
  5990. begin
  5991. Expr.OpCode:=eopAdd;
  5992. Expr.Kind:=pekUnary;
  5993. ReadPasExpr(Obj,Expr,pekUnary,aContext);
  5994. Expr.Operand:=ReadExpr(Obj,Expr,'Operand',aContext);
  5995. end;
  5996. procedure TPCUReader.ReadBinaryExpr(Obj: TJSONObject; Expr: TBinaryExpr;
  5997. aContext: TPCUReaderContext);
  5998. begin
  5999. ReadPasExpr(Obj,Expr,pekBinary,aContext);
  6000. Expr.left:=ReadExpr(Obj,Expr,'Left',aContext);
  6001. Expr.right:=ReadExpr(Obj,Expr,'Right',aContext);
  6002. end;
  6003. procedure TPCUReader.ReadBoolConstExpr(Obj: TJSONObject; Expr: TBoolConstExpr;
  6004. aContext: TPCUReaderContext);
  6005. begin
  6006. ReadPasExpr(Obj,Expr,pekBoolConst,aContext);
  6007. ReadBoolean(Obj,'Value',Expr.Value,Expr);
  6008. end;
  6009. procedure TPCUReader.ReadParamsExpr(Obj: TJSONObject; Expr: TParamsExpr;
  6010. aContext: TPCUReaderContext);
  6011. begin
  6012. ReadPasExpr(Obj,Expr,Expr.Kind,aContext);
  6013. Expr.Value:=ReadExpr(Obj,Expr,'Value',aContext);
  6014. ReadPasExprArray(Obj,Expr,'Params',Expr.Params,aContext);
  6015. end;
  6016. procedure TPCUReader.ReadRecordValues(Obj: TJSONObject; Expr: TRecordValues;
  6017. aContext: TPCUReaderContext);
  6018. var
  6019. Arr: TJSONArray;
  6020. i: Integer;
  6021. Data: TJSONData;
  6022. SubObj: TJSONObject;
  6023. SubEl: TPasElement;
  6024. aName: string;
  6025. begin
  6026. ReadPasExpr(Obj,Expr,pekListOfExp,aContext);
  6027. if ReadArray(Obj,'Fields',Arr,Expr) then
  6028. begin
  6029. SetLength(Expr.Fields,Arr.Count);
  6030. for i:=0 to Arr.Count-1 do
  6031. begin
  6032. Data:=Arr[i];
  6033. if not (Data is TJSONObject) then
  6034. RaiseMsg(20180210173636,Expr,'['+IntToStr(i)+'] is '+GetObjName(Data));
  6035. SubObj:=TJSONObject(Data);
  6036. if ReadString(SubObj,'Name',aName,Expr) then
  6037. Expr.Fields[i].Name:=aName;
  6038. SubEl:=ReadElement(TJSONObject(Data),Expr,aContext);
  6039. if not (SubEl is TPasExpr) then
  6040. RaiseMsg(20180210174041,Expr,'['+IntToStr(i)+'] is '+GetObjName(SubEl));
  6041. Expr.Fields[i].ValueExp:=TPasExpr(SubEl);
  6042. end;
  6043. end;
  6044. end;
  6045. procedure TPCUReader.ReadArrayValues(Obj: TJSONObject; Expr: TArrayValues;
  6046. aContext: TPCUReaderContext);
  6047. begin
  6048. ReadPasExpr(Obj,Expr,pekListOfExp,aContext);
  6049. ReadPasExprArray(Obj,Expr,'Values',Expr.Values,aContext);
  6050. end;
  6051. procedure TPCUReader.ReadResString(Obj: TJSONObject; El: TPasResString;
  6052. aContext: TPCUReaderContext);
  6053. begin
  6054. ReadPasElement(Obj,El,aContext);
  6055. El.Expr:=ReadExpr(Obj,El,'Expr',aContext);
  6056. end;
  6057. procedure TPCUReader.ReadAliasType(Obj: TJSONObject; El: TPasAliasType;
  6058. aContext: TPCUReaderContext);
  6059. begin
  6060. ReadPasElement(Obj,El,aContext);
  6061. ReadElType(Obj,'Dest',El,@Set_AliasType_DestType,aContext);
  6062. El.Expr:=ReadExpr(Obj,El,'Expr',aContext);
  6063. end;
  6064. procedure TPCUReader.ReadPointerType(Obj: TJSONObject; El: TPasPointerType;
  6065. aContext: TPCUReaderContext);
  6066. begin
  6067. ReadPasElement(Obj,El,aContext);
  6068. ReadElType(Obj,'Dest',El,@Set_PointerType_DestType,aContext);
  6069. end;
  6070. procedure TPCUReader.ReadSpecializeType(Obj: TJSONObject;
  6071. El: TPasSpecializeType; aContext: TPCUReaderContext);
  6072. begin
  6073. ReadAliasType(Obj,El,aContext);
  6074. ReadElementList(Obj,El,'Params',El.Params,
  6075. {$IFDEF CheckPasTreeRefCount}'TPasSpecializeType.Params'{$ELSE}true{$ENDIF},
  6076. aContext);
  6077. end;
  6078. procedure TPCUReader.ReadInlineTypeExpr(Obj: TJSONObject;
  6079. Expr: TInlineTypeExpr; aContext: TPCUReaderContext);
  6080. begin
  6081. ReadPasExpr(Obj,Expr,Expr.Kind,aContext);
  6082. ReadElType(Obj,'Dest',Expr,@Set_InlineTypeExpr_DestType,aContext);
  6083. end;
  6084. procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
  6085. Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext);
  6086. begin
  6087. Expr.Kind:=pekSpecialize;
  6088. ReadInlineTypeExpr(Obj,Expr,aContext);
  6089. end;
  6090. procedure TPCUReader.ReadRangeType(Obj: TJSONObject; El: TPasRangeType;
  6091. aContext: TPCUReaderContext);
  6092. var
  6093. Expr: TPasExpr;
  6094. s: String;
  6095. begin
  6096. ReadPasElement(Obj,El,aContext);
  6097. Expr:=ReadExpr(Obj,El,'Range',aContext);
  6098. if not (Expr is TBinaryExpr) then
  6099. begin
  6100. s:=GetObjName(Expr);
  6101. if Expr<>nil then
  6102. Expr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  6103. RaiseMsg(20180216204042,El,s);
  6104. end;
  6105. El.RangeExpr:=TBinaryExpr(Expr);
  6106. end;
  6107. procedure TPCUReader.ReadArrayType(Obj: TJSONObject; El: TPasArrayType;
  6108. aContext: TPCUReaderContext);
  6109. begin
  6110. ReadPasElement(Obj,El,aContext);
  6111. ReadPasExprArray(Obj,El,'Ranges',El.Ranges,aContext);
  6112. if El.PackMode<>pmNone then
  6113. Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
  6114. ReadElType(Obj,'ElType',El,@Set_ArrayType_ElType,aContext);
  6115. end;
  6116. procedure TPCUReader.ReadFileType(Obj: TJSONObject; El: TPasFileType;
  6117. aContext: TPCUReaderContext);
  6118. begin
  6119. ReadPasElement(Obj,El,aContext);
  6120. ReadElType(Obj,'ElType',El,@Set_FileType_ElType,aContext);
  6121. end;
  6122. procedure TPCUReader.ReadEnumValue(Obj: TJSONObject; El: TPasEnumValue;
  6123. aContext: TPCUReaderContext);
  6124. begin
  6125. ReadPasElement(Obj,El,aContext);
  6126. El.Value:=ReadExpr(Obj,El,'Value',aContext);
  6127. end;
  6128. procedure TPCUReader.ReadEnumTypeScope(Obj: TJSONObject;
  6129. Scope: TPasEnumTypeScope; aContext: TPCUReaderContext);
  6130. begin
  6131. ReadElType(Obj,'CanonicalSet',Scope.Element,@Set_EnumTypeScope_CanonicalSet,aContext);
  6132. ReadIdentifierScope(Obj,Scope,aContext);
  6133. end;
  6134. procedure TPCUReader.ReadEnumType(Obj: TJSONObject; El: TPasEnumType;
  6135. aContext: TPCUReaderContext);
  6136. var
  6137. Scope: TPasEnumTypeScope;
  6138. begin
  6139. Scope:=TPasEnumTypeScope(Resolver.CreateScope(El,TPasEnumTypeScope));
  6140. El.CustomData:=Scope;
  6141. ReadPasElement(Obj,El,aContext);
  6142. ReadEnumTypeScope(Obj,Scope,aContext);
  6143. ReadElementList(Obj,El,'Values',El.Values,
  6144. {$IFDEF CheckPasTreeRefCount}'TPasEnumType.Values'{$ELSE}true{$ENDIF},
  6145. aContext);
  6146. end;
  6147. procedure TPCUReader.ReadSetType(Obj: TJSONObject; El: TPasSetType;
  6148. aContext: TPCUReaderContext);
  6149. begin
  6150. ReadPasElement(Obj,El,aContext);
  6151. ReadElType(Obj,'EnumType',El,@Set_SetType_EnumType,aContext);
  6152. ReadBoolean(Obj,'Packed',El.IsPacked,El);
  6153. end;
  6154. function TPCUReader.ReadPackedMode(Obj: TJSONObject; const PropName: string;
  6155. ErrorEl: TPasElement): TPackMode;
  6156. var
  6157. p: TPackMode;
  6158. s: string;
  6159. begin
  6160. Result:=pmNone;
  6161. if not ReadString(Obj,PropName,s,ErrorEl) then exit;
  6162. for p in TPackMode do
  6163. if s=PCUPackModeNames[p] then
  6164. exit(p);
  6165. RaiseMsg(20180210210038,ErrorEl,PropName+' "'+s+'"');
  6166. end;
  6167. procedure TPCUReader.ReadRecordVariant(Obj: TJSONObject; El: TPasVariant;
  6168. aContext: TPCUReaderContext);
  6169. begin
  6170. ReadPasElement(Obj,El,aContext);
  6171. ReadElementList(Obj,El,'Values',El.Values,
  6172. {$IFDEF CheckPasTreeRefCount}'TPasVariant.Values'{$ELSE}true{$ENDIF},
  6173. aContext);
  6174. ReadElType(Obj,'Members',El,@Set_Variant_Members,aContext);
  6175. end;
  6176. procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
  6177. aContext: TPCUReaderContext);
  6178. begin
  6179. ReadElementReference(Obj,Scope,'DefaultProperty',@Set_RecordScope_DefaultProperty);
  6180. ReadIdentifierScope(Obj,Scope,aContext);
  6181. end;
  6182. procedure TPCUReader.ReadRecordType(Obj: TJSONObject; El: TPasRecordType;
  6183. aContext: TPCUReaderContext);
  6184. var
  6185. Data: TJSONData;
  6186. Id: Integer;
  6187. Scope: TPasRecordScope;
  6188. begin
  6189. if FileVersion<3 then
  6190. RaiseMsg(20190109214718,El,'record format changed');
  6191. Scope:=TPasRecordScope(Resolver.CreateScope(El,TPasRecordScope));
  6192. El.CustomData:=Scope;
  6193. ReadPasElement(Obj,El,aContext);
  6194. El.PackMode:=ReadPackedMode(Obj,'Packed',El);
  6195. ReadElementList(Obj,El,'Members',El.Members,
  6196. {$IFDEF CheckPasTreeRefCount}'TPasRecordType.Members'{$ELSE}true{$ENDIF},
  6197. aContext);
  6198. // VariantEl: TPasElement can be TPasVariable or TPasType
  6199. Data:=Obj.Find('VariantEl');
  6200. if Data is TJSONIntegerNumber then
  6201. begin
  6202. Id:=Data.AsInteger;
  6203. PromiseSetElReference(Id,@Set_RecordType_VariantEl,El,El);
  6204. end
  6205. else if Data is TJSONObject then
  6206. El.VariantEl:=ReadElement(TJSONObject(Data),El,aContext);
  6207. ReadElementList(Obj,El,'Variants',El.Variants,
  6208. {$IFDEF CheckPasTreeRefCount}'TPasRecordType.Variants'{$ELSE}true{$ENDIF},
  6209. aContext);
  6210. ReadRecordScope(Obj,Scope,aContext);
  6211. end;
  6212. function TPCUReader.ReadClassInterfaceType(Obj: TJSONObject;
  6213. const PropName: string; ErrorEl: TPasElement;
  6214. DefaultValue: TPasClassInterfaceType): TPasClassInterfaceType;
  6215. var
  6216. s: string;
  6217. cit: TPasClassInterfaceType;
  6218. begin
  6219. if ReadString(Obj,PropName,s,ErrorEl) then
  6220. begin
  6221. for cit in TPasClassInterfaceType do
  6222. if s=PCUClassInterfaceTypeNames[cit] then
  6223. exit(cit);
  6224. RaiseMsg(20180329105126,ErrorEl,PropName+'='+s);
  6225. end
  6226. else
  6227. Result:=DefaultValue;
  6228. end;
  6229. function TPCUReader.ReadClassScopeFlags(Obj: TJSONObject; El: TPasElement;
  6230. const PropName: string; const DefaultValue: TPasClassScopeFlags
  6231. ): TPasClassScopeFlags;
  6232. var
  6233. Names: TStringDynArray;
  6234. Enable: TBooleanDynArray;
  6235. s: String;
  6236. f: TPasClassScopeFlag;
  6237. i: Integer;
  6238. Found: Boolean;
  6239. Data: TJSONData;
  6240. begin
  6241. Result:=DefaultValue;
  6242. {$IFDEF VerbosePCUFiler}
  6243. writeln('TPCUReader.ReadClassScopeFlags START');
  6244. {$ENDIF}
  6245. Data:=Obj.Find(PropName);
  6246. if Data=nil then exit;
  6247. ReadArrayFlags(Data,El,PropName,Names,Enable);
  6248. for i:=0 to length(Names)-1 do
  6249. begin
  6250. s:=Names[i];
  6251. Found:=false;
  6252. for f in TPasClassScopeFlag do
  6253. if s=PCUClassScopeFlagNames[f] then
  6254. begin
  6255. if Enable[i] then
  6256. Include(Result,f)
  6257. else
  6258. Exclude(Result,f);
  6259. Found:=true;
  6260. break;
  6261. end;
  6262. if not Found then
  6263. RaiseMsg(20180214115647,'unknown class scope flag "'+s+'"');
  6264. end;
  6265. end;
  6266. procedure TPCUReader.ReadClassScopeAbstractProcs(Obj: TJSONObject;
  6267. Scope: TPas2JSClassScope);
  6268. var
  6269. Arr: TJSONArray;
  6270. Data: TJSONData;
  6271. Id, i: Integer;
  6272. Ref: TPCUFilerElementRef;
  6273. begin
  6274. if not ReadArray(Obj,'AbstractProcs',Arr,Scope.Element) then exit;
  6275. SetLength(Scope.AbstractProcs,Arr.Count);
  6276. for i:=0 to Arr.Count-1 do
  6277. begin
  6278. Data:=Arr[i];
  6279. if Data is TJSONIntegerNumber then
  6280. begin
  6281. Id:=Data.AsInteger;
  6282. Ref:=GetElReference(Id,Scope.Element);
  6283. if (Ref=nil) or (Ref.Element=nil) then
  6284. RaiseMsg(20180214121727,Scope.Element,'['+IntToStr(i)+'] missing Id '+IntToStr(Id));
  6285. if Ref.Element is TPasProcedure then
  6286. Scope.AbstractProcs[i]:=TPasProcedure(Ref.Element) // no AddRef
  6287. else
  6288. RaiseMsg(20180214121902,Scope.Element,'['+IntToStr(i)+'] is '+GetObjName(Ref.Element));
  6289. end
  6290. else
  6291. RaiseMsg(20180214121627,Scope.Element,'['+IntToStr(i)+'] is '+GetObjName(Data));
  6292. end;
  6293. end;
  6294. procedure TPCUReader.ReadClassIntfMapProcs(Obj: TJSONObject;
  6295. Map: TPasClassIntfMap; OrigIntfType: TPasType);
  6296. var
  6297. aClass: TPasClassType;
  6298. Arr: TJSONArray;
  6299. i, Id: Integer;
  6300. Data: TJSONData;
  6301. IntfMember: TPasElement;
  6302. Ref: TPCUFilerElementRef;
  6303. begin
  6304. aClass:=Map.Element as TPasClassType;
  6305. if ReadArray(Obj,'Procs',Arr,aClass) then
  6306. begin
  6307. if Map.Procs<>nil then
  6308. RaiseMsg(20180329143122,aClass);
  6309. Map.Procs:=TFPList.Create;
  6310. if Arr.Count<>Map.Intf.Members.Count then
  6311. RaiseMsg(20180325130318,aClass,Map.Intf.FullPath+' Expected='+IntToStr(Map.Intf.Members.Count)+', but found '+IntToStr(Arr.Count));
  6312. for i:=0 to Arr.Count-1 do
  6313. begin
  6314. Data:=Arr[i];
  6315. IntfMember:=TPasElement(Map.Intf.Members[i]);
  6316. if (Data is TJSONIntegerNumber) then
  6317. begin
  6318. Id:=Data.AsInteger;
  6319. Ref:=AddElReference(Id,aClass,nil);
  6320. if Ref.Element=nil then
  6321. RaiseMsg(20180325125930,aClass,'missing method resolution of interface '+OrigIntfType.Name);
  6322. if not (Ref.Element is TPasProcedure) then
  6323. RaiseMsg(20180325130108,aClass,'['+IntToStr(i)+']='+OrigIntfType.Name+'.'+GetObjName(IntfMember)+' method expected, but found '+GetObjName(Ref.Element));
  6324. if not (IntfMember is TPasProcedure) then
  6325. RaiseMsg(20180329134354,aClass,'['+IntToStr(i)+']='+OrigIntfType.Name+'.'+GetObjName(IntfMember)+' intf member is not method, mapped proc='+GetObjName(Ref.Element));
  6326. Map.Procs.Add(Ref.Element);
  6327. end
  6328. else if Data is TJSONNull then
  6329. begin
  6330. if IntfMember is TPasProcedure then
  6331. RaiseMsg(20180329132957,aClass,'['+IntToStr(i)+']='+OrigIntfType.Name+'.'+GetObjName(IntfMember)+' intf method expects implementation');
  6332. Map.Procs.Add(nil);
  6333. end
  6334. else
  6335. RaiseMsg(20180325125851,aClass,IntToStr(i)+' '+GetObjName(Data));
  6336. end;
  6337. end
  6338. else if Map.Intf.Members.Count>0 then
  6339. RaiseMsg(20180325130720,aClass,Map.Intf.FullPath+' Expected='+IntToStr(Map.Intf.Members.Count)+', but found 0');
  6340. end;
  6341. procedure TPCUReader.ReadClassIntfMap(Obj: TJSONObject; Scope: TPas2JSClassScope;
  6342. Map: TPasClassIntfMap; OrigIntfType: TPasType);
  6343. var
  6344. aClass: TPasClassType;
  6345. Id: Integer;
  6346. Data: TJSONData;
  6347. Ref: TPCUFilerElementRef;
  6348. AncObj: TJSONObject;
  6349. begin
  6350. aClass:=Scope.Element as TPasClassType;
  6351. Map.Element:=aClass;
  6352. // Intf
  6353. Data:=Obj.Find('Intf');
  6354. if not (Data is TJSONIntegerNumber) then
  6355. RaiseMsg(20180325130226,aClass,OrigIntfType.Name);
  6356. Id:=Data.AsInteger;
  6357. Ref:=AddElReference(Id,aClass,nil);
  6358. if not (Ref.Element is TPasClassType) then
  6359. RaiseMsg(20180325131020,aClass,OrigIntfType.Name+' '+GetObjName(Ref.Element));
  6360. Map.Intf:=TPasClassType(Ref.Element);
  6361. // Procs
  6362. ReadClassIntfMapProcs(Obj,Map,OrigIntfType);
  6363. // AncestorMap
  6364. if ReadObject(Obj,'AncestorMap',AncObj,aClass) then
  6365. begin
  6366. Map.AncestorMap:=TPasClassIntfMap.Create;
  6367. ReadClassIntfMap(AncObj,Scope,Map.AncestorMap,OrigIntfType);
  6368. end;
  6369. end;
  6370. procedure TPCUReader.ReadClassScopeInterfaces(Obj: TJSONObject;
  6371. Scope: TPas2JSClassScope);
  6372. var
  6373. aClass: TPasClassType;
  6374. Arr: TJSONArray;
  6375. i, Id: Integer;
  6376. Data: TJSONData;
  6377. Ref: TPCUFilerElementRef;
  6378. OrigIntfType, IntfType: TPasType;
  6379. SubObj: TJSONObject;
  6380. Map: TPasClassIntfMap;
  6381. begin
  6382. aClass:=Scope.Element as TPasClassType;
  6383. if ReadArray(Obj,'SInterfaces',Arr,aClass) then
  6384. begin
  6385. if Arr.Count<>aClass.Interfaces.Count then
  6386. RaiseMsg(20180325124134,aClass);
  6387. if Scope.Interfaces=nil then
  6388. Scope.Interfaces:=TFPList.Create;
  6389. if Scope.Interfaces.Count>0 then
  6390. RaiseMsg(20180325124546,aClass);
  6391. for i:=0 to Arr.Count-1 do
  6392. begin
  6393. OrigIntfType:=TPasType(aClass.Interfaces[i]);
  6394. IntfType:=Resolver.ResolveAliasType(OrigIntfType);
  6395. if not (IntfType is TPasClassType) then
  6396. RaiseMsg(20180325124401,aClass,IntToStr(i)+' '+GetObjName(IntfType));
  6397. Data:=Arr[i];
  6398. if Data is TJSONIntegerNumber then
  6399. begin
  6400. // property, interface delegation
  6401. Id:=Data.AsInteger;
  6402. Ref:=AddElReference(Id,aClass,nil);
  6403. if Ref.Element=nil then
  6404. RaiseMsg(20180325124421,aClass,'missing delegation property of interface '+OrigIntfType.Name);
  6405. if not (Ref.Element is TPasProperty) then
  6406. RaiseMsg(20180325124616,aClass,OrigIntfType.Name+' delegate: '+GetObjName(Ref.Element));
  6407. Scope.Interfaces.Add(Ref.Element);
  6408. end
  6409. else if Data is TJSONObject then
  6410. begin
  6411. // map
  6412. SubObj:=TJSONObject(Data);
  6413. Map:=TPasClassIntfMap.Create;
  6414. Scope.Interfaces.Add(Map);
  6415. ReadClassIntfMap(SubObj,Scope,Map,OrigIntfType);
  6416. end
  6417. else
  6418. RaiseMsg(20180325124206,aClass,OrigIntfType.Name);
  6419. end;
  6420. end
  6421. else if aClass.Interfaces.Count>0 then
  6422. begin
  6423. RaiseMsg(20180325131248,aClass);
  6424. end;
  6425. end;
  6426. procedure TPCUReader.ReadClassScope(Obj: TJSONObject; Scope: TPas2JSClassScope;
  6427. aContext: TPCUReaderContext);
  6428. var
  6429. aClass: TPasClassType;
  6430. CanonicalClassOf: TPasClassOfType;
  6431. begin
  6432. aClass:=Scope.Element as TPasClassType;
  6433. if aClass.ObjKind=okClass then
  6434. begin
  6435. CanonicalClassOf:=TPasClassOfType(CreateElement(TPasClassOfType,'Self',aClass));
  6436. Scope.CanonicalClassOf:=CanonicalClassOf;
  6437. CanonicalClassOf.Visibility:=visStrictPrivate;
  6438. CanonicalClassOf.SourceFilename:=aClass.SourceFilename;
  6439. CanonicalClassOf.SourceLinenumber:=aClass.SourceLinenumber;
  6440. CanonicalClassOf.DestType:=aClass;
  6441. aClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasClassScope.CanonicalClassOf'){$ENDIF};
  6442. end;
  6443. ReadElementReference(Obj,Scope,'NewInstanceFunction',@Set_ClassScope_NewInstanceFunction);
  6444. ReadElementReference(Obj,Scope,'DirectAncestor',@Set_ClassScope_DirectAncestor);
  6445. ReadElementReference(Obj,Scope,'DefaultProperty',@Set_ClassScope_DefaultProperty);
  6446. Scope.Flags:=ReadClassScopeFlags(Obj,Scope.Element,'SFlags',GetDefaultClassScopeFlags(Scope));
  6447. if not ReadString(Obj,'SGUID',Scope.GUID,aClass) then
  6448. Scope.GUID:='';
  6449. ReadIdentifierScope(Obj,Scope,aContext);
  6450. end;
  6451. procedure TPCUReader.ReadClassType(Obj: TJSONObject; El: TPasClassType;
  6452. aContext: TPCUReaderContext);
  6453. var
  6454. Arr: TJSONArray;
  6455. i: Integer;
  6456. Data: TJSONData;
  6457. Scope: TPas2JSClassScope;
  6458. Ref: TResolvedReference;
  6459. Parent: TPasElement;
  6460. SectionScope: TPasSectionScope;
  6461. begin
  6462. ReadBoolean(Obj,'Forward',El.IsForward,El);
  6463. if El.IsForward then
  6464. begin
  6465. Scope:=nil;
  6466. Ref:=TResolvedReference.Create;
  6467. Resolver.AddResolveData(El,Ref,lkModule);
  6468. ReadResolvedReference(Obj,Ref,El);
  6469. end
  6470. else
  6471. begin
  6472. if Obj.Find('Scope') is TJSONBoolean then
  6473. Scope:=nil // msIgnoreInterfaces
  6474. else
  6475. begin
  6476. Scope:=TPas2JSClassScope(Resolver.CreateScope(El,Resolver.ScopeClass_Class));
  6477. El.CustomData:=Scope;
  6478. end;
  6479. end;
  6480. ReadPasElement(Obj,El,aContext);
  6481. El.PackMode:=ReadPackedMode(Obj,'Packed',El);
  6482. // ObjKind is the 'Type'
  6483. El.InterfaceType:=ReadClassInterfaceType(Obj,'IntfType',El,citCom);
  6484. ReadElType(Obj,'Ancestor',El,@Set_ClassType_AncestorType,aContext);
  6485. ReadElType(Obj,'HelperFor',El,@Set_ClassType_HelperForType,aContext);
  6486. ReadBoolean(Obj,'External',El.IsExternal,El);
  6487. // not needed IsShortDefinition: Boolean; -> class(anchestor); without end
  6488. El.GUIDExpr:=ReadExpr(Obj,El,'GUID',aContext);
  6489. // Modifiers
  6490. if ReadArray(Obj,'Modifiers',Arr,El) then
  6491. begin
  6492. for i:=0 to Arr.Count-1 do
  6493. begin
  6494. Data:=Arr[i];
  6495. if not (Data is TJSONString) then
  6496. RaiseMsg(20180210211250,El,'Modifiers['+IntToStr(i)+'] '+GetObjName(Data));
  6497. El.Modifiers.Add(String(Data.AsString));
  6498. end;
  6499. end;
  6500. ReadElementList(Obj,El,'Interfaces',El.Interfaces,
  6501. {$IFDEF CheckPasTreeRefCount}'TPasClassType.Interfaces'{$ELSE}true{$ENDIF},
  6502. aContext);
  6503. ReadString(Obj,'ExternalNameSpace',El.ExternalNameSpace,El);
  6504. ReadString(Obj,'ExternalName',El.ExternalName,El);
  6505. if Scope<>nil then
  6506. ReadClassScope(Obj,Scope,aContext);
  6507. // read Members
  6508. ReadElementList(Obj,El,'Members',El.Members,
  6509. {$IFDEF CheckPasTreeRefCount}'TPasClassType.Members'{$ELSE}true{$ENDIF},
  6510. aContext);
  6511. if Scope<>nil then
  6512. begin
  6513. ReadClassScopeAbstractProcs(Obj,Scope);
  6514. ReadClassScopeInterfaces(Obj,Scope);
  6515. if El.ObjKind in okAllHelpers then
  6516. begin
  6517. // restore cached helpers in interface
  6518. Parent:=El.Parent;
  6519. while Parent<>nil do
  6520. begin
  6521. if Parent.ClassType=TInterfaceSection then
  6522. begin
  6523. SectionScope:=Parent.CustomData as TPasSectionScope;
  6524. Resolver.AddHelper(El,SectionScope.Helpers);
  6525. break;
  6526. end;
  6527. Parent:=Parent.Parent;
  6528. end;
  6529. end;
  6530. end;
  6531. end;
  6532. procedure TPCUReader.ReadArgument(Obj: TJSONObject; El: TPasArgument;
  6533. aContext: TPCUReaderContext);
  6534. var
  6535. s: string;
  6536. Found: Boolean;
  6537. Arg: TArgumentAccess;
  6538. begin
  6539. ReadPasElement(Obj,El,aContext);
  6540. if ReadString(Obj,'Access',s,El) then
  6541. begin
  6542. Found:=false;
  6543. for Arg in TArgumentAccess do
  6544. if s=PCUArgumentAccessNames[Arg] then
  6545. begin
  6546. El.Access:=Arg;
  6547. Found:=true;
  6548. break;
  6549. end;
  6550. if not Found then
  6551. RaiseMsg(20180210205544,El,'Access "'+s+'"');
  6552. end;
  6553. ReadElType(Obj,'ArgType',El,@Set_Argument_ArgType,aContext);
  6554. El.ValueExpr:=ReadExpr(Obj,El,'Value',aContext);
  6555. end;
  6556. function TPCUReader.ReadProcTypeModifiers(Obj: TJSONObject; El: TPasElement;
  6557. const PropName: string; const DefaultValue: TProcTypeModifiers
  6558. ): TProcTypeModifiers;
  6559. var
  6560. Names: TStringDynArray;
  6561. Enable: TBooleanDynArray;
  6562. s: String;
  6563. f: TProcTypeModifier;
  6564. i: Integer;
  6565. Found: Boolean;
  6566. Data: TJSONData;
  6567. begin
  6568. Result:=DefaultValue;
  6569. {$IFDEF VerbosePCUFiler}
  6570. writeln('TPCUReader.ReadProcTypeModifiers START');
  6571. {$ENDIF}
  6572. Data:=Obj.Find(PropName);
  6573. if Data=nil then exit;
  6574. ReadArrayFlags(Data,El,PropName,Names,Enable);
  6575. for i:=0 to length(Names)-1 do
  6576. begin
  6577. s:=Names[i];
  6578. Found:=false;
  6579. for f in TProcTypeModifier do
  6580. if s=PCUProcTypeModifierNames[f] then
  6581. begin
  6582. if Enable[i] then
  6583. Include(Result,f)
  6584. else
  6585. Exclude(Result,f);
  6586. Found:=true;
  6587. break;
  6588. end;
  6589. if not Found then
  6590. RaiseMsg(20180210212015,'unknown procedure modifier "'+s+'"');
  6591. end;
  6592. end;
  6593. procedure TPCUReader.ReadProcedureType(Obj: TJSONObject; El: TPasProcedureType;
  6594. aContext: TPCUReaderContext);
  6595. var
  6596. s: string;
  6597. Found: Boolean;
  6598. c: TCallingConvention;
  6599. begin
  6600. ReadPasElement(Obj,El,aContext);
  6601. ReadElementList(Obj,El,'Args',El.Args,
  6602. {$IFDEF CheckPasTreeRefCount}'TPasProcedureType.Args'{$ELSE}true{$ENDIF},
  6603. aContext);
  6604. if ReadString(Obj,'Call',s,El) then
  6605. begin
  6606. Found:=false;
  6607. for c in TCallingConvention do
  6608. if s=PCUCallingConventionNames[c] then
  6609. begin
  6610. El.CallingConvention:=c;
  6611. Found:=true;
  6612. break;
  6613. end;
  6614. if not Found then
  6615. RaiseMsg(20180210212130,El,'Call "'+s+'"');
  6616. end;
  6617. El.Modifiers:=ReadProcTypeModifiers(Obj,El,'Modifiers',GetDefaultProcTypeModifiers(El));
  6618. end;
  6619. procedure TPCUReader.ReadResultElement(Obj: TJSONObject; El: TPasResultElement;
  6620. aContext: TPCUReaderContext);
  6621. begin
  6622. ReadPasElement(Obj,El,aContext);
  6623. ReadElType(Obj,'Result',El,@Set_ResultElement_ResultType,aContext);
  6624. end;
  6625. procedure TPCUReader.ReadFunctionType(Obj: TJSONObject; El: TPasFunctionType;
  6626. aContext: TPCUReaderContext);
  6627. begin
  6628. ReadProcedureType(Obj,El,aContext);
  6629. El.ResultEl:=TPasResultElement(ReadElementProperty(Obj,El,'Result',TPasResultElement,aContext));
  6630. end;
  6631. procedure TPCUReader.ReadStringType(Obj: TJSONObject; El: TPasStringType;
  6632. aContext: TPCUReaderContext);
  6633. begin
  6634. ReadPasElement(Obj,El,aContext);
  6635. ReadString(Obj,'Length',El.LengthExpr,El);
  6636. end;
  6637. function TPCUReader.ReadVarModifiers(Obj: TJSONObject; El: TPasElement;
  6638. const PropName: string; const DefaultValue: TVariableModifiers
  6639. ): TVariableModifiers;
  6640. var
  6641. Names: TStringDynArray;
  6642. Enable: TBooleanDynArray;
  6643. s: String;
  6644. f: TVariableModifier;
  6645. i: Integer;
  6646. Found: Boolean;
  6647. Data: TJSONData;
  6648. begin
  6649. Result:=DefaultValue;
  6650. {$IFDEF VerbosePCUFiler}
  6651. writeln('TPCUReader.ReadVarModifiers START');
  6652. {$ENDIF}
  6653. Data:=Obj.Find(PropName);
  6654. if Data=nil then exit;
  6655. ReadArrayFlags(Data,El,PropName,Names,Enable);
  6656. for i:=0 to length(Names)-1 do
  6657. begin
  6658. s:=Names[i];
  6659. Found:=false;
  6660. for f in TVariableModifier do
  6661. if s=PCUVarModifierNames[f] then
  6662. begin
  6663. if Enable[i] then
  6664. Include(Result,f)
  6665. else
  6666. Exclude(Result,f);
  6667. Found:=true;
  6668. break;
  6669. end;
  6670. if not Found then
  6671. RaiseMsg(20180207184723,'unknown var modifier "'+s+'"');
  6672. end;
  6673. end;
  6674. procedure TPCUReader.ReadVariable(Obj: TJSONObject; El: TPasVariable;
  6675. aContext: TPCUReaderContext);
  6676. begin
  6677. ReadPasElement(Obj,El,aContext);
  6678. ReadElType(Obj,'VarType',El,@Set_Variable_VarType,aContext);
  6679. El.VarModifiers:=ReadVarModifiers(Obj,El,'VarMods',[]);
  6680. El.LibraryName:=ReadExpr(Obj,El,'Library',aContext);
  6681. El.ExportName:=ReadExpr(Obj,El,'Export',aContext);
  6682. El.AbsoluteExpr:=ReadExpr(Obj,El,'Absolute',aContext);
  6683. El.Expr:=ReadExpr(Obj,El,'Expr',aContext);
  6684. end;
  6685. procedure TPCUReader.ReadExportSymbol(Obj: TJSONObject; El: TPasExportSymbol;
  6686. aContext: TPCUReaderContext);
  6687. begin
  6688. ReadPasElement(Obj,El,aContext);
  6689. El.ExportName:=ReadExpr(Obj,El,'ExportName',aContext);
  6690. El.ExportIndex:=ReadExpr(Obj,El,'ExportIndex',aContext);
  6691. end;
  6692. procedure TPCUReader.ReadConst(Obj: TJSONObject; El: TPasConst;
  6693. aContext: TPCUReaderContext);
  6694. begin
  6695. ReadVariable(Obj,El,aContext);
  6696. if not ReadBoolean(Obj,'IsConst',El.IsConst,El) then
  6697. El.IsConst:=Obj.Find('VarType')=nil;
  6698. end;
  6699. procedure TPCUReader.ReadPropertyScope(Obj: TJSONObject;
  6700. Scope: TPasPropertyScope; aContext: TPCUReaderContext);
  6701. begin
  6702. ReadElementReference(Obj,Scope,'AncestorProp',@Set_PropertyScope_AncestorProp);
  6703. ReadIdentifierScope(Obj,Scope,aContext);
  6704. end;
  6705. procedure TPCUReader.ReadProperty(Obj: TJSONObject; El: TPasProperty;
  6706. aContext: TPCUReaderContext);
  6707. var
  6708. Scope: TPasPropertyScope;
  6709. Expr: TPasExpr;
  6710. begin
  6711. if Obj.Find('Scope') is TJSONBoolean then
  6712. Scope:=nil // msIgnoreInterfaces
  6713. else
  6714. begin
  6715. Scope:=TPasPropertyScope(Resolver.CreateScope(El,TPasPropertyScope));
  6716. El.CustomData:=Scope;
  6717. end;
  6718. ReadVariable(Obj,El,aContext);
  6719. El.IndexExpr:=ReadExpr(Obj,El,'Index',aContext);
  6720. El.ReadAccessor:=ReadExpr(Obj,El,'Read',aContext);
  6721. El.WriteAccessor:=ReadExpr(Obj,El,'Write',aContext);
  6722. if FileVersion<2 then
  6723. begin
  6724. if Obj.Find('Implements')<>nil then
  6725. begin
  6726. Expr:=ReadExpr(Obj,El,'Implements',aContext);
  6727. SetLength(El.Implements,1);
  6728. El.Implements[0]:=Expr;
  6729. end;
  6730. end
  6731. else
  6732. ReadPasExprArray(Obj,El,'Implements',El.Implements,aContext);
  6733. El.DispIDExpr:=ReadExpr(Obj,El,'DispId',aContext);
  6734. El.StoredAccessor:=ReadExpr(Obj,El,'Stored',aContext);
  6735. El.DefaultExpr:=ReadExpr(Obj,El,'DefaultValue',aContext);
  6736. ReadElementList(Obj,El,'Args',El.Args,
  6737. {$IFDEF CheckPasTreeRefCount}'TPasProperty.Args'{$ELSE}true{$ENDIF},
  6738. aContext);
  6739. //ReadAccessorName: string; // not used by resolver
  6740. //WriteAccessorName: string; // not used by resolver
  6741. //ImplementsName: string; // not used by resolver
  6742. //StoredAccessorName: string; // not used by resolver
  6743. ReadBoolean(Obj,'ReadOnly',El.DispIDReadOnly,El);
  6744. ReadBoolean(Obj,'Default',El.IsDefault,El);
  6745. ReadBoolean(Obj,'NoDefault',El.IsNodefault,El);
  6746. if Scope<>nil then
  6747. ReadPropertyScope(Obj,Scope,aContext);
  6748. end;
  6749. procedure TPCUReader.ReadMethodResolution(Obj: TJSONObject;
  6750. El: TPasMethodResolution; aContext: TPCUReaderContext);
  6751. var
  6752. s: string;
  6753. begin
  6754. ReadPasElement(Obj,El,aContext);
  6755. if ReadString(Obj,'ProcClass',s,El) then
  6756. case s of
  6757. 'procedure': El.ProcClass:=TPasProcedure;
  6758. else
  6759. RaiseMsg(20180329104616,El,s);
  6760. end
  6761. else
  6762. El.ProcClass:=TPasFunction;
  6763. El.InterfaceProc:=ReadExpr(Obj,El,'InterfaceProc',aContext);
  6764. El.InterfaceName:=ReadExpr(Obj,El,'InterfaceName',aContext);
  6765. El.ImplementationProc:=ReadExpr(Obj,El,'ImplementationProc',aContext);
  6766. end;
  6767. function TPCUReader.ReadProcedureModifiers(Obj: TJSONObject; El: TPasElement;
  6768. const PropName: string; const DefaultValue: TProcedureModifiers
  6769. ): TProcedureModifiers;
  6770. var
  6771. Names: TStringDynArray;
  6772. Enable: TBooleanDynArray;
  6773. s: String;
  6774. f: TProcedureModifier;
  6775. i: Integer;
  6776. Found: Boolean;
  6777. Data: TJSONData;
  6778. begin
  6779. Result:=DefaultValue;
  6780. {$IFDEF VerbosePCUFiler}
  6781. writeln('TPCUReader.ReadProcedureModifiers START');
  6782. {$ENDIF}
  6783. Data:=Obj.Find(PropName);
  6784. if Data=nil then exit;
  6785. ReadArrayFlags(Data,El,PropName,Names,Enable);
  6786. for i:=0 to length(Names)-1 do
  6787. begin
  6788. s:=Names[i];
  6789. Found:=false;
  6790. for f in TProcedureModifier do
  6791. if s=PCUProcedureModifierNames[f] then
  6792. begin
  6793. if Enable[i] then
  6794. Include(Result,f)
  6795. else
  6796. Exclude(Result,f);
  6797. Found:=true;
  6798. break;
  6799. end;
  6800. if not Found then
  6801. RaiseMsg(20180211110407,'unknown proc modifier "'+s+'"');
  6802. end;
  6803. end;
  6804. function TPCUReader.ReadProcScopeFlags(Obj: TJSONObject; El: TPasElement;
  6805. const PropName: string; const DefaultValue: TPasProcedureScopeFlags
  6806. ): TPasProcedureScopeFlags;
  6807. var
  6808. Names: TStringDynArray;
  6809. Enable: TBooleanDynArray;
  6810. s: String;
  6811. f: TPasProcedureScopeFlag;
  6812. i: Integer;
  6813. Found: Boolean;
  6814. Data: TJSONData;
  6815. begin
  6816. Result:=DefaultValue;
  6817. {$IFDEF VerbosePCUFiler}
  6818. writeln('TPCUReader.ReadProcedureScopeFlags START');
  6819. {$ENDIF}
  6820. Data:=Obj.Find(PropName);
  6821. if Data=nil then exit;
  6822. ReadArrayFlags(Data,El,PropName,Names,Enable);
  6823. for i:=0 to length(Names)-1 do
  6824. begin
  6825. s:=Names[i];
  6826. Found:=false;
  6827. for f in TPasProcedureScopeFlag do
  6828. if s=PCUProcedureScopeFlagNames[f] then
  6829. begin
  6830. if Enable[i] then
  6831. Include(Result,f)
  6832. else
  6833. Exclude(Result,f);
  6834. Found:=true;
  6835. break;
  6836. end;
  6837. if not Found then
  6838. RaiseMsg(20180213220601,'unknown proc scope flag "'+s+'"');
  6839. end;
  6840. end;
  6841. procedure TPCUReader.ReadProcedureScope(Obj: TJSONObject;
  6842. Scope: TPas2JSProcedureScope; aContext: TPCUReaderContext);
  6843. var
  6844. Proc: TPasProcedure;
  6845. begin
  6846. Proc:=Scope.Element as TPasProcedure;
  6847. ReadString(Obj,'ResultVarName',Scope.ResultVarName,Proc);
  6848. // Scope.OverloadName is already set in ReadProcedure
  6849. ReadElementReference(Obj,Scope,'ImplProc',@Set_ProcedureScope_ImplProc);
  6850. ReadElementReference(Obj,Scope,'Overridden',@Set_ProcedureScope_Overridden);
  6851. if Proc.Parent is TPasMembersType then
  6852. Scope.ClassRecScope:=Proc.Parent.CustomData as TPasClassOrRecordScope // no AddRef
  6853. else
  6854. ; // set via Set_ProcedureScope_ImplProc
  6855. // Scope.SelfArg only valid for method implementation
  6856. Scope.Flags:=ReadProcScopeFlags(Obj,Proc,'SFlags',[]);
  6857. Scope.BoolSwitches:=ReadBoolSwitches(Obj,Proc,'BoolSwitches',aContext.BoolSwitches);
  6858. Scope.ModeSwitches:=ReadModeSwitches(Obj,Proc,'ModeSwitches',aContext.ModeSwitches);
  6859. //ReadIdentifierScope(Obj,Scope,aContext);
  6860. end;
  6861. procedure TPCUReader.ReadProcScopeReferences(Obj: TJSONObject;
  6862. ImplScope: TPas2JSProcedureScope);
  6863. var
  6864. DeclScope: TPasProcedureScope;
  6865. DeclProc: TPasProcedure;
  6866. begin
  6867. // Note: the References are stored in the scope object of the declaration proc,
  6868. // But TPCUWriter stores them in the implementation scope, so that all
  6869. // references can be resolved immediately.
  6870. if ImplScope.ImplProc<>nil then
  6871. RaiseMsg(20180318212631,ImplScope.Element);
  6872. DeclProc:=ImplScope.DeclarationProc;
  6873. if DeclProc=nil then
  6874. DeclProc:=ImplScope.Element as TPasProcedure;
  6875. DeclScope:=DeclProc.CustomData as TPasProcedureScope;
  6876. if DeclScope.References<>nil then
  6877. RaiseMsg(20180221172403,DeclProc);
  6878. ReadScopeReferences(Obj,DeclScope,'Refs',DeclScope.References);
  6879. end;
  6880. procedure TPCUReader.ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure;
  6881. aContext: TPCUReaderContext);
  6882. var
  6883. ImplScope: TPas2JSProcedureScope;
  6884. s: string;
  6885. Arr: TJSONArray;
  6886. i: Integer;
  6887. Data: TJSONData;
  6888. begin
  6889. ImplScope:=TPas2JSProcedureScope(El.CustomData);
  6890. if ImplScope.BodyJS<>'' then
  6891. RaiseMsg(20180228231510,El);
  6892. if ImplScope.GlobalJS<>nil then
  6893. RaiseMsg(20180228231511,El);
  6894. if not ReadString(Obj,'Body',s,El) then
  6895. RaiseMsg(20180228131232,El);
  6896. ReadBoolean(Obj,'Empty',ImplScope.EmptyJS,El);
  6897. ImplScope.BodyJS:=s;
  6898. if ReadArray(Obj,'Globals',Arr,El) then
  6899. begin
  6900. for i:=0 to Arr.Count-1 do
  6901. begin
  6902. Data:=Arr[i];
  6903. if not (Data is TJSONString) then
  6904. RaiseMsg(20180228231555,El,IntToStr(i)+':'+GetObjName(Data));
  6905. ImplScope.AddGlobalJS(Data.AsString);
  6906. end;
  6907. end;
  6908. if aContext=nil then ;
  6909. end;
  6910. procedure TPCUReader.ReadProcedure(Obj: TJSONObject; El: TPasProcedure;
  6911. aContext: TPCUReaderContext);
  6912. var
  6913. DefProcMods: TProcedureModifiers;
  6914. t: TProcedureMessageType;
  6915. s: string;
  6916. Found: Boolean;
  6917. Scope: TPas2JSProcedureScope;
  6918. DeclProcId: integer;
  6919. Ref: TPCUFilerElementRef;
  6920. DeclProc: TPasProcedure;
  6921. p: SizeInt;
  6922. begin
  6923. if Obj.Find('Scope') is TJSONBoolean then
  6924. Scope:=nil // msIgnoreInterfaces
  6925. else
  6926. begin
  6927. Scope:=TPas2JSProcedureScope(Resolver.CreateScope(El,Resolver.ScopeClass_Procedure));
  6928. El.CustomData:=Scope;
  6929. p:=Pos('$',El.Name);
  6930. if p>0 then
  6931. begin
  6932. // overload proc name$2 was stored in 'Name'
  6933. Scope.OverloadName:=El.Name;
  6934. El.Name:=LeftStr(El.Name,p-1);
  6935. end;
  6936. end;
  6937. ReadPasElement(Obj,El,aContext);
  6938. if ReadInteger(Obj,'DeclarationProc',DeclProcId,El) then
  6939. begin
  6940. // ImplProc
  6941. Ref:=GetElReference(DeclProcId,El);
  6942. if (Ref=nil) or (Ref.Element=nil) then
  6943. RaiseMsg(20180219140423,El,'missing DeclarationProc '+IntToStr(DeclProcId));
  6944. if not (Ref.Element is TPasProcedure) then
  6945. RaiseMsg(20180219140547,El,'DeclarationProc='+GetObjName(Ref.Element));
  6946. DeclProc:=TPasProcedure(Ref.Element);
  6947. Scope.DeclarationProc:=DeclProc; // no AddRef
  6948. El.ProcType:=TPasProcedureType(CreateElement(TPasProcedureTypeClass(DeclProc.ProcType.ClassType),'',DeclProc));
  6949. end
  6950. else
  6951. begin
  6952. // declarationproc
  6953. El.PublicName:=ReadExpr(Obj,El,'Public',aContext);
  6954. // e.g. external LibraryExpr name LibrarySymbolName;
  6955. El.LibraryExpr:=ReadExpr(Obj,El,'Lib',aContext);
  6956. El.LibrarySymbolName:=ReadExpr(Obj,El,'LibName',aContext);
  6957. El.DispIDExpr:=ReadExpr(Obj,El,'DispId',aContext);
  6958. ReadString(Obj,'Alias',El.AliasName,El);
  6959. if ReadString(Obj,'Message',s,El) then
  6960. begin
  6961. El.MessageName:=s;
  6962. El.MessageType:=pmtInteger;
  6963. if ReadString(Obj,'MessageType',s,El) then
  6964. begin
  6965. Found:=false;
  6966. for t in TProcedureMessageType do
  6967. if s=PCUProcedureMessageTypeNames[t] then
  6968. begin
  6969. El.MessageType:=t;
  6970. Found:=true;
  6971. break;
  6972. end;
  6973. if not Found then
  6974. RaiseMsg(20180211104537,El,'MessageType "'+s+'"');
  6975. end;
  6976. end;
  6977. DefProcMods:=GetDefaultProcModifiers(El);
  6978. El.Modifiers:=ReadProcedureModifiers(Obj,El,'PMods',DefProcMods);
  6979. // read ProcType after El.Modifiers
  6980. El.ProcType:=TPasProcedureType(ReadElementProperty(
  6981. Obj,El,'ProcType',TPasProcedureType,aContext));
  6982. if Scope<>nil then
  6983. ReadProcedureScope(Obj,Scope,aContext);
  6984. end;
  6985. if (Scope<>nil) and (Obj.Find('ImplProc')=nil) then
  6986. ReadProcScopeReferences(Obj,Scope);
  6987. if Obj.Find('Body')<>nil then
  6988. ReadProcedureBody(Obj,El,aContext);
  6989. end;
  6990. procedure TPCUReader.ReadOperator(Obj: TJSONObject; El: TPasOperator;
  6991. aContext: TPCUReaderContext);
  6992. var
  6993. s: string;
  6994. Found, b: Boolean;
  6995. t: TOperatorType;
  6996. begin
  6997. ReadProcedure(Obj,El,aContext);
  6998. if ReadString(Obj,'Operator',s,El) then
  6999. begin
  7000. Found:=false;
  7001. for t in TOperatorType do
  7002. if s=PCUOperatorTypeNames[t] then
  7003. begin
  7004. El.OperatorType:=t;
  7005. Found:=true;
  7006. break;
  7007. end;
  7008. if not Found then
  7009. RaiseMsg(20180211110647,El,'Operator "'+s+'"');
  7010. end;
  7011. if ReadBoolean(Obj,'TokenBased',b,El) then
  7012. El.TokenBased:=b;
  7013. end;
  7014. procedure TPCUReader.ResolvePending;
  7015. var
  7016. i: Integer;
  7017. PendingIdentifierScope: TPCUReaderPendingIdentifierScope;
  7018. Node: TAVLTreeNode;
  7019. Ref: TPCUFilerElementRef;
  7020. begin
  7021. for i:=0 to FPendingIdentifierScopes.Count-1 do
  7022. begin
  7023. PendingIdentifierScope:=TPCUReaderPendingIdentifierScope(FPendingIdentifierScopes[i]);
  7024. ReadIdentifierScopeArray(PendingIdentifierScope.Arr,PendingIdentifierScope.Scope);
  7025. end;
  7026. FPendingIdentifierScopes.Clear;
  7027. Node:=FElementRefs.FindLowest;
  7028. while Node<>nil do
  7029. begin
  7030. Ref:=TPCUFilerElementRef(Node.Data);
  7031. Node:=FElementRefs.FindSuccessor(Node);
  7032. if Ref.Pending<>nil then
  7033. begin
  7034. {$IFDEF VerbosePCUFiler}
  7035. writeln('TPCUReader.ResolvePending Ref.Id=',Ref.Id,' Ref.Element=',GetObjName(Ref.Element));
  7036. {$ENDIF}
  7037. if Ref.Pending.ErrorEl<>nil then
  7038. RaiseMsg(20180207194340,Ref.Pending.ErrorEl,IntToStr(Ref.Id))
  7039. else
  7040. RaiseMsg(20180207194341,Ref.Element,IntToStr(Ref.Id))
  7041. end;
  7042. end;
  7043. end;
  7044. procedure TPCUReader.ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement);
  7045. var
  7046. Arr: TJSONArray;
  7047. Data: TJSONData;
  7048. SubObj: TJSONObject;
  7049. aName, s: string;
  7050. bt: TResolverBaseType;
  7051. El: TPasElement;
  7052. Id, i: integer;
  7053. Found: Boolean;
  7054. BuiltInProc: TResElDataBuiltInProc;
  7055. bp: TResolverBuiltInProc;
  7056. pbt: TPas2jsBaseType;
  7057. begin
  7058. if not ReadArray(Obj,BuiltInNodeName,Arr,ErrorEl) then exit;
  7059. for i:=0 to Arr.Count-1 do
  7060. begin
  7061. Data:=Arr[i];
  7062. if not (Data is TJSONObject) then
  7063. RaiseMsg(20180215152600,ErrorEl);
  7064. SubObj:=TJSONObject(Data);
  7065. if not ReadString(SubObj,'Name',aName,ErrorEl) then
  7066. RaiseMsg(20180215153027,ErrorEl);
  7067. if not ReadInteger(SubObj,'Id',Id,ErrorEl) then
  7068. RaiseMsg(20180215153028,ErrorEl,aName);
  7069. Found:=false;
  7070. for bt in TResolverBaseType do
  7071. begin
  7072. El:=Resolver.BaseTypes[bt];
  7073. if (El<>nil) and (CompareText(El.Name,aName)=0) then
  7074. begin
  7075. AddElReference(Id,ErrorEl,El);
  7076. Found:=true;
  7077. break;
  7078. end;
  7079. end;
  7080. if not Found then
  7081. begin
  7082. for bp in TResolverBuiltInProc do
  7083. begin
  7084. BuiltInProc:=Resolver.BuiltInProcs[bp];
  7085. if BuiltInProc=nil then continue;
  7086. El:=BuiltInProc.Element;
  7087. if (CompareText(El.Name,aName)=0) then
  7088. begin
  7089. if bp in [bfStrProc,bfStrFunc] then
  7090. begin
  7091. if not ReadString(SubObj,'Type',s,ErrorEl) then
  7092. s:='Proc';
  7093. if (s='Func')<>(bp=bfStrFunc) then continue;
  7094. end;
  7095. AddElReference(Id,ErrorEl,El);
  7096. Found:=true;
  7097. break;
  7098. end;
  7099. end;
  7100. end;
  7101. if not Found then
  7102. begin
  7103. for pbt in TPas2jsBaseType do
  7104. begin
  7105. El:=Resolver.JSBaseTypes[pbt];
  7106. if El=nil then continue;
  7107. if (CompareText(El.Name,aName)=0) then
  7108. begin
  7109. Found:=true;
  7110. AddElReference(Id,ErrorEl,El);
  7111. break;
  7112. end;
  7113. end;
  7114. end;
  7115. if not Found then
  7116. RaiseMsg(20180216231551,ErrorEl,aName);
  7117. end;
  7118. end;
  7119. constructor TPCUReader.Create;
  7120. begin
  7121. inherited Create;
  7122. FInitialFlags:=TPCUInitialFlags.Create;
  7123. FPendingIdentifierScopes:=TObjectList.Create(true);
  7124. end;
  7125. destructor TPCUReader.Destroy;
  7126. begin
  7127. FreeAndNil(FJSON);
  7128. inherited Destroy;
  7129. FreeAndNil(FPendingIdentifierScopes);
  7130. FreeAndNil(FInitialFlags);
  7131. end;
  7132. procedure TPCUReader.Clear;
  7133. var
  7134. i: Integer;
  7135. begin
  7136. for i:=0 to length(FElementRefsArray)-1 do
  7137. if (FElementRefsArray[i]<>nil) and (FElementRefsArray[i].Element=nil) then
  7138. FElementRefsArray[i].Free;
  7139. FElementRefsArray:=nil;
  7140. FPendingIdentifierScopes.Clear;
  7141. inherited Clear;
  7142. FInitialFlags.Clear;
  7143. end;
  7144. procedure TPCUReader.ReadPCU(aResolver: TPas2JSResolver; aStream: TStream);
  7145. var
  7146. JParser: TJSONParser;
  7147. Data: TJSONData;
  7148. FirstBytes: string;
  7149. Compressed: Boolean;
  7150. Decomp: Tdecompressionstream;
  7151. Count: Cardinal;
  7152. Src: TStream;
  7153. begin
  7154. FirstBytes:='';
  7155. SetLength(FirstBytes,4);
  7156. if aStream.Read(FirstBytes[1],4)<4 then
  7157. RaiseMsg(20180313232754,nil);
  7158. aStream.Seek(-4,soCurrent);
  7159. Compressed:=(FirstBytes[1]<>'{') and (FirstBytes<>UTF8BOM+'{');
  7160. JParser:=nil;
  7161. Src:=nil;
  7162. try
  7163. if Compressed then
  7164. begin
  7165. try
  7166. Decomp:=Tdecompressionstream.create(aStream);
  7167. try
  7168. Count:=Decomp.ReadDWord;
  7169. if Count>123456789 then
  7170. RaiseMsg(20180313233209,'too big, invalid format');
  7171. Src:=TMemoryStream.Create;
  7172. Src.Size:=Count;
  7173. Decomp.read(TMemoryStream(Src).Memory^,Src.Size);
  7174. finally
  7175. Decomp.Free;
  7176. end;
  7177. except
  7178. on E: Edecompressionerror do
  7179. RaiseMsg(20180704162214,'decompression error, file corrupt: '+E.Message);
  7180. end;
  7181. Src.Position:=0;
  7182. end
  7183. else
  7184. Src:=aStream;
  7185. {$IFDEF VerbosePCUUncompressed}
  7186. {AllowWriteln}
  7187. writeln('TPCUReader.ReadPCU SRC START====================================');
  7188. SetLength(FirstBytes,Src.Size);
  7189. Src.read(FirstBytes[1],length(FirstBytes));
  7190. writeln(FirstBytes);
  7191. Src.Position:=0;
  7192. writeln('TPCUReader.ReadPCU SRC END======================================');
  7193. {AllowWriteln-}
  7194. {$ENDIF}
  7195. JParser:=TJSONParser.Create(Src,[joUTF8,joStrict]);
  7196. Data:=JParser.Parse;
  7197. if not (Data is TJSONObject) then
  7198. RaiseMsg(20180202130727,'expected JSON object, but found '+JSONTypeName(Data.JSONType));
  7199. finally
  7200. if Src<>aStream then
  7201. Src.Free;
  7202. JParser.Free;
  7203. end;
  7204. ReadJSONHeader(aResolver,TJSONObject(Data));
  7205. end;
  7206. procedure TPCUReader.ReadJSONHeader(aResolver: TPas2JSResolver;
  7207. Obj: TJSONObject);
  7208. var
  7209. aName: String;
  7210. Data: TJSONData;
  7211. i: Integer;
  7212. begin
  7213. FResolver:=aResolver;
  7214. FParser:=Resolver.CurrentParser;
  7215. FScanner:=FParser.Scanner;
  7216. FJSON:=Obj;
  7217. {$IF defined(VerbosePCUFiler) or defined(VerboseUnitQueue)}
  7218. writeln('TPCUReader.ReadJSONHeader START ');
  7219. {$ENDIF}
  7220. ReadHeaderMagic(Obj);
  7221. ReadHeaderVersion(Obj);
  7222. ReadGUID(Obj);
  7223. for i:=0 to Obj.Count-1 do
  7224. begin
  7225. aName:=Obj.Names[i];
  7226. {$IFDEF VerbosePCUFiler}
  7227. writeln('TPCUReader.ReadJSONHeader ',aName);
  7228. {$ENDIF}
  7229. Data:=Obj.Elements[aName];
  7230. case aName of
  7231. 'FileType': ; // done in ReadHeaderMagic
  7232. 'Version': ; // done in ReadHeaderVersion
  7233. 'GUID': ; // done in ReadGUID
  7234. 'TargetPlatform': ReadTargetPlatform(Data);
  7235. 'TargetProcessor': ReadTargetProcessor(Data);
  7236. 'Sources': ReadSrcFiles(Data);
  7237. 'InitParserOpts': InitialFlags.ParserOptions:=ReadParserOptions(Obj,nil,aName,PCUDefaultParserOptions);
  7238. 'InitModeSwitches': InitialFlags.ModeSwitches:=ReadModeSwitches(Obj,nil,aName,PCUDefaultModeSwitches);
  7239. 'InitBoolSwitches': InitialFlags.BoolSwitches:=ReadBoolSwitches(Obj,nil,aName,PCUDefaultBoolSwitches);
  7240. 'InitConverterOpts': InitialFlags.ConverterOptions:=ReadConverterOptions(Obj,nil,aName,PCUDefaultConverterOptions);
  7241. 'FinalParserOpts': Parser.Options:=ReadParserOptions(Obj,nil,aName,InitialFlags.ParserOptions);
  7242. 'FinalModeSwitches': Scanner.CurrentModeSwitches:=ReadModeSwitches(Obj,nil,aName,InitialFlags.ModeSwitches);
  7243. 'FinalBoolSwitches': Scanner.CurrentBoolSwitches:=ReadBoolSwitches(Obj,nil,aName,InitialFlags.BoolSwitches);
  7244. 'Module': ReadModuleHeader(Data);
  7245. else
  7246. ReadHeaderItem(aName,Data);
  7247. end;
  7248. end;
  7249. {$IFDEF VerbosePCUFiler}
  7250. writeln('TPCUReader.ReadJSONHeader END');
  7251. {$ENDIF}
  7252. end;
  7253. function TPCUReader.ReadContinue: boolean;
  7254. var
  7255. Obj, SubObj: TJSONObject;
  7256. aContext: TPCUReaderContext;
  7257. begin
  7258. {$IF defined(VerbosePCUFiler) or defined(VerboseUnitQueue)}
  7259. writeln('TPCUReader.ReadContinue START ',Resolver.RootElement.Name);
  7260. {$ENDIF}
  7261. Obj:=JSON;
  7262. if not ReadObject(Obj,'Module',SubObj,nil) then
  7263. RaiseMsg(20180307114005,'missing Module');
  7264. aContext:=CreateContext;
  7265. try
  7266. Result:=ReadModule(SubObj,aContext);
  7267. finally
  7268. aContext.Free;
  7269. end;
  7270. {$IF defined(VerbosePCUFiler) or defined(VerboseUnitQueue)}
  7271. writeln('TPCUReader.ReadContinue END');
  7272. {$ENDIF}
  7273. end;
  7274. { TPas2JSPrecompileFormats }
  7275. function TPas2JSPrecompileFormats.GetItems(Index: integer
  7276. ): TPas2JSPrecompileFormat;
  7277. begin
  7278. Result:=TPas2JSPrecompileFormat(FItems[Index]);
  7279. end;
  7280. constructor TPas2JSPrecompileFormats.Create;
  7281. begin
  7282. FItems:=TObjectList.Create(true);
  7283. end;
  7284. destructor TPas2JSPrecompileFormats.Destroy;
  7285. begin
  7286. Clear;
  7287. FreeAndNil(FItems);
  7288. inherited Destroy;
  7289. end;
  7290. procedure TPas2JSPrecompileFormats.Clear;
  7291. begin
  7292. FItems.Clear;
  7293. end;
  7294. function TPas2JSPrecompileFormats.Count: integer;
  7295. begin
  7296. Result:=FItems.Count;
  7297. end;
  7298. function TPas2JSPrecompileFormats.Add(aFormat: TPas2JSPrecompileFormat
  7299. ): TPas2JSPrecompileFormats;
  7300. begin
  7301. if FindExt(aFormat.Ext)<>nil then
  7302. begin
  7303. aFormat.Free;
  7304. raise Exception.Create('pas2js precompile extension already exists');
  7305. end;
  7306. FItems.Add(aFormat);
  7307. Result:=Self;
  7308. end;
  7309. function TPas2JSPrecompileFormats.Add(const Ext, Description: string;
  7310. const Reader: TPCUReaderClass; const Writer: TPCUWriterClass
  7311. ): TPas2JSPrecompileFormat;
  7312. begin
  7313. Result:=TPas2JSPrecompileFormat.Create;
  7314. Result.Ext:=Ext;
  7315. Result.Description:=Description;
  7316. Result.ReaderClass:=Reader;
  7317. Result.WriterClass:=Writer;
  7318. Result.Enabled:=true;
  7319. Add(Result);
  7320. end;
  7321. function TPas2JSPrecompileFormats.IndexOf(aFormat: TPas2JSPrecompileFormat
  7322. ): integer;
  7323. begin
  7324. Result:=FItems.IndexOf(aFormat);
  7325. end;
  7326. function TPas2JSPrecompileFormats.FindExt(Ext: string): TPas2JSPrecompileFormat;
  7327. var
  7328. i: Integer;
  7329. begin
  7330. Result:=nil;
  7331. if (Ext='') then exit;
  7332. if Ext[1]='.' then
  7333. begin
  7334. system.Delete(Ext,1,1);
  7335. if Ext='' then exit;
  7336. end;
  7337. for i:=0 to Count-1 do
  7338. if CompareText(Ext,Items[i].Ext)=0 then
  7339. exit(Items[i]);
  7340. end;
  7341. function TPas2JSPrecompileFormats.Remove(aFormat: TPas2JSPrecompileFormat
  7342. ): integer;
  7343. begin
  7344. Result:=IndexOf(aFormat);
  7345. if Result>=0 then
  7346. FItems.Delete(Result);
  7347. end;
  7348. function TPas2JSPrecompileFormats.Delete(Index: integer): TPas2JSPrecompileFormats;
  7349. begin
  7350. FItems.Delete(Index);
  7351. Result:=Self;
  7352. end;
  7353. initialization
  7354. PrecompileFormats:=TPas2JSPrecompileFormats.Create;
  7355. PrecompileFormats.Add('pcu','all used pcu must match exactly',TPCUReader,TPCUWriter);
  7356. finalization
  7357. PrecompileFormats.Free;
  7358. PrecompileFormats:=nil;
  7359. end.