pas2jsfiler.pp 242 KB

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