ppudump.pp 172 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424
  1. {
  2. Copyright (c) 1998-2020 by the FPC Development Team
  3. Dumps the contents of a FPC unit file (PPU File)
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************}
  16. program ppudump;
  17. {$i fpcdefs.inc}
  18. {$H+}
  19. {$packenum 1}
  20. {$define IN_PPUDUMP}
  21. uses
  22. { do NOT add symconst or globtype to make merging easier }
  23. { do include symconst and globtype now before splitting 2.5 PM 2011-06-15 }
  24. cutils,
  25. SysUtils,
  26. constexp,
  27. symconst,
  28. ppu,
  29. entfile,
  30. systems,
  31. cpuinfo,
  32. globals,
  33. globtype,
  34. widestr,
  35. tokens,
  36. version,
  37. ppuout,
  38. ppujson,
  39. ppuxml;
  40. const
  41. Title = 'PPU-Analyser';
  42. Copyright = 'Copyright (c) 1998-2020 by the Free Pascal Development Team';
  43. { verbosity }
  44. v_none = $0;
  45. v_header = $1;
  46. v_defs = $2;
  47. v_syms = $4;
  48. v_interface = $8;
  49. v_implementation = $10;
  50. // v_browser = $20;
  51. v_all = $ff;
  52. { not needed anymore $i systems.inc }
  53. { List of all supported cpus }
  54. const
  55. CpuTxt : array[tsystemcpu] of string[16]=
  56. (
  57. { 0 } 'none',
  58. { 1 } 'i386',
  59. { 2 } 'm68k',
  60. { 3 } 'alpha (obsolete)',
  61. { 4 } 'powerpc',
  62. { 5 } 'sparc',
  63. { 6 } 'vis (obsolete)',
  64. { 7 } 'ia64 (obsolete)',
  65. { 8 } 'x86_64',
  66. { 9 } 'mipseb',
  67. { 10 } 'arm',
  68. { 11 } 'powerpc64',
  69. { 12 } 'avr',
  70. { 13 } 'mipsel',
  71. { 14 } 'jvm',
  72. { 15 } 'i8086',
  73. { 16 } 'aarch64',
  74. { 17 } 'wasm32',
  75. { 18 } 'sparc64',
  76. { 19 } 'riscv32',
  77. { 20 } 'riscv64',
  78. { 21 } 'xtensa',
  79. { 22 } 'z80',
  80. { 23 } 'mips64',
  81. { 24 } 'mips64el',
  82. { 25 } 'loongarch64'
  83. );
  84. CpuHasController : array[tsystemcpu] of boolean =
  85. (
  86. { 0 } false {'none'},
  87. { 1 } false {'i386'},
  88. { 2 } false {'m68k'},
  89. { 3 } false {'alpha (obsolete)'},
  90. { 4 } false {'powerpc'},
  91. { 5 } false {'sparc'},
  92. { 6 } false {'vis (obsolete)'},
  93. { 7 } false {'ia64 (obsolete)'},
  94. { 8 } false {'x86_64'},
  95. { 9 } false {'mipseb'},
  96. { 10 } true {'arm'},
  97. { 11 } false {'powerpc64'},
  98. { 12 } true {'avr'},
  99. { 13 } true {'mipsel'},
  100. { 14 } false {'jvm'},
  101. { 15 } false {'i8086'},
  102. { 16 } false {'aarch64'},
  103. { 17 } false {'wasm32'},
  104. { 18 } false {'sparc64'},
  105. { 19 } false {'riscv32'},
  106. { 20 } false {'riscv64'},
  107. { 21 } true {'xtensa'},
  108. { 22 } true {'z80'},
  109. { 23 } false {'mips64'},
  110. { 24 } false {'mips64el'},
  111. { 25 } false {'loongarch64'}
  112. );
  113. { List of all supported system-cpu couples }
  114. const
  115. Targets : array[tsystem] of string[26]=(
  116. { 0 } 'none',
  117. { 1 } 'GO32V1 (obsolete)',
  118. { 2 } 'GO32V2',
  119. { 3 } 'Linux-i386',
  120. { 4 } 'OS/2',
  121. { 5 } 'Win32',
  122. { 6 } 'FreeBSD-i386',
  123. { 7 } 'Amiga',
  124. { 8 } 'Atari',
  125. { 9 } 'MacOSClassic-m68k',
  126. { 10 } 'Linux-m68k',
  127. { 11 } 'PalmOS-m68k',
  128. { 12 } 'Linux-alpha (obsolete)',
  129. { 13 } 'Linux-ppc',
  130. { 14 } 'MacOSClassic-ppc',
  131. { 15 } 'Solaris-i386',
  132. { 16 } 'BeOS-i386',
  133. { 17 } 'NetBSD-i386',
  134. { 18 } 'NetBSD-m68k',
  135. { 19 } 'Netware-i386-clib',
  136. { 20 } 'Qnx-i386',
  137. { 21 } 'WDOSX-i386',
  138. { 22 } 'Solaris-sparc',
  139. { 23 } 'Linux-sparc',
  140. { 24 } 'OpenBSD-i386',
  141. { 25 } 'OpenBSD-m68k (obsolete)',
  142. { 26 } 'Linux-x86-64',
  143. { 27 } 'Darwin-ppc',
  144. { 28 } 'OS/2 via EMX',
  145. { 29 } 'NetBSD-powerpc',
  146. { 30 } 'OpenBSD-powerpc',
  147. { 31 } 'Linux-arm',
  148. { 32 } 'Watcom-i386',
  149. { 33 } 'MorphOS-powerpc',
  150. { 34 } 'FreeBSD-x86-64',
  151. { 35 } 'Netware-i386-libc',
  152. { 36 } 'Amiga-PowerPC',
  153. { 37 } 'Win64-x64',
  154. { 38 } 'WinCE-ARM',
  155. { 39 } 'Win64-iA64 (obsolete)',
  156. { 40 } 'WinCE-i386',
  157. { 41 } 'Linux-x64',
  158. { 42 } 'GBA-arm',
  159. { 43 } 'Linux-powerpc64',
  160. { 44 } 'Darwin-i386',
  161. { 45 } 'PalmOS-arm',
  162. { 46 } 'Darwin-powerpc64',
  163. { 47 } 'NDS-arm',
  164. { 48 } 'Embedded-i386',
  165. { 49 } 'Embedded-m68k',
  166. { 50 } 'Embedded-alpha (obsolete)',
  167. { 51 } 'Embedded-powerpc',
  168. { 52 } 'Embedded-sparc',
  169. { 53 } 'Embedded-vm (obsolete)',
  170. { 54 } 'Embedded-iA64 (obsolete)',
  171. { 55 } 'Embedded-x64',
  172. { 56 } 'Embedded-mips',
  173. { 57 } 'Embedded-arm',
  174. { 58 } 'Embedded-powerpc64',
  175. { 59 } 'Symbian-i386',
  176. { 60 } 'Symbian-arm',
  177. { 61 } 'Darwin-x64',
  178. { 62 } 'Embedded-avr',
  179. { 63 } 'Haiku-i386',
  180. { 64 } 'iOS-ARM',
  181. { 65 } 'Solaris-x86-64',
  182. { 66 } 'Linux-MIPS',
  183. { 67 } 'Linux-MIPSel',
  184. { 68 } 'NativeNT-i386',
  185. { 69 } 'iPhoneSim-i386',
  186. { 70 } 'Wii-powerpc',
  187. { 71 } 'OpenBSD-x86-64',
  188. { 72 } 'NetBSD-x86-64',
  189. { 73 } 'AIX-powerpc',
  190. { 74 } 'AIX-powerpc64',
  191. { 75 } 'Java-JVM',
  192. { 76 } 'Android-JVM',
  193. { 77 } 'Android-arm',
  194. { 78 } 'Android-i386',
  195. { 79 } 'MSDOS-i8086',
  196. { 80 } 'Android-MIPSel',
  197. { 81 } 'Embedded-mipseb',
  198. { 82 } 'Embedded-mipsel',
  199. { 83 } 'AROS-i386',
  200. { 84 } 'AROS-x86-64',
  201. { 85 } 'DragonFly-x86-64',
  202. { 86 } 'iOS-AArch64',
  203. { 87 } 'iPhoneSim-x86-64',
  204. { 88 } 'Linux-AArch64',
  205. { 89 } 'Win16',
  206. { 90 } 'Embedded-i8086',
  207. { 91 } 'AROS-arm',
  208. { 92 } 'WebAssembly-wasm',
  209. { 93 } 'Linux-sparc64',
  210. { 94 } 'Solaris-sparc64',
  211. { 95 } 'NetBSD-arm',
  212. { 96 } 'Linux-RiscV32',
  213. { 97 } 'Linux-RiscV64',
  214. { 98 } 'Embedded-RiscV32',
  215. { 99 } 'Embedded-RiscV64',
  216. { 100 } 'Android-AArch64',
  217. { 101 } 'Android-x86-64',
  218. { 102 } 'Haiku-x86-64',
  219. { 103 } 'Embedded-Xtensa',
  220. { 104 } 'FreeRTos-Xtensa',
  221. { 105 } 'Linux-Xtensa',
  222. { 106 } 'FreeRTos-arm',
  223. { 107 } 'Win64-AArch64',
  224. { 108 } 'Embedded-Z80',
  225. { 109 } 'ZXSpectrum-Z80',
  226. { 110 } 'MSX-DOS-Z80',
  227. { 111 } 'Darwin-AArch64',
  228. { 112 } 'AmstradCPC-Z80',
  229. { 113 } 'SinclairQL-m68k',
  230. { 114 } 'WASI-WASM32',
  231. { 115 } 'FreeBSD-AArch64',
  232. { 116 } 'Embedded-aarch64',
  233. { 117 } 'Linux-MIPS64',
  234. { 118 } 'Linux-MIPS64el',
  235. { 119 } 'FreeRTos-RiscV32',
  236. { 120 } 'Linux-LoongArch64',
  237. { 121 } 'iPhoneSim-AArch64',
  238. { 122 } 'Human68k-m68k',
  239. { 123 } 'PS1-mipsel',
  240. { 124 } 'WASIp1threads-WASM32'
  241. );
  242. const
  243. { in widestr, we have the following definition
  244. type
  245. tcompilerwidechar = word;
  246. thus widecharsize seems to always be 2 bytes }
  247. widecharsize : longint = 2;
  248. cpu : tsystemcpu = cpu_no;
  249. { This type is defined in scanner.pas unit }
  250. type
  251. tspecialgenerictoken = (
  252. ST_LOADSETTINGS,
  253. ST_LINE,
  254. ST_COLUMN,
  255. ST_FILEINDEX,
  256. ST_LOADMESSAGES,
  257. ST_INVALID);
  258. type
  259. tcpu_i386 = (
  260. cpu_variant_i386_none,
  261. cpu_variant_386,
  262. cpu_variant_486,
  263. cpu_variant_Pentium,
  264. cpu_variant_Pentium2,
  265. cpu_variant_Pentium3,
  266. cpu_variant_Pentium4,
  267. cpu_variant_PentiumM,
  268. cpu_variant_core_i,
  269. cpu_variant_core_avx,
  270. cpu_variant_core_avx2);
  271. tcpu_m68k = (
  272. cpu_variant_m68k_none,
  273. cpu_variant_MC68000,
  274. cpu_variant_MC68020,
  275. cpu_variant_MC68040,
  276. cpu_variant_MC68060,
  277. cpu_variant_isa_a,
  278. cpu_variant_isa_a_p,
  279. cpu_variant_isa_b,
  280. cpu_variant_isa_c,
  281. cpu_variant_cfv4e
  282. );
  283. tcpu_powerpc = (
  284. cpu_variant_powerpc_none,
  285. cpu_variant_ppc604,
  286. cpu_variant_ppc750,
  287. cpu_variant_ppc7400,
  288. cpu_variant_ppc970
  289. );
  290. tcpu_sparc = (
  291. cpu_variant_sparc_none,
  292. cpu_variant_SPARC_V7,
  293. cpu_variant_SPARC_V8,
  294. cpu_variant_SPARC_V9
  295. );
  296. tcpu_x86_64 = (
  297. cpu_variant_x86_64_none,
  298. cpu_variant_athlon64,
  299. cpu_variant_x86_64_core_i,
  300. cpu_variant_x86_64_core_avx,
  301. cpu_variant_x86_64_core_avx2
  302. );
  303. tcpu_mipseb = (
  304. cpu_variant_mipseb_none,
  305. cpu_variant_mips1,
  306. cpu_variant_mips2,
  307. cpu_variant_mips3,
  308. cpu_variant_mips4,
  309. cpu_variant_mips5,
  310. cpu_variant_mips32,
  311. cpu_variant_mips32r2,
  312. cpu_variant_pic32mx
  313. );
  314. tcpu_arm = (
  315. cpu_variant_arm_none,
  316. cpu_variant_armv3,
  317. cpu_variant_armv4,
  318. cpu_variant_armv4t,
  319. cpu_variant_armv5,
  320. cpu_variant_armv5t,
  321. cpu_variant_armv5te,
  322. cpu_variant_armv5tej,
  323. cpu_variant_armv6,
  324. cpu_variant_armv6k,
  325. cpu_variant_armv6t2,
  326. cpu_variant_armv6z,
  327. cpu_variant_armv6m,
  328. cpu_variant_armv7,
  329. cpu_variant_armv7a,
  330. cpu_variant_armv7r,
  331. cpu_variant_armv7m,
  332. cpu_variant_armv7em
  333. );
  334. tcpu_powerpc64 = (
  335. cpu_variant_powerpc64_none,
  336. cpu_variant_powerpc64_ppc970
  337. );
  338. tcpu_avr = (
  339. cpu_variant_avr_none,
  340. cpu_variant_avr1,
  341. cpu_variant_avr2,
  342. cpu_variant_avr25,
  343. cpu_variant_avr3,
  344. cpu_variant_avr31,
  345. cpu_variant_avr35,
  346. cpu_variant_avr4,
  347. cpu_variant_avr5,
  348. cpu_variant_avr51,
  349. cpu_variant_avr6
  350. );
  351. tcpu_mipsel = tcpu_mipseb;
  352. tcpu_jvm = (
  353. cpu_variant_jvm_none,
  354. { jvm, same as cpu_none }
  355. cpu_variant_jvm,
  356. { jvm byte code to be translated into Dalvik bytecode: more type-
  357. sensitive }
  358. cpu_variant_dalvik
  359. );
  360. tcpu_i8086 = (
  361. cpu_variant_i8086_none,
  362. cpu_variant_8086,
  363. cpu_variant_186,
  364. cpu_variant_286,
  365. cpu_variant_i8086_386,
  366. cpu_variant_i8086_486,
  367. cpu_variant_i8086_Pentium,
  368. cpu_variant_i8086_Pentium2,
  369. cpu_variant_i8086_Pentium3,
  370. cpu_variant_i8086_Pentium4,
  371. cpu_variant_i8086_PentiumM
  372. );
  373. tcpu_aarch64 = (
  374. cpu_variant_aarch64_none,
  375. cpu_variant_armv8
  376. );
  377. tcpu_wasm32 = (
  378. cpu_variant_wasm32_none);
  379. tcpu_sparc64 = (
  380. cpu_variant_sparc64_none,
  381. cpu_variant_SPARC64_V9
  382. );
  383. tcpu_riscv32 = (
  384. cpu_variant_riscv32_none,
  385. cpu_variant_rv32imafd,
  386. cpu_variant_rv32ima,
  387. cpu_variant_rv32im,
  388. cpu_variant_rv32i
  389. );
  390. tcpu_riscv64 = (
  391. cpu_variant_riscv64_none,
  392. cpu_variant_rv64imafdc,
  393. cpu_variant_rv64imafd,
  394. cpu_variant_rv64ima,
  395. cpu_variant_rv64im,
  396. cpu_variant_rv64i
  397. );
  398. tcpu_type = record
  399. case tsystemcpu of
  400. cpu_no: { 0 }
  401. ();
  402. cpu_i386: { 1 }
  403. (cpu_i386 : tcpu_i386;);
  404. cpu_m68k: { 2 }
  405. (cpu_m68k : tcpu_m68k;);
  406. obsolete_cpu_alpha: { 3 }
  407. ();
  408. cpu_powerpc: { 4 }
  409. (cpu_powerpc : tcpu_powerpc;);
  410. cpu_sparc: { 5 }
  411. (cpu_sparc : tcpu_sparc;);
  412. obsolete_cpu_vm: { 6 }
  413. ();
  414. obsolete_cpu_ia64: { 7 }
  415. ();
  416. cpu_x86_64: { 8 }
  417. (cpu_x86_64 : tcpu_x86_64;);
  418. cpu_mipseb: { 9 }
  419. (cpu_mipseb : tcpu_mipseb;);
  420. cpu_arm: { 10 }
  421. (cpu_arm : tcpu_arm;);
  422. cpu_powerpc64: { 11 }
  423. (cpu_powerpc64 : tcpu_powerpc64;);
  424. cpu_avr: { 12 }
  425. (cpu_avr : tcpu_avr;);
  426. cpu_mipsel: { 13 }
  427. (cpu_mipsel : tcpu_mipsel;);
  428. cpu_jvm: { 14 }
  429. (cpu_jvm : tcpu_jvm;);
  430. cpu_i8086: { 15 }
  431. (cpu_i8086 : tcpu_i8086;);
  432. cpu_aarch64: { 16 }
  433. (cpu_aarch64 : tcpu_aarch64;);
  434. cpu_wasm32: { 17 }
  435. (cpu_wasm32 : tcpu_wasm32;);
  436. cpu_sparc64: { 18 }
  437. (cpu_sparc64 : tcpu_sparc64;);
  438. cpu_riscv32: { 19 }
  439. (cpu_riscv32 : tcpu_riscv32;);
  440. cpu_riscv64: { 20 }
  441. (cpu_riscv64 : tcpu_riscv64;);
  442. end;
  443. TPpuModuleDef = class(TPpuUnitDef)
  444. ModuleFlags: tmoduleflags;
  445. end;
  446. type
  447. t_ppu_endian = (ppu_unknown_endian, ppu_little_endian, ppu_big_endian );
  448. tppudumpfile = class(tppufile)
  449. internal_endian : t_ppu_endian;
  450. protected
  451. procedure RaiseAssertion(Code: Longint); override;
  452. end;
  453. var
  454. ppufile : tppudumpfile;
  455. ppuversion : dword;
  456. space : string;
  457. verbose : longint;
  458. derefdata : pbyte;
  459. derefdatalen : longint;
  460. pout: TPpuOutput;
  461. nostdout: boolean;
  462. UnitList: TPpuContainerDef;
  463. CurUnit: TPpuModuleDef;
  464. SkipVersionCheck: boolean;
  465. SymAnsiStr: boolean;
  466. var
  467. { needed during tobjectdef parsing... }
  468. current_defoptions : tdefoptions;
  469. current_objectoptions : tobjectoptions;
  470. current_symtable_options : tsymtableoptions;
  471. {****************************************************************************
  472. Helper Routines
  473. ****************************************************************************}
  474. {****************************************************************************
  475. Routine to read 80-bit reals
  476. ****************************************************************************
  477. }
  478. {$PUSH}
  479. {$WARN 6018 OFF} { Turn off unreachable code warning }
  480. { On platforms with sizeof(ext) <> 10 the code below will cause an unreachable
  481. code warning, which will cause compilation failures with -Sew (KB) }
  482. type
  483. TSplit80bitReal = packed record
  484. case byte of
  485. 0: (bytes: Array[0..9] of byte);
  486. 1: (words: Array[0..4] of word);
  487. end;
  488. const
  489. maxDigits = 17;
  490. function Real80bitToStr(var e : TSplit80bitReal;var ext : extended) : string;
  491. var
  492. Temp : string;
  493. new : TSplit80bitReal;
  494. fraczero, expmaximal, sign, outside_double : boolean;
  495. exp : smallint;
  496. d : double;
  497. i : longint;
  498. e_qw, mantval : qword;
  499. e_w : word;
  500. begin
  501. if sizeof(ext)=10 then
  502. begin
  503. ext:=pextended(@e)^;
  504. str(ext,result);
  505. exit;
  506. end;
  507. { extended, format (MSB): 1 Sign bit, 15 bit exponent, 64 bit mantissa }
  508. if (ppufile.internal_endian=ppu_big_endian) then
  509. begin
  510. e_w:=pword(@(e.bytes[0]))^;
  511. e_qw:=unaligned(pqword(@(e.bytes[2]))^);
  512. end
  513. else
  514. begin
  515. e_w:=pword(@(e.bytes[8]))^;
  516. e_qw:=pqword(@(e.bytes[0]))^;
  517. end;
  518. if ppufile.change_endian then
  519. begin
  520. e_w:=swapendian(e_w);
  521. e_qw:=swapendian(e_qw);
  522. end;
  523. sign := (e_w and $8000) <> 0;
  524. expMaximal := (e_w and $7fff) = 32767;
  525. exp:=(e_w and $7fff) - 16383 - 63;
  526. fraczero := ((e_qw and qword($7fffffffffffffff)) = 0);
  527. mantval:=e_qw;
  528. if expMaximal then
  529. if fraczero then
  530. if sign then
  531. temp := '-Inf'
  532. else temp := '+Inf'
  533. else temp := 'Nan'
  534. else
  535. begin
  536. d:=double(mantval);
  537. if sign then
  538. d:=-d;
  539. outside_double:=false;
  540. Try
  541. if exp > 0 then
  542. begin
  543. for i:=1 to exp do
  544. d:=d *2.0;
  545. end
  546. else if exp < 0 then
  547. begin
  548. for i:=1 to -exp do
  549. d:=d /2.0;
  550. end;
  551. Except
  552. outside_double:=true;
  553. end;
  554. if (mantval<>0) and (d=0.0) then
  555. outside_double:=true;
  556. if outside_double then
  557. begin
  558. Temp:='Extended value outside double bound';
  559. ext:=0.0;
  560. end
  561. else
  562. begin
  563. ext:=d;
  564. system.str(d,temp);
  565. end;
  566. end;
  567. temp:=temp+' w=$'+hexstr(e_w,4)+',qw=$'+hexstr(e_qw,16);
  568. result:=temp;
  569. end;
  570. {$POP}
  571. const has_errors : boolean = false;
  572. has_warnings : boolean = false;
  573. has_more_infos : boolean = false;
  574. procedure SetHasErrors;
  575. begin
  576. has_errors:=true;
  577. end;
  578. Procedure WriteError(const S : string);
  579. Begin
  580. system.Writeln(StdErr, S);
  581. SetHasErrors;
  582. End;
  583. procedure StrAppend(var st : string; const st2 : string);
  584. begin
  585. st:=st+st2;
  586. end;
  587. procedure tppudumpfile.RaiseAssertion(Code: Longint);
  588. begin
  589. WriteError('Internal Error ' + ToStr(Code));
  590. inherited RaiseAssertion(Code);
  591. end;
  592. Procedure WriteWarning(const S : string);
  593. var
  594. ss: string;
  595. Begin
  596. ss:='!! Warning: ' + S;
  597. if nostdout then
  598. system.Writeln(StdErr, ss)
  599. else
  600. system.Writeln(ss);
  601. has_warnings:=true;
  602. End;
  603. procedure Write(const s: string);
  604. begin
  605. if nostdout then exit;
  606. system.write(s);
  607. end;
  608. procedure Write(const params: array of const);
  609. var
  610. i: integer;
  611. { Last vtType define in rtl/inc/objpash.inc }
  612. const
  613. max_vttype = vtUnicodeString;
  614. begin
  615. if nostdout then exit;
  616. for i:=Low(params) to High(params) do
  617. { All vtType in
  618. vtInteger = 0;
  619. vtBoolean = 1;
  620. vtChar = 2;
  621. vtExtended = 3;
  622. vtString = 4;
  623. vtPointer = 5;
  624. vtPChar = 6;
  625. vtObject = 7;
  626. vtClass = 8;
  627. vtWideChar = 9;
  628. vtPWideChar = 10;
  629. vtAnsiString32 = 11; called vtAnsiString in objpas unit
  630. vtCurrency = 12;
  631. vtVariant = 13;
  632. vtInterface = 14;
  633. vtWideString = 15;
  634. vtInt64 = 16;
  635. vtQWord = 17;
  636. vtUnicodeString = 18;
  637. // vtAnsiString16 = 19; not yet used
  638. // vtAnsiString64 = 20; not yet used
  639. }
  640. with TVarRec(params[i]) do
  641. case VType of
  642. vtInteger: system.write(VInteger);
  643. vtBoolean: system.write(VBoolean);
  644. vtChar: system.write(VChar);
  645. vtExtended: system.write(VExtended^);
  646. vtString: system.write(VString^);
  647. vtPointer:
  648. begin
  649. { Not sure the display will be correct
  650. if sizeof pointer is not native }
  651. WriteWarning('Pointer constant');
  652. end;
  653. vtPChar: system.write(VPChar);
  654. vtObject:
  655. begin
  656. { Not sure the display will be correct
  657. if sizeof pointer is not native }
  658. WriteWarning('Object constant');
  659. end;
  660. vtClass:
  661. begin
  662. { Not sure the display will be correct
  663. if sizeof pointer is not native }
  664. WriteWarning('Class constant');
  665. end;
  666. vtWideChar: system.write(VWideChar);
  667. vtPWideChar:
  668. begin
  669. WriteWarning('PWideChar constant');
  670. end;
  671. vtAnsiString: system.write(ansistring(VAnsiString));
  672. vtCurrency : system.write(VCurrency^);
  673. vtVariant :
  674. begin
  675. { Not sure the display will be correct
  676. if sizeof pointer is not native }
  677. WriteWarning('Variant constant');
  678. end;
  679. vtInterface :
  680. begin
  681. { Not sure the display will be correct
  682. if sizeof pointer is not native }
  683. WriteWarning('Interface constant');
  684. end;
  685. vtWideString : system.write(widestring(VWideString));
  686. vtInt64: system.write(VInt64^);
  687. vtQWord: system.write(VQWord^);
  688. vtUnicodeString : system.write(unicodestring(VUnicodeString));
  689. else
  690. begin
  691. system.writeln;
  692. system.writeln('Unsupported var type: ', VType);
  693. Halt(10);
  694. end;
  695. end;
  696. end;
  697. procedure Writeln(const s: string = '');
  698. begin
  699. if nostdout then exit;
  700. system.writeln(s);
  701. end;
  702. procedure Writeln(const params: array of const);
  703. begin
  704. if nostdout then exit;
  705. Write(params);
  706. system.writeln;
  707. end;
  708. Procedure HasMoreInfos;
  709. begin
  710. Writeln('!! Entry has more information stored');
  711. has_more_infos:=true;
  712. end;
  713. function Unknown(const st : string; val :longint) : string;
  714. Begin
  715. Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>';
  716. SetHasErrors;
  717. end;
  718. function ToStr(w:longint):String;
  719. begin
  720. Str(w,ToStr);
  721. end;
  722. Function Target2Str(w:longint):string;
  723. begin
  724. if w<=ord(high(tsystem)) then
  725. Target2Str:=Targets[tsystem(w)]
  726. else
  727. Target2Str:=Unknown('target',w);
  728. end;
  729. Function Cpu2Str(w:longint):string;
  730. begin
  731. if w<=ord(high(tsystemcpu)) then
  732. begin
  733. cpu:=tsystemcpu(w);
  734. Cpu2Str:=CpuTxt[cpu];
  735. end
  736. else
  737. Cpu2Str:=Unknown('cpu',w);
  738. end;
  739. Function Varspez2Str(w:longint):string;
  740. const
  741. { in symconst unit
  742. tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref); }
  743. varspezstr : array[tvarspez] of string[8]=('Value','Const','Var','Out','ConstRef','Final');
  744. begin
  745. if w<=ord(high(varspezstr)) then
  746. Varspez2Str:=varspezstr[tvarspez(w)]
  747. else
  748. Varspez2Str:=Unknown('varspez',w);
  749. end;
  750. Function VarRegable2Str(w:longint):string;
  751. { tvarregable type is defined in symconst unit }
  752. const
  753. varregableStr : array[tvarregable] of string[6]=('None','IntReg','FPUReg','MMReg','Addr');
  754. begin
  755. if w<=ord(high(varregablestr)) then
  756. Varregable2Str:=varregablestr[tvarregable(w)]
  757. else
  758. Varregable2Str:=Unknown('regable',w);
  759. end;
  760. Function Visibility2Str(w:longint):string;
  761. const
  762. { tvisibility type is defined in symconst unit }
  763. visibilityName : array[tvisibility] of string[16] = (
  764. 'hidden','strict private','private','strict protected','protected',
  765. 'public','published','<none>'
  766. );
  767. begin
  768. if w<=ord(high(visibilityName)) then
  769. result:=visibilityName[tvisibility(w)]
  770. else
  771. result:=Unknown('visibility',w);
  772. end;
  773. Function IntfEntryType2Str(w:longint):string;
  774. const
  775. { tinterfaceentrytype type is defined in symconst unit }
  776. Name : array[tinterfaceentrytype] of string = (
  777. 'standard','virtual method result','static method result','field value','virtual method class',
  778. 'static method class','field value class'
  779. );
  780. begin
  781. if w<=ord(high(Name)) then
  782. result:=Name[tinterfaceentrytype(w)]
  783. else
  784. result:=Unknown('entry type',w);
  785. end;
  786. function PPUFlags2Str(flags:dword):string;
  787. type
  788. tflagopt=record
  789. mask : dword;
  790. str : string[30];
  791. end;
  792. const
  793. flagopts=8;
  794. mask_big_endian = $4;
  795. mask_little_endian = $1000;
  796. flagopt : array[1..flagopts] of tflagopt=(
  797. (mask: $4 ;str:'big_endian'),
  798. // (mask: $10 ;str:'browser'),
  799. (mask: $20 ;str:'in_library'),
  800. (mask: $40 ;str:'smart_linked'),
  801. (mask: $80 ;str:'static_linked'),
  802. (mask: $100 ;str:'shared_linked'),
  803. (mask: $400 ;str:'no_link'),
  804. (mask: $1000 ;str:'little_endian'),
  805. (mask: $8000 ;str:'fpu_emulation_on')
  806. );
  807. var
  808. i : longint;
  809. ntflags : dword;
  810. first : boolean;
  811. s : string;
  812. begin
  813. s:='';
  814. ntflags:=flags;
  815. ppufile.internal_endian:=ppu_unknown_endian;
  816. if flags<>0 then
  817. begin
  818. first:=true;
  819. for i:=1to flagopts do
  820. if (flags and flagopt[i].mask)<>0 then
  821. begin
  822. if first then
  823. first:=false
  824. else
  825. s:=s+', ';
  826. s:=s+flagopt[i].str;
  827. if flagopt[i].mask=mask_big_endian then
  828. begin
  829. if (ppufile.internal_endian<>ppu_unknown_endian) then
  830. begin
  831. s:=s+' endianess explicitly set twice';
  832. SetHasErrors;
  833. end;
  834. ppufile.internal_endian:=ppu_big_endian;
  835. end;
  836. if flagopt[i].mask=mask_little_endian then
  837. begin
  838. if (ppufile.internal_endian<>ppu_unknown_endian) then
  839. begin
  840. s:=s+' endianess explicitly set twice';
  841. SetHasErrors;
  842. end;
  843. ppufile.internal_endian:=ppu_little_endian;
  844. end;
  845. ntflags:=ntflags and (not flagopt[i].mask);
  846. end;
  847. end
  848. else
  849. s:='none';
  850. if ntflags<>0 then
  851. begin
  852. s:=s+' unknown '+hexstr(ntflags,8);
  853. SetHasErrors;
  854. end;
  855. if (ppufile.internal_endian=ppu_unknown_endian) then
  856. begin
  857. s:=s+' endianess not explicitly set';
  858. SetHasErrors;
  859. end;
  860. PPUFlags2Str:=s;
  861. end;
  862. Function L0(l:longint):string;
  863. {
  864. return the string of value l, if l<10 then insert a zero, so
  865. the string is always at least 2 chars '01','02',etc
  866. }
  867. var
  868. s : string;
  869. begin
  870. Str(l,s);
  871. if l<10 then
  872. s:='0'+s;
  873. L0:=s;
  874. end;
  875. function filetimestring( t : longint) : string;
  876. {
  877. convert dos datetime t to a string YY/MM/DD HH:MM:SS
  878. }
  879. var
  880. DT : TDateTime;
  881. hsec : word;
  882. Year,Month,Day: Word;
  883. hour,min,sec : word;
  884. begin
  885. if t=-1 then
  886. begin
  887. Result := 'Not Found';
  888. SetHasErrors;
  889. exit;
  890. end;
  891. DT := FileDateToDateTime(t);
  892. DecodeTime(DT,hour,min,sec,hsec);
  893. DecodeDate(DT,year,month,day);
  894. Result := L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
  895. end;
  896. {****************************************************************************
  897. Read Routines
  898. ****************************************************************************}
  899. function readsymstr(ppufile: tppufile): ansistring;
  900. begin
  901. if not(mf_symansistr in CurUnit.ModuleFlags) then
  902. result:=ppufile.getstring
  903. else
  904. result:=ppufile.getansistring;
  905. end;
  906. function readmanagementoperatoroptions(const space : string;const name : string):tmanagementoperators;forward;
  907. procedure readrecsymtableoptions;
  908. var
  909. usefieldalignment : shortint;
  910. begin
  911. if ppufile.readentry<>ibrecsymtableoptions then
  912. begin
  913. SetHasErrors;
  914. exit;
  915. end;
  916. writeln([space,' recordalignment: ',shortint(ppufile.getbyte)]);
  917. usefieldalignment:=shortint(ppufile.getbyte);
  918. writeln([space,' usefieldalignment: ',usefieldalignment]);
  919. writeln([space,' recordalignmin: ',shortint(ppufile.getbyte)]);
  920. if (usefieldalignment=C_alignment) then
  921. writeln([space,' fieldalignment: ',shortint(ppufile.getbyte)]);
  922. readmanagementoperatoroptions(space,'Fields have MOPs');
  923. end;
  924. function readsymtableoptions(const s: string) : tsymtableoptions;
  925. type
  926. tsymtblopt=record
  927. mask : tsymtableoption;
  928. str : string[30];
  929. end;
  930. const
  931. symtblopts=ord(high(tsymtableoption)) + 1;
  932. symtblopt : array[1..symtblopts] of tsymtblopt=(
  933. (mask:sto_has_helper; str:'Has helper'),
  934. (mask:sto_has_generic; str:'Has generic'),
  935. (mask:sto_has_operator; str:'Has operator'),
  936. (mask:sto_needs_init_final;str:'Needs init final table'),
  937. (mask:sto_has_non_trivial_init;str:'Has non trivial init')
  938. );
  939. var
  940. options : tsymtableoptions;
  941. first : boolean;
  942. i : integer;
  943. begin
  944. if ppufile.readentry<>ibsymtableoptions then
  945. begin
  946. SetHasErrors;
  947. exit;
  948. end;
  949. ppufile.getset(tppuset1(options));
  950. if space<>'' then
  951. writeln([space,'------ ',s,' ------']);
  952. write([space,'Symtable options: ']);
  953. if options<>[] then
  954. begin
  955. first:=true;
  956. for i:=1 to symtblopts do
  957. if (symtblopt[i].mask in options) then
  958. begin
  959. if first then
  960. first:=false
  961. else
  962. write(', ');
  963. write(symtblopt[i].str);
  964. end;
  965. end
  966. else
  967. write('none');
  968. writeln;
  969. readsymtableoptions:=options;
  970. end;
  971. procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef); forward;
  972. procedure readsymbols(const s:string; ParentDef: TPpuContainerDef = nil); forward;
  973. procedure readsymtable(const s: string; ParentDef: TPpuContainerDef = nil);
  974. var
  975. stored_symtable_options : tsymtableoptions;
  976. begin
  977. stored_symtable_options:=current_symtable_options;
  978. current_symtable_options:=readsymtableoptions(s);
  979. readdefinitions(s, ParentDef);
  980. readsymbols(s, ParentDef);
  981. current_symtable_options:=stored_symtable_options;
  982. end;
  983. procedure readrecordsymtable(const s: string; ParentDef: TPpuContainerDef = nil);
  984. begin
  985. readrecsymtableoptions;
  986. readsymtable(s, ParentDef);
  987. end;
  988. Procedure ReadLinkContainer(const prefix:string);
  989. {
  990. Read a serie of strings and write to the screen starting every line
  991. with prefix
  992. }
  993. function maskstr(m:longint):string;
  994. { link options are in globtype unit
  995. const
  996. link_none = $0;
  997. link_always = $1;
  998. link_static = $2;
  999. link_smart = $4;
  1000. link_shared = $8; }
  1001. var
  1002. s : string;
  1003. begin
  1004. s:='';
  1005. if (m and link_always)<>0 then
  1006. s:=s+'always ';
  1007. if (m and link_static)<>0 then
  1008. s:=s+'static ';
  1009. if (m and link_smart)<>0 then
  1010. s:=s+'smart ';
  1011. if (m and link_shared)<>0 then
  1012. s:=s+'shared ';
  1013. maskstr:=s;
  1014. end;
  1015. var
  1016. s : string;
  1017. m : longint;
  1018. begin
  1019. while not ppufile.endofentry do
  1020. begin
  1021. s:=ppufile.getstring;
  1022. m:=ppufile.getlongint;
  1023. WriteLn([prefix,s,' (',maskstr(m),')']);
  1024. end;
  1025. end;
  1026. Procedure ReadContainer(const prefix:string);
  1027. {
  1028. Read a series of strings and write to the screen starting every line
  1029. with prefix
  1030. }
  1031. begin
  1032. while not ppufile.endofentry do
  1033. WriteLn([prefix,ppufile.getstring]);
  1034. end;
  1035. procedure ReadLoadUnit;
  1036. var
  1037. ucrc,uintfcrc, indcrc : cardinal;
  1038. un: TPpuUnitDef;
  1039. begin
  1040. while not ppufile.EndOfEntry do
  1041. begin
  1042. un:=TPpuUnitDef.Create(CurUnit.UsedUnits);
  1043. un.Name:=ppufile.getstring;
  1044. write(['Uses unit: ',un.Name]);
  1045. ucrc:=cardinal(ppufile.getlongint);
  1046. uintfcrc:=cardinal(ppufile.getlongint);
  1047. indcrc:=cardinal(ppufile.getlongint);
  1048. writeln([' (Crc: ',hexstr(ucrc,8),', IntfcCrc: ',hexstr(uintfcrc,8),', IndCrc: ',hexstr(indcrc,8),')']);
  1049. un.Crc:=ucrc;
  1050. un.IntfCrc:=uintfcrc;
  1051. end;
  1052. end;
  1053. Procedure ReadDerefmap;
  1054. var
  1055. i,mapsize : longint;
  1056. s: string;
  1057. begin
  1058. mapsize:=ppufile.getlongint;
  1059. writeln(['DerefMapsize: ',mapsize]);
  1060. SetLength(CurUnit.RefUnits, mapsize);
  1061. for i:=0 to mapsize-1 do
  1062. begin
  1063. s:=ppufile.getstring;
  1064. writeln(['DerefMap[',i,'] = ',s]);
  1065. CurUnit.RefUnits[i]:=LowerCase(s);
  1066. end;
  1067. end;
  1068. Procedure ReadImportSymbols;
  1069. var
  1070. extlibname : string;
  1071. j,
  1072. extsymcnt : longint;
  1073. extsymname : string;
  1074. extsymmangledname : string;
  1075. extsymordnr : longint;
  1076. extsymisvar : boolean;
  1077. begin
  1078. while not ppufile.endofentry do
  1079. begin
  1080. extlibname:=ppufile.getstring;
  1081. extsymcnt:=ppufile.getlongint;
  1082. writeln(['External Library: ',extlibname,' (',extsymcnt,' imports)']);
  1083. for j:=0 to extsymcnt-1 do
  1084. begin
  1085. extsymname:=ppufile.getstring;
  1086. extsymmangledname:=ppufile.getstring;
  1087. extsymordnr:=ppufile.getlongint;
  1088. extsymisvar:=ppufile.getbyte<>0;
  1089. writeln([' ',extsymname,' as ',extsymmangledname,
  1090. '(OrdNr: ',extsymordnr,' IsVar: ',extsymisvar,')']);
  1091. end;
  1092. end;
  1093. end;
  1094. Procedure ReadDerefdata;
  1095. begin
  1096. derefdatalen:=ppufile.entrysize;
  1097. if derefdatalen=0 then
  1098. begin
  1099. Writeln(['No Derefdata length=0']);
  1100. derefdata:=nil;
  1101. exit;
  1102. end;
  1103. Writeln(['Derefdata length: ',derefdatalen]);
  1104. derefdata:=allocmem(derefdatalen);
  1105. ppufile.getdata(derefdata^,derefdatalen);
  1106. end;
  1107. Procedure FreeDerefdata;
  1108. begin
  1109. if assigned(derefdata) then
  1110. begin
  1111. FreeMem(derefdata);
  1112. derefdata:=nil;
  1113. derefdatalen:=0;
  1114. end;
  1115. end;
  1116. Procedure ReadWpoFileInfo;
  1117. begin
  1118. Writeln(['Compiled with input whole-program optimisation from ',ppufile.getstring,' ',filetimestring(ppufile.getlongint)]);
  1119. end;
  1120. Procedure ReadAsmSymbols;
  1121. const
  1122. unitasmlisttype: array[tunitasmlisttype] of string[6]=(
  1123. 'PUBLIC',
  1124. 'EXTERN'
  1125. );
  1126. type
  1127. { Copied from aasmbase.pas }
  1128. TAsmsymbind=(
  1129. AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL,
  1130. { global in the current program/library, but not visible outside it }
  1131. AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT,
  1132. { a symbol that's internal to the compiler and used as a temp }
  1133. AB_TEMP,
  1134. { a global symbol that points to another global symbol and is only used
  1135. to allow indirect loading in case of packages and indirect imports }
  1136. AB_INDIRECT,AB_EXTERNAL_INDIRECT,
  1137. AB_WEAK);
  1138. TAsmsymtype=(
  1139. AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,
  1140. {
  1141. the address of this code label is taken somewhere in the code
  1142. so it must be taken care of it when creating pic
  1143. }
  1144. AT_ADDR,
  1145. { Label for debug or other non-program information }
  1146. AT_METADATA,
  1147. { label for data that must always be accessed indirectly, because it
  1148. is handled explcitely in the system unit or (e.g. RTTI and threadvar
  1149. tables) -- never seen in an assembler/assembler writer, always
  1150. changed to AT_DATA }
  1151. AT_DATA_FORCEINDIRECT,
  1152. { don't generate an implicit indirect symbol as that might be provided
  1153. by other means (e.g. the typed const builder) to ensure a correct
  1154. section name }
  1155. AT_DATA_NOINDIRECT,
  1156. { Thread-local symbol (ELF targets) }
  1157. AT_TLS,
  1158. { GNU indirect function (ELF targets) }
  1159. AT_GNU_IFUNC,
  1160. { WebAssembly global variable }
  1161. AT_WASM_GLOBAL,
  1162. { WebAssembly exception tag (used as a parameter for the 'throw' and
  1163. 'catch' instructions) }
  1164. AT_WASM_EXCEPTION_TAG
  1165. );
  1166. var
  1167. s,
  1168. bindstr,
  1169. typestr : string;
  1170. i : longint;
  1171. t: tunitasmlisttype;
  1172. begin
  1173. writeln([space,'Assembler Symbols']);
  1174. writeln([space,'-----------------']);
  1175. t:=tunitasmlisttype(ppufile.getbyte);
  1176. if (t>=Low(tunitasmlisttype)) and (t<=High(tunitasmlisttype)) then
  1177. typestr:=unitasmlisttype[t]
  1178. else
  1179. typestr:='UNKNOWN';
  1180. writeln([space,'Type: ',typestr]);
  1181. writeln([space,'Count: ',ppufile.getlongint]);
  1182. i:=0;
  1183. while (not ppufile.endofentry) and (not ppufile.error) do
  1184. begin
  1185. s:=ppufile.getstring;
  1186. case tasmsymbind(ppufile.getbyte) of
  1187. AB_EXTERNAL :
  1188. bindstr:='External';
  1189. AB_COMMON :
  1190. bindstr:='Common';
  1191. AB_LOCAL :
  1192. bindstr:='Local';
  1193. AB_GLOBAL :
  1194. bindstr:='Global';
  1195. AB_WEAK_EXTERNAL :
  1196. bindstr:='Weak external';
  1197. AB_PRIVATE_EXTERN :
  1198. bindstr:='Private extern';
  1199. AB_LAZY :
  1200. bindstr:='Lazy';
  1201. AB_IMPORT :
  1202. bindstr:='Import';
  1203. AB_TEMP :
  1204. bindstr:='Temp';
  1205. AB_INDIRECT :
  1206. bindstr:='Indirect';
  1207. AB_EXTERNAL_INDIRECT :
  1208. bindstr:='Indirect external';
  1209. AB_WEAK:
  1210. bindstr:='Weak';
  1211. else
  1212. begin
  1213. bindstr:='<Error !!>';
  1214. SetHasErrors;
  1215. end;
  1216. end;
  1217. case tasmsymtype(ppufile.getbyte) of
  1218. AT_FUNCTION :
  1219. typestr:='Function';
  1220. AT_DATA :
  1221. typestr:='Data';
  1222. AT_SECTION :
  1223. typestr:='Section';
  1224. AT_LABEL :
  1225. typestr:='Label';
  1226. AT_ADDR :
  1227. typestr:='Label (with address taken)';
  1228. AT_METADATA :
  1229. typestr:='Metadata';
  1230. { this shouldn't appear in a PPU }
  1231. AT_DATA_FORCEINDIRECT :
  1232. typestr:='Data (ForceIndirect)';
  1233. { this shouldn't appear in a PPU }
  1234. AT_DATA_NOINDIRECT:
  1235. typestr:='Data (NoIndirect)';
  1236. AT_TLS :
  1237. typestr:='TLS';
  1238. AT_GNU_IFUNC :
  1239. typestr:='GNU IFUNC';
  1240. AT_WASM_GLOBAL:
  1241. typestr:='WebAssembly global variable';
  1242. AT_WASM_EXCEPTION_TAG:
  1243. typestr:='WebAssembly exception tag';
  1244. else
  1245. begin
  1246. typestr:='<Error !!>';
  1247. SetHasErrors;
  1248. end;
  1249. end;
  1250. Writeln([space,' ',i,' : ',s,' [',bindstr,',',typestr,']']);
  1251. inc(i);
  1252. end;
  1253. writeln([space]);
  1254. end;
  1255. function getexprint:Tconstexprint;
  1256. begin
  1257. getexprint.overflow:=false;
  1258. getexprint.signed:=ppufile.getboolean;
  1259. getexprint.svalue:=ppufile.getint64;
  1260. end;
  1261. Procedure ReadPosInfo(Def: TPpuDef = nil);
  1262. var
  1263. info : byte;
  1264. fileindex,line,column : longint;
  1265. begin
  1266. with ppufile do
  1267. begin
  1268. fileindex:=0;
  1269. line:=0;
  1270. column:=0;
  1271. {
  1272. info byte layout in bits:
  1273. 0-1 - amount of bytes for fileindex
  1274. 2-3 - amount of bytes for line
  1275. 4-5 - amount of bytes for column
  1276. }
  1277. info:=getbyte;
  1278. case (info and $03) of
  1279. 0 : fileindex:=getbyte;
  1280. 1 : fileindex:=getword;
  1281. 2 : fileindex:=(getbyte shl 16) or getword;
  1282. 3 : fileindex:=getlongint;
  1283. end;
  1284. case ((info shr 2) and $03) of
  1285. 0 : line:=getbyte;
  1286. 1 : line:=getword;
  1287. 2 : line:=(getbyte shl 16) or getword;
  1288. 3 : line:=getlongint;
  1289. end;
  1290. case ((info shr 4) and $03) of
  1291. 0 : column:=getbyte;
  1292. 1 : column:=getword;
  1293. 2 : column:=(getbyte shl 16) or getword;
  1294. 3 : column:=getlongint;
  1295. end;
  1296. Writeln([fileindex,' (',line,',',column,')']);
  1297. if Def <> nil then
  1298. begin
  1299. Def.FilePos.FileIndex:=fileindex;
  1300. Def.FilePos.Line:=line;
  1301. Def.FilePos.Col:=column;
  1302. end;
  1303. end;
  1304. end;
  1305. procedure readderef(const derefspace: string; Ref: TPpuRef = nil);
  1306. var
  1307. b : tdereftype;
  1308. first : boolean;
  1309. idx : longint;
  1310. i,n : byte;
  1311. pdata : pbyte;
  1312. begin
  1313. if not assigned(derefdata) then
  1314. exit;
  1315. first:=true;
  1316. idx:=ppufile.getlongint;
  1317. if idx = -1 then
  1318. begin
  1319. writeln('Nil');
  1320. exit;
  1321. end;
  1322. if (idx>derefdatalen) then
  1323. begin
  1324. WriteError('!! Error: Deref idx '+IntToStr(idx)+' > '+IntToStr(derefdatalen));
  1325. exit;
  1326. end;
  1327. write([derefspace,'(',idx,') ']);
  1328. pdata:=@derefdata[idx];
  1329. i:=0;
  1330. n:=pdata[i];
  1331. inc(i);
  1332. if n<1 then
  1333. begin
  1334. WriteError('!! Error: Deref len < 1');
  1335. exit;
  1336. end;
  1337. while (i<=n) do
  1338. begin
  1339. if not first then
  1340. write(', ')
  1341. else
  1342. first:=false;
  1343. b:=tdereftype(pdata[i]);
  1344. inc(i);
  1345. case b of
  1346. deref_nil :
  1347. write('Nil');
  1348. deref_symid :
  1349. begin
  1350. idx:=BEtoN(unaligned(PInt32(@pdata[i{..i+3}])^));
  1351. inc(i,4);
  1352. write(['SymId ',idx]);
  1353. if Ref <> nil then
  1354. Ref.Id:=idx;
  1355. end;
  1356. deref_defid :
  1357. begin
  1358. idx:=BEtoN(unaligned(PInt32(@pdata[i{..i+3}])^));
  1359. inc(i,4);
  1360. write(['DefId ',idx]);
  1361. if Ref <> nil then
  1362. Ref.Id:=idx;
  1363. end;
  1364. deref_unit :
  1365. begin
  1366. idx:=BEtoN(unaligned(PUint16(@pdata[i{..i+1}])^));
  1367. inc(i,2);
  1368. write(['Unit ',idx]);
  1369. if Ref <> nil then
  1370. Ref.UnitIndex:=idx;
  1371. end;
  1372. else
  1373. begin
  1374. WriteError('!! unsupported dereftyp: '+IntToStr(ord(b)));
  1375. break;
  1376. end;
  1377. end;
  1378. end;
  1379. writeln;
  1380. end;
  1381. Procedure ReadUnitImportSyms;
  1382. var
  1383. c,i : longint;
  1384. begin
  1385. writeln([space,'Imported Symbols']);
  1386. writeln([space,'----------------']);
  1387. c:=ppufile.getlongint;
  1388. for i:=0 to c-1 do
  1389. readderef(space);
  1390. writeln([space]);
  1391. end;
  1392. procedure readpropaccesslist(const s:string; Ref: TPpuRef = nil);
  1393. { type tsltype is in symconst unit }
  1394. const
  1395. slstr : array[tsltype] of string[12] = (
  1396. '',
  1397. 'load',
  1398. 'call',
  1399. 'subscript',
  1400. 'vec',
  1401. 'typeconv',
  1402. 'absolutetype'
  1403. );
  1404. var
  1405. sl : tsltype;
  1406. begin
  1407. readderef('',Ref);
  1408. repeat
  1409. sl:=tsltype(ppufile.getbyte);
  1410. if sl=sl_none then
  1411. break;
  1412. write([s,'(',slstr[sl],') ']);
  1413. case sl of
  1414. sl_none : ;
  1415. sl_call,
  1416. sl_load,
  1417. sl_subscript :
  1418. if (Ref <> nil) and (Ref.IsNull) then
  1419. begin
  1420. readderef('',Ref);
  1421. Ref.IsSymId:=True;
  1422. end
  1423. else
  1424. readderef('');
  1425. sl_absolutetype,
  1426. sl_typeconv :
  1427. readderef('');
  1428. sl_vec :
  1429. begin
  1430. writeln([ppufile.getlongint]);
  1431. readderef('');
  1432. end;
  1433. end;
  1434. until false;
  1435. end;
  1436. (*
  1437. talignmentinfo = packed record
  1438. procalign,
  1439. loopalign,
  1440. jumpalign,
  1441. constalignmin,
  1442. constalignmax,
  1443. varalignmin,
  1444. varalignmax,
  1445. localalignmin,
  1446. localalignmax,
  1447. recordalignmin,
  1448. recordalignmax,
  1449. maxCrecordalign : longint;
  1450. end;
  1451. tsettings = packed record
  1452. alignment : talignmentinfo;
  1453. globalswitches : tglobalswitches;
  1454. moduleswitches : tmoduleswitches;
  1455. localswitches : tlocalswitches;
  1456. modeswitches : tmodeswitches;
  1457. optimizerswitches : toptimizerswitches;
  1458. { generate information necessary to perform these wpo's during a subsequent compilation }
  1459. genwpoptimizerswitches: twpoptimizerswitches;
  1460. { perform these wpo's using information generated during a previous compilation }
  1461. dowpoptimizerswitches: twpoptimizerswitches;
  1462. debugswitches : tdebugswitches;
  1463. { 0: old behaviour for sets <=256 elements
  1464. >0: round to this size }
  1465. setalloc,
  1466. packenum : shortint;
  1467. packrecords : shortint;
  1468. maxfpuregisters : shortint;
  1469. cputype,
  1470. optimizecputype : tcputype;
  1471. fputype : tfputype;
  1472. asmmode : tasmmode;
  1473. interfacetype : tinterfacetypes;
  1474. defproccall : tproccalloption;
  1475. sourcecodepage : tcodepagestring;
  1476. minfpconstprec : tfloattype;
  1477. disabledircache : boolean;
  1478. { CPU targets with microcontroller support can add a controller specific unit }
  1479. controllertype : tcontrollertype;
  1480. { WARNING: this pointer cannot be written as such in record token }
  1481. pmessage : pmessagestaterecord;
  1482. end;
  1483. *)
  1484. procedure readprocinfooptions(space : string);
  1485. (*
  1486. tprocinfoflag=(
  1487. { procedure has at least one assembler block }
  1488. pi_has_assembler_block,
  1489. { procedure does a call }
  1490. pi_do_call,
  1491. { procedure has a try statement = no register optimization }
  1492. pi_uses_exceptions,
  1493. { procedure is declared as @var(assembler), don't optimize}
  1494. pi_is_assembler,
  1495. { procedure contains data which needs to be finalized }
  1496. pi_needs_implicit_finally,
  1497. { procedure has the implicit try..finally generated }
  1498. pi_has_implicit_finally,
  1499. { procedure uses fpu}
  1500. pi_uses_fpu,
  1501. { procedure uses GOT for PIC code }
  1502. pi_needs_got,
  1503. { references var/proc/type/const in static symtable,
  1504. i.e. not allowed for inlining from other units }
  1505. pi_uses_static_symtable,
  1506. { set if the procedure has to push parameters onto the stack }
  1507. pi_has_stackparameter,
  1508. { set if the procedure has at least one label }
  1509. pi_has_label,
  1510. { calls itself recursive }
  1511. pi_is_recursive,
  1512. { stack frame optimization not possible (only on x86 probably) }
  1513. pi_needs_stackframe,
  1514. { set if the procedure has at least one register saved on the stack }
  1515. pi_has_saved_regs,
  1516. { dfa was generated for this proc }
  1517. pi_dfaavailable,
  1518. { subroutine contains interprocedural used labels }
  1519. pi_has_interproclabel,
  1520. { subroutine contains interprocedural gotos }
  1521. pi_has_global_goto
  1522. ); *)
  1523. type
  1524. tprocinfoopt=record
  1525. mask : tprocinfoflag;
  1526. str : string[82];
  1527. end;
  1528. const
  1529. procinfoopts=ord(high(tprocinfoflag)) - ord(low(tprocinfoflag));
  1530. procinfoopt : array[0..procinfoopts] of tprocinfoopt=(
  1531. (mask:pi_has_assembler_block;
  1532. str:' has at least one assembler block'),
  1533. (mask:pi_do_call;
  1534. str:' does a call'),
  1535. (mask:pi_uses_exceptions;
  1536. str:' has a try statement = no register optimization '),
  1537. (mask:pi_is_assembler;
  1538. str:' is declared as @var(assembler), don''t optimize'),
  1539. (mask:pi_needs_implicit_finally;
  1540. str:' contains data which needs to be finalized '),
  1541. (mask:pi_has_implicit_finally;
  1542. str:' has the implicit try..finally generated '),
  1543. (mask:pi_uses_fpu;
  1544. str:' uses fpu'),
  1545. (mask:pi_needs_got;
  1546. str:' uses GOT for PIC code '),
  1547. (mask:pi_uses_static_symtable;
  1548. str:' references var/proc/type/const in static symtable'),
  1549. (mask:pi_has_stackparameter;
  1550. str:' set if the procedure has to push parameters onto the stack '),
  1551. (mask:pi_has_label;
  1552. str:' set if the procedure has at least one label '),
  1553. (mask:pi_is_recursive;
  1554. str:' calls itself recursive '),
  1555. (mask:pi_needs_stackframe;
  1556. str:' stack frame optimization not possible (only on x86 probably) '),
  1557. (mask:pi_has_saved_regs;
  1558. str:' set if the procedure has at least one register saved on the stack '),
  1559. (mask:pi_dfaavailable;
  1560. str:' dfa was generated for this proc '),
  1561. (mask:pi_has_interproclabel;
  1562. str:' subroutine contains interprocedural used labels '),
  1563. (mask:pi_has_unwind_info;
  1564. str:' unwinding info was generated for this proc '),
  1565. (mask:pi_has_global_goto;
  1566. str:' subroutine contains interprocedural goto '),
  1567. (mask:pi_has_inherited;
  1568. str:' subroutine contains inherited call '),
  1569. (mask:pi_has_nested_exit;
  1570. str:' subroutine contains a nested subroutine which calls the exit of the current one '),
  1571. (mask:pi_has_stack_allocs;
  1572. str:' allocates memory on stack, so stack may be unbalanced on exit '),
  1573. (mask:pi_estimatestacksize;
  1574. str:' stack size is estimated before subroutine is compiled '),
  1575. (mask:pi_calls_c_varargs;
  1576. str:' calls function with C-style varargs '),
  1577. (mask:pi_has_open_array_parameter;
  1578. str:' has open array parameter '),
  1579. (mask:pi_uses_threadvar;
  1580. str:' uses threadvars '),
  1581. (mask:pi_has_except_table_data;
  1582. str:' has except table data '),
  1583. (mask:pi_needs_tls;
  1584. str:' uses TLS data pointer '),
  1585. (mask:pi_uses_get_frame;
  1586. str:' uses get_frame'),
  1587. (mask:pi_uses_ymm;
  1588. str:' uses ymm register (x86 only)'),
  1589. (mask:pi_no_framepointer_needed;
  1590. str:' set if no frame pointer is needed, the rules when this applies is target specific'
  1591. )
  1592. );
  1593. var
  1594. procinfooptions : tprocinfoflags;
  1595. i : longint;
  1596. first : boolean;
  1597. begin
  1598. ppufile.getset(tppuset4(procinfooptions));
  1599. if procinfooptions<>[] then
  1600. begin
  1601. first:=true;
  1602. for i:=0 to procinfoopts do
  1603. if (procinfoopt[i].mask in procinfooptions) then
  1604. begin
  1605. if first then
  1606. first:=false
  1607. else
  1608. write(', ');
  1609. write(procinfoopt[i].str);
  1610. end;
  1611. end;
  1612. writeln;
  1613. end;
  1614. procedure readsymoptions(space : string; Def: TPpuDef = nil);
  1615. type
  1616. tsymopt=record
  1617. mask : tsymoption;
  1618. str : string[30];
  1619. end;
  1620. const
  1621. symopts=ord(high(tsymoption)) - ord(low(tsymoption));
  1622. { sp_none = 0 corresponds to nothing }
  1623. symopt : array[1..symopts] of tsymopt=(
  1624. (mask:sp_static; str:'Static'),
  1625. (mask:sp_hint_deprecated; str:'Hint Deprecated'),
  1626. (mask:sp_hint_platform; str:'Hint Platform'),
  1627. (mask:sp_hint_library; str:'Hint Library'),
  1628. (mask:sp_hint_unimplemented; str:'Hint Unimplemented'),
  1629. (mask:sp_hint_experimental; str:'Hint Experimental'),
  1630. (mask:sp_has_overloaded; str:'Has overloaded'),
  1631. (mask:sp_internal; str:'Internal'),
  1632. (mask:sp_implicitrename; str:'Implicit Rename'),
  1633. (mask:sp_generic_para; str:'Generic Parameter'),
  1634. (mask:sp_has_deprecated_msg; str:'Has Deprecated Message'),
  1635. (mask:sp_generic_dummy; str:'Generic Dummy'),
  1636. (mask:sp_explicitrename; str:'Explicit Rename'),
  1637. (mask:sp_generic_const; str:'Generic Constant Parameter'),
  1638. (mask:sp_generic_unnamed_type;str:'Generic Unnamed Type')
  1639. );
  1640. var
  1641. symoptions : tsymoptions;
  1642. i : longint;
  1643. first : boolean;
  1644. begin
  1645. ppufile.getset(tppuset2(symoptions));
  1646. if symoptions<>[] then
  1647. begin
  1648. if Def <> nil then
  1649. begin
  1650. if sp_internal in symoptions then
  1651. Def.Visibility:=dvHidden;
  1652. if sp_generic_dummy in symoptions then
  1653. Def.GenericDummy:=true;
  1654. end;
  1655. first:=true;
  1656. for i:=1to symopts do
  1657. if (symopt[i].mask in symoptions) then
  1658. begin
  1659. if first then
  1660. first:=false
  1661. else
  1662. write(', ');
  1663. write(symopt[i].str);
  1664. end;
  1665. end;
  1666. writeln;
  1667. if sp_has_deprecated_msg in symoptions then
  1668. writeln([space,'Deprecated : ', ppufile.getstring]);
  1669. end;
  1670. procedure readvisibility(Def: TPpuDef = nil);
  1671. var
  1672. i: byte;
  1673. begin
  1674. i:=ppufile.getbyte;
  1675. if Def <> nil then
  1676. case tvisibility(i) of
  1677. vis_public: Def.Visibility:=dvPublic;
  1678. vis_published: Def.Visibility:=dvPublished;
  1679. vis_protected, vis_strictprotected: Def.Visibility:=dvProtected;
  1680. else Def.Visibility:=dvPrivate;
  1681. end;
  1682. writeln(Visibility2Str(i));
  1683. end;
  1684. procedure readattrs(def: TPpuDef);
  1685. var
  1686. i,cnt,paras: longint;
  1687. begin
  1688. cnt:=ppufile.getlongint;
  1689. if cnt>0 then
  1690. begin
  1691. writeln([space,' Attributes : ']);
  1692. space:=' '+space;
  1693. if assigned(def) then
  1694. SetLength(def.Attrs,cnt);
  1695. for i:=0 to cnt-1 do
  1696. begin
  1697. writeln([space,'** Custom Attribute ',i,' **']);
  1698. write ([space,' Type symbol : ']);
  1699. if assigned(def) then
  1700. begin
  1701. def.Attrs[i].TypeSym:=TPpuRef.Create;
  1702. readderef('',def.Attrs[i].TypeSym);
  1703. end
  1704. else
  1705. readderef('');
  1706. write ([space,' Type constructor : ']);
  1707. if assigned(def) then
  1708. begin
  1709. def.Attrs[i].TypeConstr:=TPpuRef.Create;
  1710. readderef('',def.Attrs[i].TypeConstr);
  1711. end
  1712. else
  1713. readderef('');
  1714. paras:=ppufile.getlongint;
  1715. writeln([space,' Parameters : ',paras]);
  1716. if assigned(def) then
  1717. def.Attrs[i].ParaCount:=paras;
  1718. end;
  1719. delete(space,1,4);
  1720. end;
  1721. end;
  1722. procedure readnodetree; forward;
  1723. procedure readattrparas(def: TPpuDef);
  1724. var
  1725. attr,para: LongInt;
  1726. begin
  1727. if Length(def.Attrs) > 0 then
  1728. writeln([space,' Attr Paras : ']);
  1729. space:=' '+space;
  1730. for attr:=0 to High(def.Attrs) do
  1731. begin
  1732. writeln([space,'** Custom Attribute ',attr,' Arguments **']);
  1733. space:=' '+space;
  1734. for para:=0 to def.Attrs[attr].ParaCount-1 do
  1735. begin
  1736. readnodetree;
  1737. end;
  1738. delete(space,1,4);
  1739. end;
  1740. delete(space,1,4);
  1741. end;
  1742. procedure readdefsubentries(def: TPpuDef);
  1743. begin
  1744. space:=' '+space;
  1745. readattrparas(def);
  1746. delete(space,1,4);
  1747. end;
  1748. procedure readsymsubentries(def: TPpuDef);
  1749. begin
  1750. readattrparas(def);
  1751. end;
  1752. procedure readcommonsym(const s:string; Def: TPpuDef = nil);
  1753. var
  1754. i: integer;
  1755. n: ansistring;
  1756. begin
  1757. n:=readsymstr(ppufile);
  1758. if Def <> nil then
  1759. Def.Name:=n;
  1760. i:=ppufile.getlongint;
  1761. if Def <> nil then
  1762. Def.SetSymId(i);
  1763. writeln([space,'** Symbol Id ',i,' **']);
  1764. writeln([space,s,n]);
  1765. write ([space,' File Pos : ']);
  1766. readposinfo(Def);
  1767. write ([space,' Visibility : ']);
  1768. readvisibility(Def);
  1769. write ([space,' SymOptions : ']);
  1770. readsymoptions(space+' ',Def);
  1771. readattrs(Def);
  1772. end;
  1773. procedure readcgpara(const space:string);
  1774. { this is originally in cgbase.pas }
  1775. type
  1776. TCGLoc=(LOC_INVALID, LOC_VOID, LOC_CONSTANT, LOC_JUMP, LOC_FLAGS,
  1777. LOC_REGISTER, LOC_CREGISTER, LOC_FPUREGISTER, LOC_CFPUREGISTER,
  1778. LOC_MMXREGISTER, LOC_CMMXREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
  1779. LOC_SUBSETREG, LOC_CSUBSETREG, LOC_SUBSETREF, LOC_CSUBSETREF,
  1780. LOC_CREFERENCE, LOC_REFERENCE);
  1781. const
  1782. tcgloc2str : array[TCGLoc] of string[12] = (
  1783. 'LOC_INVALID', 'LOC_VOID', 'LOC_CONST', 'LOC_JUMP', 'LOC_FLAGS',
  1784. 'LOC_REG', 'LOC_CREG', 'LOC_FPUREG', 'LOC_CFPUREG',
  1785. 'LOC_MMXREG', 'LOC_CMMXREG', 'LOC_MMREG', 'LOC_CMMREG',
  1786. 'LOC_SSETREG', 'LOC_CSSETREG', 'LOC_SSETREF', 'LOC_CSSETREF',
  1787. 'LOC_CREF', 'LOC_REF');
  1788. var
  1789. i: byte;
  1790. ii: longint;
  1791. np: byte;
  1792. loc: tcgloc;
  1793. begin
  1794. i:=ppufile.getbyte;
  1795. writeln([space,' Alignment : ',i]);
  1796. i:=ppufile.getbyte;
  1797. writeln([space,' Size : ',i]);
  1798. ii:=ppufile.getaint;
  1799. writeln([space,' IntSize : ',ii]);
  1800. readderef(space+' ');
  1801. np:=ppufile.getbyte;
  1802. writeln([space,' NumParaloc : ',np]);
  1803. while np > 0 do
  1804. begin
  1805. i:=ppufile.getbyte;
  1806. writeln([space,' Paraloc Size : ',i]);
  1807. loc:=tcgloc(ppufile.getbyte);
  1808. if loc > high(tcgloc) then
  1809. begin
  1810. WriteError('!! Location is out of range! '+IntToStr(ord(loc)));
  1811. loc:=LOC_INVALID;
  1812. end;
  1813. writeln([space,' Paraloc Loc : (',ord(loc),') ',tcgloc2str[loc]]);
  1814. case loc of
  1815. LOC_REFERENCE:
  1816. begin
  1817. writeln([space,' RegIndex : $',hexstr(ppufile.getdword,8)]);
  1818. writeln([space,' Offset : ',ppufile.getaint]);
  1819. end;
  1820. LOC_FPUREGISTER,
  1821. LOC_CFPUREGISTER,
  1822. LOC_MMREGISTER,
  1823. LOC_CMMREGISTER,
  1824. LOC_REGISTER,
  1825. LOC_CREGISTER :
  1826. begin
  1827. writeln([space,' ShiftVal : ',ppufile.getbyte]);
  1828. writeln([space,' Register : $',hexstr(ppufile.getdword,8)]);
  1829. end;
  1830. LOC_VOID:
  1831. begin end
  1832. else
  1833. WriteError('!! Invalid location error')
  1834. end;
  1835. dec(np);
  1836. end;
  1837. end;
  1838. procedure displaytokenbuffer(tokenbuf : pbyte;tokenbufsize : longint);
  1839. type
  1840. ptoken=^ttoken;
  1841. pmsgstate =^tmsgstate;
  1842. var
  1843. tbi : longint;
  1844. state : tmsgstate;
  1845. prev_settings, new_settings : Tsettings;
  1846. nb, msgvalue, mesgnb : longint;
  1847. function readtoken: ttoken;
  1848. var
  1849. b,b2 : byte;
  1850. begin
  1851. b:=tokenbuf[tbi];
  1852. inc(tbi);
  1853. if (b and $80)<>0 then
  1854. begin
  1855. b2:=tokenbuf[tbi];
  1856. inc(tbi);
  1857. result:=ttoken(((b and $7f) shl 8) or b2);
  1858. end
  1859. else
  1860. result:=ttoken(b);
  1861. end;
  1862. function gettokenbufdword : dword;
  1863. var
  1864. var32 : dword;
  1865. begin
  1866. var32:=unaligned(pdword(@tokenbuf[tbi])^);
  1867. inc(tbi,sizeof(dword));
  1868. if ppufile.change_endian then
  1869. var32:=swapendian(var32);
  1870. result:=var32;
  1871. end;
  1872. function gettokenbufword : word;
  1873. var
  1874. var16 : word;
  1875. begin
  1876. var16:=unaligned(pword(@tokenbuf[tbi])^);
  1877. inc(tbi,sizeof(word));
  1878. if ppufile.change_endian then
  1879. var16:=swapendian(var16);
  1880. result:=var16;
  1881. end;
  1882. function gettokenbuflongint : longint;
  1883. var
  1884. var32 : longint;
  1885. begin
  1886. var32:=unaligned(plongint(@tokenbuf[tbi])^);
  1887. inc(tbi,sizeof(longint));
  1888. if ppufile.change_endian then
  1889. var32:=swapendian(var32);
  1890. result:=var32;
  1891. end;
  1892. function gettokenbufshortint : shortint;
  1893. var
  1894. var8 : shortint;
  1895. begin
  1896. var8:=pshortint(@tokenbuf[tbi])^;
  1897. inc(tbi,sizeof(shortint));
  1898. result:=var8;
  1899. end;
  1900. procedure tokenreadset(var b;size : longint);
  1901. var
  1902. i : longint;
  1903. begin
  1904. move(tokenbuf[tbi],b,size);
  1905. inc(tbi,size);
  1906. if ppufile.change_endian then
  1907. for i:=0 to size-1 do
  1908. Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]);
  1909. end;
  1910. function gettokenbufbyte : byte;
  1911. begin
  1912. result:=pbyte(@tokenbuf[tbi])^;
  1913. inc(tbi);
  1914. end;
  1915. function tokenreadenum(size : longint) : longword;
  1916. begin
  1917. if size=1 then
  1918. result:=gettokenbufbyte
  1919. else if size=2 then
  1920. result:=gettokenbufword
  1921. else if size=4 then
  1922. result:=gettokenbufdword;
  1923. end;
  1924. function gettokenbufsizeint : int64;
  1925. var
  1926. var64 : int64;
  1927. var32 : longint;
  1928. var16 : smallint;
  1929. begin
  1930. if CpuAddrBitSize[cpu]=64 then
  1931. begin
  1932. var64:=unaligned(pint64(@tokenbuf[tbi])^);
  1933. inc(tbi,sizeof(int64));
  1934. if ppufile.change_endian then
  1935. var64:=swapendian(var64);
  1936. result:=var64;
  1937. end
  1938. else if CpuAddrBitSize[cpu]=32 then
  1939. begin
  1940. var32:=unaligned(plongint(@tokenbuf[tbi])^);
  1941. inc(tbi,sizeof(longint));
  1942. if ppufile.change_endian then
  1943. var32:=swapendian(var32);
  1944. result:=var32;
  1945. end
  1946. else if CpuAddrBitSize[cpu]=16 then
  1947. begin
  1948. { ASizeInt is still a longint, see globtype.pas unit }
  1949. var32:=unaligned(plongint(@tokenbuf[tbi])^);
  1950. inc(tbi,sizeof(longint));
  1951. if ppufile.change_endian then
  1952. var32:=swapendian(var32);
  1953. result:=var32;
  1954. end
  1955. else
  1956. begin
  1957. WriteError('Wrong CpuAddrBitSize');
  1958. result:=0;
  1959. end;
  1960. end;
  1961. procedure tokenreadsettings(var asettings : tsettings; expected_size : asizeint);
  1962. { This procedure
  1963. needs to be changed whenever
  1964. globals.tsettings type is changed,
  1965. the problem is that no error will appear
  1966. before tests with generics are tested. PM }
  1967. var
  1968. startpos, endpos : longword;
  1969. begin
  1970. { WARNING all those fields need to be in the correct
  1971. order otherwise cross_endian PPU reading will fail }
  1972. startpos:=tbi;
  1973. with asettings do
  1974. begin
  1975. alignment.procalign:=gettokenbuflongint;
  1976. alignment.loopalign:=gettokenbuflongint;
  1977. alignment.jumpalign:=gettokenbuflongint;
  1978. alignment.jumpalignskipmax:=gettokenbuflongint;
  1979. alignment.coalescealign:=gettokenbuflongint;
  1980. alignment.coalescealignskipmax:=gettokenbuflongint;
  1981. alignment.constalignmin:=gettokenbuflongint;
  1982. alignment.constalignmax:=gettokenbuflongint;
  1983. alignment.varalignmin:=gettokenbuflongint;
  1984. alignment.varalignmax:=gettokenbuflongint;
  1985. alignment.localalignmin:=gettokenbuflongint;
  1986. alignment.localalignmax:=gettokenbuflongint;
  1987. alignment.recordalignmin:=gettokenbuflongint;
  1988. alignment.recordalignmax:=gettokenbuflongint;
  1989. alignment.maxCrecordalign:=gettokenbuflongint;
  1990. tokenreadset(globalswitches,sizeof(globalswitches));
  1991. tokenreadset(targetswitches,sizeof(targetswitches));
  1992. tokenreadset(moduleswitches,sizeof(moduleswitches));
  1993. tokenreadset(localswitches,sizeof(localswitches));
  1994. tokenreadset(modeswitches,sizeof(modeswitches));
  1995. tokenreadset(optimizerswitches,sizeof(optimizerswitches));
  1996. tokenreadset(genwpoptimizerswitches,sizeof(genwpoptimizerswitches));
  1997. tokenreadset(dowpoptimizerswitches,sizeof(dowpoptimizerswitches));
  1998. tokenreadset(debugswitches,sizeof(debugswitches));
  1999. { 0: old behaviour for sets <=256 elements
  2000. >0: round to this size }
  2001. setalloc:=gettokenbufshortint;
  2002. packenum:=gettokenbufshortint;
  2003. packrecords:=gettokenbufshortint;
  2004. maxfpuregisters:=gettokenbufshortint;
  2005. cputype:=tcputype(tokenreadenum(sizeof(tcputype)));
  2006. optimizecputype:=tcputype(tokenreadenum(sizeof(tcputype)));
  2007. fputype:=tfputype(tokenreadenum(sizeof(tfputype)));
  2008. asmmode:=tasmmode(tokenreadenum(sizeof(tasmmode)));
  2009. interfacetype:=tinterfacetypes(tokenreadenum(sizeof(tinterfacetypes)));
  2010. defproccall:=tproccalloption(tokenreadenum(sizeof(tproccalloption)));
  2011. { tstringencoding is word type,
  2012. thus this should be OK here }
  2013. sourcecodepage:=tstringEncoding(gettokenbufword);
  2014. minfpconstprec:=tfloattype(tokenreadenum(sizeof(tfloattype)));
  2015. disabledircache:=boolean(gettokenbufbyte);
  2016. tlsmodel:=ttlsmodel(tokenreadenum(sizeof(ttlsmodel)));
  2017. { TH: Since the field was conditional originally, it was not stored in PPUs. }
  2018. { While adding ControllerSupport constant, I decided not to store ct_none }
  2019. { on targets not supporting controllers, but this might be changed here and }
  2020. { in tokenwritesettings in the future to unify the PPU structure and handling }
  2021. { of this field in the compiler. }
  2022. {$PUSH}
  2023. {$WARN 6018 OFF} (* Unreachable code due to compile time evaluation *)
  2024. if CpuHasController[cpu] then
  2025. controllertype:=tcontrollertype(tokenreadenum(sizeof(tcontrollertype)))
  2026. else
  2027. ControllerType:=ct_none;
  2028. {$POP}
  2029. endpos:=tbi;
  2030. if endpos-startpos<>expected_size then
  2031. Writeln(['Wrong size of Settings read-in: ',expected_size,' expected, but got ',endpos-startpos]);
  2032. end;
  2033. end;
  2034. procedure dump_new_settings;
  2035. (* tsettings = record
  2036. alignment : talignmentinfo;
  2037. globalswitches : tglobalswitches;
  2038. targetswitches : ttargetswitches;
  2039. moduleswitches : tmoduleswitches;
  2040. localswitches : tlocalswitches;
  2041. modeswitches : tmodeswitches;
  2042. optimizerswitches : toptimizerswitches;
  2043. { generate information necessary to perform these wpo's during a subsequent compilation }
  2044. genwpoptimizerswitches: twpoptimizerswitches;
  2045. { perform these wpo's using information generated during a previous compilation }
  2046. dowpoptimizerswitches: twpoptimizerswitches;
  2047. debugswitches : tdebugswitches;
  2048. { 0: old behaviour for sets <=256 elements
  2049. >0: round to this size }
  2050. setalloc,
  2051. packenum : shortint;
  2052. packrecords : shortint;
  2053. maxfpuregisters : shortint;
  2054. cputype,
  2055. optimizecputype,
  2056. asmcputype : tcputype;
  2057. fputype : tfputype;
  2058. asmmode : tasmmode;
  2059. interfacetype : tinterfacetypes;
  2060. defproccall : tproccalloption;
  2061. sourcecodepage : tstringencoding;
  2062. minfpconstprec : tfloattype;
  2063. disabledircache : boolean;
  2064. tlsmodel : ttlsmodel;
  2065. {$if defined(i8086)}
  2066. x86memorymodel : tx86memorymodel;
  2067. {$endif defined(i8086)}
  2068. {$if defined(ARM)}
  2069. instructionset : tinstructionset;
  2070. {$endif defined(ARM)}
  2071. {$if defined(LLVM) and not defined(GENERIC_CPU)}
  2072. llvmversion: tllvmversion;
  2073. {$endif defined(LLVM) and not defined(GENERIC_CPU)}
  2074. { CPU targets with microcontroller support can add a controller specific unit }
  2075. controllertype : tcontrollertype;
  2076. { WARNING: this pointer cannot be written as such in record token }
  2077. pmessage : pmessagestaterecord;
  2078. end; *)
  2079. const
  2080. targetswitchname : array[ttargetswitch] of string[77] =
  2081. { global target-specific switches }
  2082. ('Target None', {ts_none}
  2083. { generate code that results in smaller TOCs than normal (AIX) }
  2084. 'Small TOC', {ts_small_toc}
  2085. { for the JVM target: generate integer array initializations via string
  2086. constants in order to reduce the generated code size (Java routines
  2087. are limited to 64kb of bytecode) }
  2088. 'JVM compact int array init', {ts_compact_int_array_init}
  2089. { for the JVM target: intialize enum fields in constructors with the
  2090. enum class instance corresponding to ordinal value 0 (not done by
  2091. default because this initialization can only be performed after the
  2092. inherited constructors have run, and if they call a virtual method
  2093. of the current class, then this virtual method may already have
  2094. initialized that field with another value and the constructor
  2095. initialization will result in data loss }
  2096. 'JVM enum field init', {ts_jvm_enum_field_init}
  2097. { when automatically generating getters/setters for properties, use
  2098. these strings as prefixes for the generated getters/setter names }
  2099. 'Auto getter prefix', {ts_auto_getter_prefix}
  2100. 'Auto setter prefix', {ts_auto_setter_predix}
  2101. 'Thumb interworking', {ts_thumb_interworking,}
  2102. { lowercase the first character of routine names, used to generate
  2103. names that are compliant with Java coding standards from code
  2104. written according to Delphi coding standards }
  2105. 'LowerCase proc start', {ts_lowercase_proc_start,}
  2106. { initialise local variables on the JVM target so you won't get
  2107. accidental uses of uninitialised values }
  2108. 'Init locals', {ts_init_locals}
  2109. { emit a CLD instruction before using the x86 string instructions }
  2110. 'Emit CLD instruction', {ts_cld}
  2111. { increment BP before pushing it in the function prologue and decrement
  2112. it after popping it in the function epilogue, iff the function is
  2113. going to terminate with a far ret. Thus, the BP value pushed on the
  2114. stack becomes odd if the function is far and even if the function is
  2115. near. This allows walking the BP chain on the stack and e.g.
  2116. obtaining a stack trace even if the program uses a mixture of near
  2117. and far calls. This is also required for Win16 real mode, because it
  2118. allows Windows to move code segments around (in order to defragment
  2119. memory) and then walk through the stacks of all running programs and
  2120. update the segment values of the segment that has moved. }
  2121. 'Use odd BP for far procs', {ts_x86_far_procs_push_odd_bp}
  2122. 'No exception support', {ts_wasm_no_exceptions}
  2123. 'Branchful exceptions support', {ts_wasm_bf_exceptions}
  2124. 'JavaScript-based exception support', {ts_wasm_js_exceptions}
  2125. 'Native WebAssembly exceptions support', {ts_wasm_native_exceptions}
  2126. 'WebAssembly threads support', {ts_wasm_threads}
  2127. 'Use WebAssembly saturating (nontrapping) float to int conversion instructions' {ts_wasm_saturating_float_to_int}
  2128. );
  2129. moduleswitchname : array[tmoduleswitch] of string[40] =
  2130. ('Module None', {cs_modulenone,}
  2131. { parser }
  2132. 'Floating Point Emulation',{ cs_fp_emulation}
  2133. 'Extended syntax', {cs_extsyntax}
  2134. { support }
  2135. 'Goto allowed', {cs_support_goto}
  2136. 'Macro support', {cs_support_macro}
  2137. 'C operator support', {cs_support_c_operators}
  2138. { generation }
  2139. 'Profile', {cs_profile}
  2140. 'Debug information', {cs_debuginfo}
  2141. 'Compilation of System unit', {cs_compilesystem}
  2142. 'Line information', {cs_lineinfo}
  2143. 'Implicit exceptions', {cs_implicit_exceptions}
  2144. 'Explicit CodePage', {cs_explicit_codepage}
  2145. 'System CodePage', {cs_system_codepage}
  2146. { linking }
  2147. 'Create smart units', {cs_create_smart}
  2148. 'Create dynamic', {cs_create_dynamic}
  2149. 'Create PIC code', {cs_create_pic}
  2150. { browser switches are back }
  2151. 'Browser', {cs_browser}
  2152. 'Local Browser', {cs_local_browser}
  2153. { target specific }
  2154. 'Executable Stack', {cs_executable_stack}
  2155. { i8086 specific }
  2156. 'Huge code', {cs_huge_code}
  2157. 'Win16 smart callbacks', {cs_win16_smartcallbacks}
  2158. { Record usage of checkpointer experimental feature }
  2159. 'CheckPointer used', {cs_checkpointer_called}
  2160. 'Supports LLVM Link-Time Optimization' {cs_lto}
  2161. ,'Enable LLVM Address Sanitizer'
  2162. );
  2163. globalswitchname : array[tglobalswitch] of string[73] =
  2164. ('Global None',{cs_globalnone}
  2165. { parameter switches }
  2166. 'Check unit name', {cs_check_unit_name}
  2167. 'Constructor name', {cs_constructor_name}
  2168. 'Support exceptions',{cs_support_exceptions}
  2169. 'Support Objective-C pas',{ cs_support_c_objectivepas}
  2170. 'Transparent file names', {cs_transparent_file_names}
  2171. { units }
  2172. 'Load Objpas Unit', {cs_load_objpas_unit}
  2173. 'Load GPC unit', {cs_load_gpc_unit}
  2174. 'Load FPCKylix unit', {cs_load_fpcylix_unit}
  2175. 'Support Vectors', {cs_support_vectors}
  2176. { debuginfo }
  2177. 'Use HeapTRc unit', {cs_use_heaptrc}
  2178. 'Use line information', {cs_use_lineinfo}
  2179. 'Use GDB Valgrind', {cs_gdb_valgrind}
  2180. 'No regalloc', {cs_no_regalloc}
  2181. 'Stabs preserve cases', {cs_stabs_preservecase}
  2182. { assembling }
  2183. 'Leave assembler file', {cs_asm_leave}
  2184. 'Use external assembler', {cs_asm_extern}
  2185. 'Use pipes to call assembler', {cs_asm_pipe}
  2186. 'Add source infos into assembler files', {cs_asm_source}
  2187. 'Add RTTI infos into assembler files', {cs_asm_rtti_source}
  2188. 'Add register allocation into assembler files', {cs_asm_regalloc}
  2189. 'Add temporary allocation into assmebler files', {cs_asm_tempalloc}
  2190. 'Add node information into assembler files', {cs_asm_nodes}
  2191. 'Adapt assembler call to GNU version <= 2.25', {cs_asm_pre_binutils_2_25}
  2192. { linking }
  2193. 'Skip linking stage', {cs_link_nolink}
  2194. 'Link static', {cs_link_static}
  2195. 'Link smart', {cs_link_smart}
  2196. 'Link shared', {cs_link_shared}
  2197. 'Link deffile', {cs_link_deffile}
  2198. 'Strip after linking', {cs_link_strip}
  2199. 'Use linker static flag',{cs_link_staticflag}
  2200. 'Link on target OS',{cs_link_on_target}
  2201. 'Use external linker', {cs_link_extern}
  2202. 'Link opt vtable', {cs_link_opt_vtable}
  2203. 'Link opt used sections', {cs_link_opt_used_sections}
  2204. 'Link debug to separate file',{cs_link_separate_dbg_file}
  2205. 'Create linker map', {cs_link_map}
  2206. 'Link to pthread', {cs_link_pthread}
  2207. 'Link no default lib order', {cs_link_no_default_lib_order}
  2208. 'Link using native linker', {cs_link_native}
  2209. 'Link for GNU linker version <=2.19', {cs_link_pre_binutils_2_19}
  2210. 'Link using vlink', {cs_link_vlink}
  2211. 'Discard _START code', {cs_link_discard_start}
  2212. 'Discard code initializing the zero register and stack pointer', {cs_link_discard_zeroreg_sp}
  2213. 'Discard initializing data', {cs_link_discard_copydata}
  2214. 'Discard jump to PASCALMAIN', {cs_link_discard_jmp_main}
  2215. 'Link-Time Optimization disabled for system unit', {cs_lto_nosystem}
  2216. 'Assemble on target OS', {cs_asemble_on_target}
  2217. 'Use a memory model to support >2GB static data on 64 Bit target', {cs_large}
  2218. 'Generate UF2 binary', {cs_generate_uf2}
  2219. 'Link using ld.lld GNU compatible LLVM linker' {cs_link_lld}
  2220. );
  2221. localswitchname : array[tlocalswitch] of string[50] =
  2222. { Switches which can be changed locally }
  2223. ('Local None', {cs_localnone}
  2224. { codegen }
  2225. 'Check overflow', {cs_check_overflow}
  2226. 'Check range', {cs_check_range}
  2227. 'Check object error', {cs_check_object}
  2228. 'Check I/O error', {cs_check_io}
  2229. 'Check stack', {cs_check_stack}
  2230. 'Check pointer', {cs_checkpointer}
  2231. 'Check ordinal size', {cs_check_ordinal_size}
  2232. 'Generate stackframes', {cs_generate_stackframes}
  2233. 'Do assertions', {cs_do_assertion}
  2234. 'Generate RTTI', {cs_generate_rtti}
  2235. 'Full boolean evaluaion', {cs_full_boolean_eval}
  2236. 'Typed constant are writable', {cs_typed_const_writable}
  2237. 'Allow calcuation on enum types', {cs_allow_enum_calc}
  2238. 'Do inline', {cs_do_inline}
  2239. 'Add FWAIT instruction for FPU 8087', {cs_fpu_fwait}
  2240. 'IEEE errors', {cs_ieee_errors}
  2241. 'Check low address loading', {cs_check_low_addr_load}
  2242. 'Imported data', {cs_imported_data}
  2243. 'Excess precision', {cs_excessprecision}
  2244. 'Check fpu exceptions', {cs_check_fpu_exceptions}
  2245. 'Check all case coverage', {cs_check_all_case_coverage}
  2246. { mmx }
  2247. 'Allow MMX instructions', {cs_mmx}
  2248. 'Use MMX saturation', {cs_mmx_saturation}
  2249. { parser }
  2250. 'Use typed addresses', {cs_typed_addresses}
  2251. 'Use strict var strings', {cs_strict_var_strings}
  2252. 'Use reference counted strings', {cs_refcountedstrings}
  2253. 'Use bit-packing', {cs_bitpacking}
  2254. 'Use var property setter', {cs_varpropsetter}
  2255. 'Use scoped enums',{cs_scopedenums}
  2256. 'Use pointer math', {cs_pointermath}
  2257. 'Open string', {cs_openstring}
  2258. { macpas specific}
  2259. 'MACPAS exteranl variable', {cs_external_var}
  2260. 'MACPAS externally visible', {cs_externally_visible}
  2261. { jvm specific }
  2262. 'JVM check var copyout', {cs_check_var_copyout}
  2263. 'Zero based strings', {cs_zerobasedstrings}
  2264. { i8086 specific }
  2265. 'i8086 force FAR calls', {cs_force_far_calls}
  2266. 'i8086 huge pointer arithmetic', {cs_hugeptr_arithmetic_normalization}
  2267. 'i8086 huge pointer comparison', {cs_hugeptr_comparison_normalization}
  2268. 'enforce legacy ifend behaviour' {cs_legacyifend}
  2269. );
  2270. { Switches which can be changed by a mode (fpc,tp7,delphi) }
  2271. modeswitchname : array[tmodeswitch] of string[50] =
  2272. ('m_none',
  2273. { generic }
  2274. 'm_fpc','m_objfpc','m_delphi','m_tp7','m_mac','m_iso','m_extpas',
  2275. {$ifdef gpc_mode}'m_gpc',{$endif}
  2276. { more specific }
  2277. 'm_class', { delphi class model }
  2278. 'm_objpas', { load objpas unit }
  2279. 'm_result', { result in functions }
  2280. 'm_string_pchar', { pchar 2 string conversion }
  2281. 'm_cvar_support', { cvar variable directive }
  2282. 'm_nested_comment', { nested comments }
  2283. 'm_tp_procvar', { tp style procvars (no @ needed) }
  2284. 'm_mac_procvar', { macpas style procvars }
  2285. 'm_repeat_forward', { repeating forward declarations is needed }
  2286. 'm_pointer_2_procedure', { allows the assignement of pointers to
  2287. procedure variables }
  2288. 'm_autoderef', { does auto dereferencing of struct. vars }
  2289. 'm_initfinal', { initialization/finalization for units }
  2290. 'm_default_ansistring', { ansistring turned on by default }
  2291. 'm_out', { support the calling convention OUT }
  2292. 'm_default_para', { support default parameters }
  2293. 'm_hintdirective', { support hint directives }
  2294. 'm_duplicate_names', { allow locals/paras to have duplicate names of globals }
  2295. 'm_property', { allow properties }
  2296. 'm_default_inline', { allow inline proc directive }
  2297. 'm_except', { allow exception-related keywords }
  2298. 'm_objectivec1', { support interfacing with Objective-C (1.0) }
  2299. 'm_objectivec2', { support interfacing with Objective-C (2.0) }
  2300. 'm_nested_procvars', { support nested procedural variables }
  2301. 'm_non_local_goto', { support non local gotos (like iso pascal) }
  2302. 'm_advanced_records', { advanced record syntax with visibility sections, methods and properties }
  2303. 'm_isolike_unary_minus', { unary minus like in iso pascal: same precedence level as binary minus/plus }
  2304. 'm_systemcodepage', { use system codepage as compiler codepage by default, emit ansistrings with system codepage }
  2305. 'm_final_fields', { allows declaring fields as "final", which means they must be initialised
  2306. in the (class) constructor and are constant from then on (same as final
  2307. fields in Java) }
  2308. 'm_default_unicodestring', { makes the default string type in $h+ mode unicodestring rather than
  2309. ansistring; similarly, char becomes unicodechar rather than ansichar }
  2310. 'm_type_helpers', { allows the declaration of "type helper" for all supported types
  2311. (primitive types, records, classes, interfaces) }
  2312. 'm_blocks', { support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) }
  2313. 'm_isolike_io', { I/O as it required by an ISO compatible compiler }
  2314. 'm_isolike_program_para',{ program parameters as it required by an ISO compatible compiler }
  2315. 'm_isolike_mod', { mod operation as it is required by an iso compatible compiler }
  2316. 'm_array_operators', { use Delphi compatible array operators instead of custom ones ("+") }
  2317. 'm_multi_helpers', { helpers can appear in multiple scopes simultaneously }
  2318. 'm_array2dynarray', { regular arrays can be implicitly converted to dynamic arrays }
  2319. 'm_prefixed_attributes', { enable attributes that are defined before the type they belong to }
  2320. 'm_underscoreisseparator',{ _ can be used as separator to group digits in numbers }
  2321. 'm_implicit_function_specialization', { attempt to specialize generic function by inferring types from parameters }
  2322. 'm_function_references', { enable Delphi-style function references }
  2323. 'm_anonymous_functions' { enable Delphi-style anonymous functions }
  2324. );
  2325. { optimizer }
  2326. optimizerswitchname : array[toptimizerswitch] of string[50] =
  2327. ('cs_opt_level1',
  2328. 'cs_opt_level2',
  2329. 'cs_opt_level3',
  2330. 'cs_opt_level4',
  2331. 'cs_opt_regvar',
  2332. 'cs_opt_uncertain',
  2333. 'cs_opt_size',
  2334. 'cs_opt_stackframe',
  2335. 'cs_opt_peephole',
  2336. 'cs_opt_loopunroll',
  2337. 'cs_opt_tailrecursion',
  2338. 'cs_opt_nodecse',
  2339. 'cs_opt_nodedfa',
  2340. 'cs_opt_loopstrength',
  2341. 'cs_opt_scheduler',
  2342. 'cs_opt_autoinline',
  2343. 'cs_useebp',
  2344. 'cs_userbp',
  2345. 'cs_opt_reorder_fields',
  2346. 'cs_opt_fastmath',
  2347. { Allow removing expressions whose result is not used, even when this
  2348. can change program behaviour (range check errors disappear',
  2349. access violations due to invalid pointer derefences disappear, ...).
  2350. Note: it does not (and must not) remove expressions that have
  2351. explicit side-effects, only implicit side-effects (like the ones
  2352. mentioned before) can disappear.
  2353. }
  2354. 'cs_opt_dead_values',
  2355. { compiler checks for empty procedures/methods and removes calls to them if possible }
  2356. 'cs_opt_remove_empty_proc',
  2357. 'cs_opt_constant_propagate',
  2358. 'cs_opt_dead_store_eliminate',
  2359. 'cs_opt_forcenostackframe',
  2360. 'cs_opt_use_load_modify_store',
  2361. 'cs_opt_unused_para',
  2362. 'cs_opt_consts',
  2363. 'cs_opt_forloop'
  2364. );
  2365. var
  2366. globalswitch : tglobalswitch;
  2367. targetswitch : ttargetswitch;
  2368. moduleswitch : tmoduleswitch;
  2369. localswitch : tlocalswitch;
  2370. modeswitch : tmodeswitch;
  2371. optimizerswitch : toptimizerswitch;
  2372. globalswitches : tglobalswitches;
  2373. targetswitches : ttargetswitches;
  2374. moduleswitches : tmoduleswitches;
  2375. localswitches : tlocalswitches;
  2376. modeswitches : tmodeswitches;
  2377. optimizerswitches : toptimizerswitches;
  2378. begin
  2379. {alignment : talignmentinfo;}
  2380. {talignmentinfo = packed record}
  2381. writeln('Procedure alignment: '+tostr(new_settings.alignment.procalign));
  2382. writeln('Loop alignment: '+tostr(new_settings.alignment.loopalign));
  2383. { alignment for labels after unconditional jumps, this must be a power of two }
  2384. writeln('Jump alignment: '+tostr(new_settings.alignment.jumpalign));
  2385. { max. alignment for labels after unconditional jumps:
  2386. the compiler tries to align jumpalign, however, to do so it inserts at maximum jumpalignskipmax bytes or uses
  2387. the next smaller power of two of jumpalign }
  2388. writeln('Jump skip max alignment: '+tostr(new_settings.alignment.jumpalignskipmax));
  2389. { alignment for labels where two flows of the program flow coalesce, this must be a power of two }
  2390. writeln('Coalescence alignment: '+tostr(new_settings.alignment.coalescealign));
  2391. { max. alignment for labels where two flows of the program flow coalesce
  2392. the compiler tries to align to coalescealign, however, to do so it inserts at maximum coalescealignskipmax bytes or uses
  2393. the next smaller power of two of coalescealign }
  2394. writeln('Coalescence skip max alignment: '+tostr(new_settings.alignment.coalescealignskipmax));
  2395. writeln('Const min alignment: '+tostr(new_settings.alignment.constalignmin));
  2396. writeln('Const max alignment: '+tostr(new_settings.alignment.constalignmax));
  2397. writeln('Var min alignment: '+tostr(new_settings.alignment.varalignmin));
  2398. writeln('Var max alignment: '+tostr(new_settings.alignment.varalignmax));
  2399. writeln('Local min alignment: '+tostr(new_settings.alignment.localalignmin));
  2400. writeln('Local max alignment: '+tostr(new_settings.alignment.localalignmax));
  2401. writeln('Min record alignment: '+tostr(new_settings.alignment.recordalignmin));
  2402. writeln('Max record alignment: '+tostr(new_settings.alignment.recordalignmax));
  2403. writeln('Max C record alignment: '+tostr(new_settings.alignment.maxCrecordalign));
  2404. globalswitches:=new_settings.globalswitches;
  2405. for globalswitch:=low(tglobalswitch) to high(tglobalswitch) do
  2406. if globalswitch in globalswitches then
  2407. begin
  2408. writeln('global switch: '+globalswitchname[globalswitch]);
  2409. exclude(globalswitches,globalswitch);
  2410. end;
  2411. if (globalswitches <> []) then
  2412. writeln('Unknown global switch');
  2413. targetswitches:=new_settings.targetswitches;
  2414. for targetswitch:=low(ttargetswitch) to high(ttargetswitch) do
  2415. if targetswitch in targetswitches then
  2416. begin
  2417. writeln('target switch: '+targetswitchname[targetswitch]);
  2418. exclude(targetswitches,targetswitch);
  2419. end;
  2420. if (targetswitches <> []) then
  2421. writeln('Unknown target switch');
  2422. moduleswitches:=new_settings.moduleswitches;
  2423. for moduleswitch:=low(tmoduleswitch) to high(tmoduleswitch) do
  2424. if moduleswitch in moduleswitches then
  2425. begin
  2426. writeln('module switch: '+moduleswitchname[moduleswitch]);
  2427. exclude(moduleswitches,moduleswitch);
  2428. end;
  2429. if (moduleswitches <> []) then
  2430. writeln('Unknown module switch');
  2431. localswitches:=new_settings.localswitches;
  2432. for localswitch:=low(tlocalswitch) to high(tlocalswitch) do
  2433. if localswitch in localswitches then
  2434. begin
  2435. writeln('local switch: '+localswitchname[localswitch]);
  2436. exclude(localswitches,localswitch);
  2437. end;
  2438. if (localswitches <> []) then
  2439. writeln('Unknown local switch');
  2440. modeswitches:=new_settings.modeswitches;
  2441. for modeswitch:=low(tmodeswitch) to high(tmodeswitch) do
  2442. if modeswitch in modeswitches then
  2443. begin
  2444. writeln(['mode switch: ',modeswitchname[modeswitch]]);
  2445. exclude(modeswitches,modeswitch);
  2446. end;
  2447. if (modeswitches <> []) then
  2448. writeln('Unknown mode switch');
  2449. optimizerswitches:=new_settings.optimizerswitches;
  2450. for optimizerswitch:=low(toptimizerswitch) to high(toptimizerswitch) do
  2451. if optimizerswitch in optimizerswitches then
  2452. begin
  2453. writeln(['optimizer switch: ',optimizerswitchname[optimizerswitch]]);
  2454. exclude(optimizerswitches,optimizerswitch);
  2455. end;
  2456. if (optimizerswitches <> []) then
  2457. writeln('Unknown optimizer switch');
  2458. writeln(['Set allocation size ',new_settings.setalloc]);
  2459. writeln(['Pack enums ',new_settings.packenum]);
  2460. writeln(['Pack records ',new_settings.packrecords]);
  2461. writeln(['Max FPU registers ',new_settings.maxfpuregisters]);
  2462. writeln('Verbosity '+hexstr(new_settings.verbosity,8));
  2463. writeln(['CPU type ',new_settings.cputype]);
  2464. writeln(['CPU optimize type ',new_settings.optimizecputype]);
  2465. writeln(['FPU type ',new_settings.fputype]);
  2466. writeln(['ASM mode ',new_settings.asmmode]);
  2467. end;
  2468. var
  2469. linestr,genstr : string;
  2470. token : ttoken;
  2471. copy_size, stbi, last_col, new_col : longint;
  2472. last_line,new_line : dword;
  2473. len : sizeint;
  2474. wstring : widestring;
  2475. astring : ansistring;
  2476. begin
  2477. tbi:=0;
  2478. last_line:=0;
  2479. last_col:=0;
  2480. linestr:='';
  2481. genstr:='';
  2482. fillchar(new_settings,sizeof(new_settings),#0);
  2483. fillchar(prev_settings,sizeof(prev_settings),#0);
  2484. write([space,' Tokens: ']);
  2485. while tbi<tokenbufsize do
  2486. begin
  2487. token:=readtoken;
  2488. if token<>_GENERICSPECIALTOKEN then
  2489. begin
  2490. if token <= high(ttoken) then
  2491. begin
  2492. write(arraytokeninfo[token].str);
  2493. if not (token in [_CWCHAR, _CWSTRING, _CSTRING, _CCHAR,
  2494. _INTCONST,_REALNUMBER, _ID]) then
  2495. StrAppend(linestr,lowercase(arraytokeninfo[token].str));
  2496. end
  2497. else
  2498. begin
  2499. HasMoreInfos;
  2500. write('Error in Token List');
  2501. break;
  2502. end;
  2503. {idtoken:=}readtoken;
  2504. end;
  2505. case token of
  2506. _CWCHAR,
  2507. _CWSTRING :
  2508. begin
  2509. len:=gettokenbufsizeint;
  2510. setlength(wstring,len);
  2511. move(tokenbuf[tbi],wstring[1],len*2);
  2512. write([' ''',wstring,'''']);
  2513. StrAppend(linestr,' ''');
  2514. StrAppend(linestr,wstring);
  2515. StrAppend(linestr,'''');
  2516. inc(tbi,len*2);
  2517. end;
  2518. _CSTRING:
  2519. begin
  2520. len:=gettokenbufsizeint;
  2521. setlength(astring,len);
  2522. if len>0 then
  2523. move(tokenbuf[tbi],astring[1],len);
  2524. write([' ''',astring,'''']);
  2525. StrAppend(linestr,' ''');
  2526. StrAppend(linestr,astring);
  2527. StrAppend(linestr,'''');
  2528. inc(tbi,len);
  2529. end;
  2530. _CCHAR:
  2531. begin
  2532. write([' ''',unaligned(pshortstring(@tokenbuf[tbi])^),'''']);
  2533. StrAppend(linestr,' ''');
  2534. StrAppend(linestr,unaligned(pshortstring(@tokenbuf[tbi])^));
  2535. StrAppend(linestr,'''');
  2536. inc(tbi,tokenbuf[tbi]+1);
  2537. end;
  2538. _INTCONST,
  2539. _REALNUMBER :
  2540. begin
  2541. write([' ',unaligned(pshortstring(@tokenbuf[tbi])^)]);
  2542. StrAppend(linestr,unaligned(pshortstring(@tokenbuf[tbi])^));
  2543. inc(tbi,tokenbuf[tbi]+1);
  2544. end;
  2545. _ID :
  2546. begin
  2547. write([' ',unaligned(pshortstring(@tokenbuf[tbi])^)]);
  2548. StrAppend(linestr,unaligned(pshortstring(@tokenbuf[tbi])^));
  2549. inc(tbi,tokenbuf[tbi]+1);
  2550. end;
  2551. _GENERICSPECIALTOKEN:
  2552. begin
  2553. { Short version of column change,
  2554. byte or $80 used }
  2555. if (tokenbuf[tbi] and $80)<>0 then
  2556. begin
  2557. new_col:=tokenbuf[tbi] and $7f;
  2558. write(['Col: ',new_col]);
  2559. if length(linestr)<new_col-1 then
  2560. StrAppend(linestr,StringOfChar(' ',new_col - 1 - length(linestr)));
  2561. inc(tbi);
  2562. last_col:=new_col;
  2563. end
  2564. else
  2565. case tspecialgenerictoken(tokenbuf[tbi]) of
  2566. ST_LOADSETTINGS:
  2567. begin
  2568. inc(tbi);
  2569. write([space,'Settings: ']);
  2570. fillchar(new_settings,sizeof(new_settings),#0);
  2571. { This does not load pmessage pointer }
  2572. new_settings.pmessage:=nil;
  2573. { TSettings size depends in target...
  2574. We first read the size of the copied part }
  2575. { Still not cross endian ready :( }
  2576. copy_size:=gettokenbufsizeint;
  2577. stbi:=tbi;
  2578. tokenreadsettings(new_settings, copy_size);
  2579. tbi:=stbi+copy_size;
  2580. if CompareByte(new_settings,prev_settings,copy_size)<>0 then
  2581. begin
  2582. dump_new_settings;
  2583. writeln;
  2584. end
  2585. else
  2586. begin
  2587. writeln('Unchanged');
  2588. end;
  2589. prev_settings:=new_settings;
  2590. end;
  2591. ST_LOADMESSAGES:
  2592. begin
  2593. inc(tbi);
  2594. mesgnb:=gettokenbufsizeint;;
  2595. writeln([space,mesgnb,' messages: ']);
  2596. if (tbi+2*sizeof(longint)*mesgnb>tokenbufsize) then
  2597. begin
  2598. WriteError('!! Error: number of messages incompatible with token buffer size');
  2599. end;
  2600. for nb:=1 to mesgnb do
  2601. begin
  2602. msgvalue:=gettokenbuflongint;
  2603. state:=tmsgstate(gettokenbuflongint);
  2604. writeln(['#',msgvalue,' ',state]);
  2605. end;
  2606. end;
  2607. ST_LINE:
  2608. begin
  2609. inc(tbi);
  2610. new_line:=gettokenbufdword;
  2611. if (new_line<>last_line) then
  2612. begin
  2613. StrAppend(genstr,linestr+LineEnding);
  2614. linestr:='';
  2615. end;
  2616. writeln(['Line: ',new_line]);
  2617. last_line:=new_line;
  2618. end;
  2619. ST_COLUMN:
  2620. begin
  2621. inc(tbi);
  2622. new_col:=gettokenbufword;
  2623. write(['Col: ',new_col]);
  2624. if length(linestr)<new_col - 1 then
  2625. StrAppend(linestr,StringOfChar(' ',new_col - 1 - length(linestr)));
  2626. last_col:=new_col;
  2627. end;
  2628. ST_FILEINDEX:
  2629. begin
  2630. inc(tbi);
  2631. StrAppend(genstr,linestr+LineEnding);
  2632. linestr:='';
  2633. write(['File: ',gettokenbufword]);
  2634. end;
  2635. else
  2636. begin
  2637. HasMoreInfos;
  2638. write('Error in Token List');
  2639. break;
  2640. end;
  2641. end;
  2642. end;
  2643. else ; { empty else to avoid warning }
  2644. end;
  2645. if tbi<tokenbufsize then
  2646. write(',');
  2647. end;
  2648. if (tbi>tokenbufsize) then
  2649. begin
  2650. WriteError('!! Error: read past of token buffer size');
  2651. end
  2652. else
  2653. writeln;
  2654. StrAppend(genstr,linestr);
  2655. writeln(['##',genstr,'##']);
  2656. end;
  2657. procedure readcommondef(const s:string; out defoptions: tdefoptions; Def: TPpuDef = nil);
  2658. type
  2659. tdefopt=record
  2660. mask : tdefoption;
  2661. str : string[30];
  2662. end;
  2663. tdefstateinfo=record
  2664. mask : tdefstate;
  2665. str : string[30];
  2666. end;
  2667. tgenconstrflag=record
  2668. mask : tgenericconstraintflag;
  2669. str : string[30];
  2670. end;
  2671. const
  2672. defopt : array[1..ord(high(tdefoption))] of tdefopt=(
  2673. (mask:df_unique; str:'Unique Type'),
  2674. (mask:df_generic; str:'Generic'),
  2675. (mask:df_specialization; str:'Specialization'),
  2676. (mask:df_copied_def; str:'Copied Typedef'),
  2677. (mask:df_genconstraint; str:'Generic Constraint'),
  2678. { this should never happen for defs stored to a ppu file }
  2679. (mask:df_not_registered_no_free; str:'Unregistered/No free (invalid)'),
  2680. (mask:df_llvm_no_struct_packing; str:'LLVM unpacked struct'),
  2681. (mask:df_internal; str:'Internal'),
  2682. (mask:df_has_global_ref; str:'Has Global Ref'),
  2683. (mask:df_has_generic_fields; str:'Has generic fields'),
  2684. (mask:df_llvm_no_typename; str:'LLVM no typename')
  2685. );
  2686. defstate : array[1..ord(high(tdefstate))] of tdefstateinfo=(
  2687. (mask:ds_vmt_written; str:'VMT Written'),
  2688. (mask:ds_rtti_table_used; str:'RTTITable Used'),
  2689. (mask:ds_init_table_used; str:'InitTable Used'),
  2690. (mask:ds_rtti_table_written; str:'RTTITable Written'),
  2691. (mask:ds_init_table_written; str:'InitTable Written'),
  2692. (mask:ds_dwarf_dbg_info_used; str:'Dwarf DbgInfo Used'),
  2693. (mask:ds_dwarf_dbg_info_written;str:'Dwarf DbgInfo Written')
  2694. );
  2695. genconstrflag : array[1..ord(high(tgenericconstraintflag))] of tgenconstrflag=(
  2696. (mask:gcf_constructor; str:'Constructor'),
  2697. (mask:gcf_class; str:'Class'),
  2698. (mask:gcf_record; str:'Record')
  2699. );
  2700. var
  2701. defstates : tdefstates;
  2702. i, nb, len : longint;
  2703. first : boolean;
  2704. min_size, tokenbufsize : longint;
  2705. tokenbuf : pbyte;
  2706. genconstr : tgenericconstraintflags;
  2707. begin
  2708. i:=ppufile.getlongint;
  2709. if Def <> nil then
  2710. Def.Id:=i;
  2711. writeln([space,'** Definition Id ',i,' **']);
  2712. writeln([space,s]);
  2713. write ([space,' Type symbol : ']);
  2714. if Def <> nil then
  2715. readderef('', Def.Ref)
  2716. else
  2717. readderef('');
  2718. write ([space,' DefOptions : ']);
  2719. ppufile.getset(tppuset2(defoptions));
  2720. if defoptions<>[] then
  2721. begin
  2722. first:=true;
  2723. for i:=1to high(defopt) do
  2724. if (defopt[i].mask in defoptions) then
  2725. begin
  2726. if first then
  2727. first:=false
  2728. else
  2729. write(', ');
  2730. write(defopt[i].str);
  2731. end;
  2732. end;
  2733. writeln;
  2734. write ([space,' DefStates : ']);
  2735. ppufile.getset(tppuset1(defstates));
  2736. if defstates<>[] then
  2737. begin
  2738. first:=true;
  2739. for i:=1 to high(defstate) do
  2740. if (defstate[i].mask in defstates) then
  2741. begin
  2742. if first then
  2743. first:=false
  2744. else
  2745. write(', ');
  2746. write(defstate[i].str);
  2747. end;
  2748. end;
  2749. writeln;
  2750. if df_unique in defoptions then
  2751. begin
  2752. write ([space,' OriginalDef : ']);
  2753. readderef(space);
  2754. end;
  2755. if df_genconstraint in defoptions then
  2756. begin
  2757. ppufile.getset(tppuset1(genconstr));
  2758. write ([space,' GenConstraints : ']);
  2759. if genconstr<>[] then
  2760. begin
  2761. first:=true;
  2762. for i:=1 to high(genconstrflag) do
  2763. if (genconstrflag[i].mask in genconstr) then
  2764. begin
  2765. if first then
  2766. first:=false
  2767. else
  2768. write(', ');
  2769. write(genconstrflag[i].str);
  2770. end;
  2771. end;
  2772. writeln;
  2773. len:=ppufile.getlongint;
  2774. if len>0 then
  2775. begin
  2776. space:=' '+space;
  2777. writeln([space,'------ constraint defs begin ------']);
  2778. for i:=0 to len-1 do
  2779. begin
  2780. writeln([space,'------ constraint def ',i,' ------']);
  2781. readderef(space);
  2782. end;
  2783. writeln([space,'------ constraint defs end ------']);
  2784. delete(space,1,4);
  2785. end;
  2786. end;
  2787. if [df_generic,df_specialization]*defoptions<>[] then
  2788. begin
  2789. nb:=ppufile.getlongint;
  2790. writeln([space,'has ',nb,' parameters']);
  2791. if nb>0 then
  2792. begin
  2793. for i:=0 to nb-1 do
  2794. begin
  2795. writeln([space,'parameter ',i,': ',ppufile.getstring]);
  2796. readderef(space);
  2797. end;
  2798. end;
  2799. end;
  2800. if df_generic in defoptions then
  2801. begin
  2802. tokenbufsize:=ppufile.getlongint;
  2803. writeln([space,' Tokenbuffer size : ',tokenbufsize]);
  2804. tokenbuf:=allocmem(tokenbufsize);
  2805. ppufile.getdata(tokenbuf^,tokenbufsize);
  2806. displaytokenbuffer(tokenbuf,tokenbufsize);
  2807. freemem(tokenbuf);
  2808. end;
  2809. if df_specialization in defoptions then
  2810. begin
  2811. write ([space,' Orig. GenericDef : ']);
  2812. readderef('');
  2813. end;
  2814. space:=space+' ';
  2815. readattrs(def);
  2816. delete(space,1,4);
  2817. current_defoptions:=defoptions;
  2818. end;
  2819. { Read abstract procdef and return if inline procdef }
  2820. { type tproccalloption is in globtype unit }
  2821. { type tproctypeoption is in globtype unit }
  2822. { type tprocoption is in globtype unit }
  2823. procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions; ProcDef: TPpuProcDef);
  2824. type
  2825. tproccallopt=record
  2826. mask : tproccalloption;
  2827. str : string[30];
  2828. end;
  2829. tproctypeopt=record
  2830. mask : tproctypeoption;
  2831. str : string[30];
  2832. end;
  2833. tprocopt=record
  2834. mask : tprocoption;
  2835. str : string[34];
  2836. end;
  2837. const
  2838. {proccalloptionStr is also in globtype unit }
  2839. proctypeopt : array[1..ord(high(tproctypeoption))] of tproctypeopt=(
  2840. (mask:potype_proginit; str:'ProgInit'),
  2841. (mask:potype_unitinit; str:'UnitInit'),
  2842. (mask:potype_unitfinalize; str:'UnitFinalize'),
  2843. (mask:potype_constructor; str:'Constructor'),
  2844. (mask:potype_destructor; str:'Destructor'),
  2845. (mask:potype_operator; str:'Operator'),
  2846. (mask:potype_procedure; str:'Procedure'),
  2847. (mask:potype_function; str:'Function'),
  2848. (mask:potype_class_constructor; str:'Class Constructor'),
  2849. (mask:potype_class_destructor; str:'Class Destructor'),
  2850. { Dispinterface property accessors }
  2851. (mask:potype_propgetter; str:'Property Getter'),
  2852. (mask:potype_propsetter; str:'Property Setter'),
  2853. (mask:potype_exceptfilter; str:'SEH filter'),
  2854. (mask:potype_mainstub; str:'main stub'),
  2855. (mask:potype_pkgstub; str:'package stub'),
  2856. (mask:potype_libmainstub; str:'library main stub')
  2857. );
  2858. procopt : array[1..ord(high(tprocoption))] of tprocopt=(
  2859. (mask:po_classmethod; str:'ClassMethod'),
  2860. (mask:po_virtualmethod; str:'VirtualMethod'),
  2861. (mask:po_abstractmethod; str:'AbstractMethod'),
  2862. (mask:po_finalmethod; str:'FinalMethod'),
  2863. (mask:po_staticmethod; str:'StaticMethod'),
  2864. (mask:po_overridingmethod;str:'OverridingMethod'),
  2865. (mask:po_methodpointer; str:'MethodPointer'),
  2866. (mask:po_interrupt; str:'Interrupt'),
  2867. (mask:po_iocheck; str:'IOCheck'),
  2868. (mask:po_assembler; str:'Assembler'),
  2869. (mask:po_msgstr; str:'MsgStr'),
  2870. (mask:po_msgint; str:'MsgInt'),
  2871. (mask:po_exports; str:'Exports'),
  2872. (mask:po_external; str:'External'),
  2873. (mask:po_overload; str:'Overload'),
  2874. (mask:po_varargs; str:'VarArgs'),
  2875. (mask:po_internconst; str:'InternConst'),
  2876. (mask:po_addressonly; str:'AddressOnly'),
  2877. (mask:po_public; str:'Public'),
  2878. (mask:po_hascallingconvention;str:'HasCallingConvention'),
  2879. (mask:po_reintroduce; str:'ReIntroduce'),
  2880. (mask:po_explicitparaloc; str:'ExplicitParaloc'),
  2881. (mask:po_nostackframe; str:'NoStackFrame'),
  2882. (mask:po_has_mangledname; str:'HasMangledName'),
  2883. (mask:po_has_public_name; str:'HasPublicName'),
  2884. (mask:po_forward; str:'Forward'),
  2885. (mask:po_global; str:'Global'),
  2886. (mask:po_syscall; str:'Syscall'),
  2887. (mask:po_syscall_legacy; str:'SyscallLegacy'),
  2888. (mask:po_syscall_basenone;str:'SyscallBaseNone'),
  2889. (mask:po_syscall_basefirst;str:'SyscallBaseFirst'),
  2890. (mask:po_syscall_baselast;str:'SyscallBaseLast'),
  2891. (mask:po_syscall_basereg; str:'SyscallBaseReg'),
  2892. (mask:po_syscall_has_libsym; str:'Has LibSym'),
  2893. (mask:po_syscall_has_importnr; str:'Uses ImportNr'),
  2894. (mask:po_inline; str:'Inline'),
  2895. (mask:po_compilerproc; str:'CompilerProc'),
  2896. (mask:po_has_importdll; str:'HasImportDLL'),
  2897. (mask:po_has_importname; str:'HasImportName'),
  2898. (mask:po_kylixlocal; str:'KylixLocal'),
  2899. (mask:po_dispid; str:'DispId'),
  2900. (mask:po_weakexternal; str:'WeakExternal'),
  2901. (mask:po_objc; str:'ObjC'),
  2902. (mask:po_enumerator_movenext; str:'EnumeratorMoveNext'),
  2903. (mask:po_optional; str: 'Optional'),
  2904. (mask:po_delphi_nested_cc;str: 'Delphi-style nested frameptr'),
  2905. (mask:po_java_nonvirtual; str: 'Java non-virtual method'),
  2906. (mask:po_ignore_for_overload_resolution;str: 'Ignored for overload resolution'),
  2907. (mask:po_rtlproc; str: 'RTL procedure'),
  2908. (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler'),
  2909. (mask:po_far; str: 'Far'),
  2910. (mask:po_hasnearfarcallmodel; str: 'Near/Far explicit'),
  2911. (mask:po_noreturn; str: 'No return'),
  2912. (mask:po_is_function_ref; str: 'Function reference'),
  2913. (mask:po_is_block; str: 'C "Block"'),
  2914. (mask:po_is_auto_getter; str: 'Automatically generated getter'),
  2915. (mask:po_is_auto_setter; str: 'Automatically generated setter'),
  2916. (mask:po_noinline; str: 'Never inline'),
  2917. (mask:po_variadic; str: 'C VarArgs with array-of-const para'),
  2918. (mask:po_objc_related_result_type; str: 'Objective-C related result type'),
  2919. (mask:po_anonymous; str: 'Anonymous'),
  2920. (mask:po_wasm_funcref; str: 'WebAssembly funcref'),
  2921. (mask:po_wasm_suspending; str: 'WebAssembly suspending')
  2922. );
  2923. var
  2924. proctypeoption : tproctypeoption;
  2925. i : longint;
  2926. first : boolean;
  2927. begin
  2928. write([space,' Return type : ']);
  2929. readderef('', ProcDef.ReturnType);
  2930. proctypeoption:=tproctypeoption(ppufile.getbyte);
  2931. case proctypeoption of
  2932. potype_function: Include(ProcDef.Options, poFunction);
  2933. potype_procedure: Include(ProcDef.Options, poProcedure);
  2934. potype_constructor: Include(ProcDef.Options, poConstructor);
  2935. potype_destructor: Include(ProcDef.Options, poDestructor);
  2936. potype_operator: Include(ProcDef.Options, poOperator);
  2937. end;
  2938. write([space,' TypeOption : ']);
  2939. first:=true;
  2940. for i:=1 to high(proctypeopt) do
  2941. if (proctypeopt[i].mask=proctypeoption) then
  2942. begin
  2943. if first then
  2944. first:=false
  2945. else
  2946. write(', ');
  2947. write(proctypeopt[i].str);
  2948. end;
  2949. writeln;
  2950. proccalloption:=tproccalloption(ppufile.getbyte);
  2951. writeln([space,' CallOption : ',proccalloptionStr[proccalloption]]);
  2952. ppufile.getset(tppuset8(procoptions));
  2953. if procoptions<>[] then
  2954. begin
  2955. if po_classmethod in procoptions then Include(ProcDef.Options, poClassMethod);
  2956. if po_virtualmethod in procoptions then Include(ProcDef.Options, poVirtual);
  2957. if po_abstractmethod in procoptions then Include(ProcDef.Options, poAbstract);
  2958. if po_overridingmethod in procoptions then Include(ProcDef.Options, poOverriding);
  2959. if po_overload in procoptions then Include(ProcDef.Options, poOverload);
  2960. if po_inline in procoptions then Include(ProcDef.Options, poInline);
  2961. if (po_methodpointer in procoptions) and (ProcDef.DefType = dtProcType) then
  2962. TPpuProcTypeDef(ProcDef).MethodPtr:=True;
  2963. write([space,' Options : ']);
  2964. first:=true;
  2965. for i:=1 to high(procopt) do
  2966. if (procopt[i].mask in procoptions) then
  2967. begin
  2968. if first then
  2969. first:=false
  2970. else
  2971. write(', ');
  2972. write(procopt[i].str);
  2973. end;
  2974. writeln;
  2975. end;
  2976. if (po_explicitparaloc in procoptions) then
  2977. begin
  2978. readcgpara(space);
  2979. end;
  2980. end;
  2981. { type tvaroption is in unit symconst }
  2982. { register variable }
  2983. { type tvarregable is in unit symconst }
  2984. procedure readabstractvarsym(const s:string;var varoptions:tvaroptions; VarDef: TPpuVarDef = nil);
  2985. type
  2986. tvaropt=record
  2987. mask : tvaroption;
  2988. str : string[30];
  2989. end;
  2990. const
  2991. varopt : array[1..ord(high(tvaroption))] of tvaropt=(
  2992. (mask:vo_is_external; str:'External'),
  2993. (mask:vo_is_dll_var; str:'DLLVar'),
  2994. (mask:vo_is_thread_var; str:'ThreadVar'),
  2995. (mask:vo_has_local_copy; str:'HasLocalCopy'),
  2996. (mask:vo_is_const; str:'Constant'),
  2997. (mask:vo_is_public; str:'Public'),
  2998. (mask:vo_is_high_para; str:'HighValue'),
  2999. (mask:vo_is_funcret; str:'Funcret'),
  3000. (mask:vo_is_self; str:'Self'),
  3001. (mask:vo_is_vmt; str:'VMT'),
  3002. (mask:vo_is_result; str:'Result'),
  3003. (mask:vo_is_parentfp; str:'ParentFP'),
  3004. (mask:vo_is_loop_counter; str:'LoopCounter'),
  3005. (mask:vo_is_hidden_para; str:'Hidden'),
  3006. (mask:vo_has_explicit_paraloc;str:'ExplicitParaloc'),
  3007. (mask:vo_is_syscall_lib; str:'SysCallLib'),
  3008. (mask:vo_has_mangledname; str:'HasMangledName'),
  3009. (mask:vo_is_typed_const; str:'TypedConst'),
  3010. (mask:vo_is_range_check; str:'RangeCheckSwitch'),
  3011. (mask:vo_is_overflow_check; str:'OverflowCheckSwitch'),
  3012. (mask:vo_is_typinfo_para; str:'TypeInfo'),
  3013. (mask:vo_is_msgsel;str:'MsgSel'),
  3014. (mask:vo_is_weak_external;str:'WeakExternal'),
  3015. (mask:vo_is_first_field;str:'IsFirstField'),
  3016. (mask:vo_volatile; str:'Volatile'),
  3017. (mask:vo_has_section; str:'HasSection'),
  3018. (mask:vo_force_finalize; str:'ForceFinalize'),
  3019. (mask:vo_is_default_var; str:'DefaultIntrinsicVar'),
  3020. (mask:vo_is_far; str:'IsFar'),
  3021. (mask:vo_has_global_ref; str:'HasGlobalRef'),
  3022. (mask:vo_is_internal; str:'IsInternal')
  3023. );
  3024. type
  3025. tvaraccessdesc=record
  3026. mask: tvarsymaccessflag;
  3027. str: string[30];
  3028. end;
  3029. const
  3030. varaccessstr : array[ord(low(tvarsymaccessflag))..ord(high(tvarsymaccessflag))] of tvaraccessdesc=(
  3031. (mask: vsa_addr_taken; str:'Address taken'),
  3032. (mask: vsa_different_scope; str:'Accessed from different scope')
  3033. );
  3034. var
  3035. i : longint;
  3036. accessflag: tvarsymaccessflag;
  3037. varsymaccessflags: tvarsymaccessflags;
  3038. first : boolean;
  3039. begin
  3040. readcommonsym(s, VarDef);
  3041. i:=ppufile.getbyte;
  3042. if (VarDef <> nil) and (VarDef.DefType = dtParam) then
  3043. with TPpuParamDef(VarDef) do
  3044. case tvarspez(i) of
  3045. vs_value: Spez:=psValue;
  3046. vs_var: Spez:=psVar;
  3047. vs_out: Spez:=psOut;
  3048. vs_const: Spez:=psConst;
  3049. vs_constref: Spez:=psConstRef;
  3050. end;
  3051. writeln([space,' Spez : ',Varspez2Str(i)]);
  3052. writeln([space,' Regable : ',Varregable2Str(ppufile.getbyte)]);
  3053. ppufile.getset(tppuset1(varsymaccessflags));
  3054. write([space, ' Access Flags : ']);
  3055. first:=true;
  3056. for i:=low(varaccessstr) to high(varaccessstr) do
  3057. begin
  3058. if varaccessstr[i].mask in varsymaccessflags then
  3059. begin
  3060. if first then
  3061. first:=false
  3062. else
  3063. write([', ']);
  3064. write([varaccessstr[i].str]);
  3065. end
  3066. end;
  3067. writeln;
  3068. write ([space,' Var Type : ']);
  3069. if VarDef <> nil then
  3070. readderef('',VarDef.VarType)
  3071. else
  3072. readderef('');
  3073. ppufile.getset(tppuset4(varoptions));
  3074. if varoptions<>[] then
  3075. begin
  3076. if (VarDef <> nil) and (VarDef.DefType = dtParam) and (vo_is_hidden_para in varoptions) then
  3077. TPpuParamDef(VarDef).Spez:=psHidden;
  3078. write([space,' Options : ']);
  3079. first:=true;
  3080. for i:=1 to high(varopt) do
  3081. if (varopt[i].mask in varoptions) then
  3082. begin
  3083. if first then
  3084. first:=false
  3085. else
  3086. write(', ');
  3087. write(varopt[i].str);
  3088. end;
  3089. writeln;
  3090. end;
  3091. end;
  3092. procedure readobjectdefoptions(ObjDef: TPpuObjectDef = nil);
  3093. type
  3094. tsymopt=record
  3095. mask : tobjectoption;
  3096. str : string[30];
  3097. end;
  3098. const
  3099. symopt : array[1..ord(high(tobjectoption))] of tsymopt=(
  3100. (mask:oo_is_forward; str:'IsForward'),
  3101. (mask:oo_is_abstract; str:'IsAbstract'),
  3102. (mask:oo_is_sealed; str:'IsSealed'),
  3103. (mask:oo_has_virtual; str:'HasVirtual'),
  3104. (mask:oo_has_private; str:'HasPrivate'),
  3105. (mask:oo_has_protected; str:'HasProtected'),
  3106. (mask:oo_has_strictprivate; str:'HasStrictPrivate'),
  3107. (mask:oo_has_strictprotected;str:'HasStrictProtected'),
  3108. (mask:oo_has_constructor; str:'HasConstructor'),
  3109. (mask:oo_has_destructor; str:'HasDestructor'),
  3110. (mask:oo_has_vmt; str:'HasVMT'),
  3111. (mask:oo_has_msgstr; str:'HasMsgStr'),
  3112. (mask:oo_has_msgint; str:'HasMsgInt'),
  3113. (mask:oo_can_have_published; str:'CanHavePublished'),
  3114. (mask:oo_has_default_property;str:'HasDefaultProperty'),
  3115. (mask:oo_has_valid_guid; str:'HasValidGUID'),
  3116. (mask:oo_has_enumerator_movenext; str:'HasEnumeratorMoveNext'),
  3117. (mask:oo_has_enumerator_current; str:'HasEnumeratorCurrent'),
  3118. (mask:oo_is_external; str:'External'),
  3119. (mask:oo_is_formal; str:'Formal'),
  3120. (mask:oo_is_classhelper; str:'Class Helper/Category'),
  3121. (mask:oo_has_class_constructor; str:'HasClassConstructor'),
  3122. (mask:oo_has_class_destructor; str:'HasClassDestructor'),
  3123. (mask:oo_is_enum_class; str:'JvmEnumClass'),
  3124. (mask:oo_has_new_destructor; str:'HasNewDestructor'),
  3125. (mask:oo_is_funcref; str:'IsFuncRef'),
  3126. (mask:oo_is_invokable; str:'IsInvokable'),
  3127. (mask:oo_is_capturer; str:'IsCapturer'),
  3128. (mask:oo_inherits_not_specialized; str:'InheritedNotSpecialized')
  3129. );
  3130. var
  3131. i : longint;
  3132. first : boolean;
  3133. begin
  3134. ppufile.getset(tppuset4(current_objectoptions));
  3135. if current_objectoptions<>[] then
  3136. begin
  3137. if ObjDef <> nil then
  3138. begin
  3139. if oo_is_abstract in current_objectoptions then
  3140. Include(ObjDef.Options, ooIsAbstract);
  3141. end;
  3142. first:=true;
  3143. for i:=1 to high(symopt) do
  3144. if (symopt[i].mask in current_objectoptions) then
  3145. begin
  3146. if first then
  3147. first:=false
  3148. else
  3149. write(', ');
  3150. write(symopt[i].str);
  3151. end;
  3152. end;
  3153. writeln;
  3154. end;
  3155. procedure readextendedrtti;
  3156. type
  3157. tvisopt=record
  3158. mask : trtti_visibility;
  3159. str : string[10];
  3160. end;
  3161. const
  3162. visopt : array[0..ord(high(trtti_visibility))] of tvisopt=(
  3163. (mask:rv_private; str:'Private'),
  3164. (mask:rv_protected; str:'Protected'),
  3165. (mask:rv_public; str:'Public'),
  3166. (mask:rv_published; str:'Published')
  3167. );
  3168. type
  3169. toptionopt=record
  3170. mask : trtti_option;
  3171. str : string[10];
  3172. end;
  3173. const
  3174. voptionopt : array[0..ord(high(trtti_option))] of toptionopt=(
  3175. (mask:ro_methods; str:'Methods'),
  3176. (mask:ro_fields; str:'Fields'),
  3177. (mask:ro_properties; str:'Properties')
  3178. );
  3179. var
  3180. clause: string;
  3181. visibilities: trtti_visibilities;
  3182. first: boolean;
  3183. i, ro: integer;
  3184. begin
  3185. clause:='';
  3186. case trtti_clause(ppufile.getbyte) of
  3187. rtc_none: clause:='None';
  3188. rtc_inherit: clause:='Inherit';
  3189. rtc_explicit: clause:='Explicit';
  3190. end;
  3191. writeln([space,' Clause : ',clause]);
  3192. for ro:=0 to high(voptionopt) do
  3193. begin
  3194. ppufile.getset(tppuset1(visibilities));
  3195. if visibilities<>[] then
  3196. begin
  3197. write([space,' ',voptionopt[ro].str,' : ']);
  3198. first:=true;
  3199. for i:=0 to high(visopt) do
  3200. if visopt[i].mask in visibilities then
  3201. begin
  3202. if first then
  3203. first:=false
  3204. else
  3205. write(', ');
  3206. write(visopt[i].str);
  3207. end;
  3208. if not first then
  3209. writeln;
  3210. end;
  3211. end;
  3212. end;
  3213. procedure readprocimploptions(const space: string; out implprocoptions: timplprocoptions);
  3214. type
  3215. tpiopt=record
  3216. mask : timplprocoption;
  3217. str : string[30];
  3218. end;
  3219. const
  3220. piopt : array[low(timplprocoption)..high(timplprocoption)] of tpiopt=(
  3221. (mask:pio_empty; str:'IsEmpty'),
  3222. (mask:pio_has_inlininginfo; str:'HasInliningInfo'),
  3223. (mask:pio_inline_not_possible; str:'InlineNotPossible'),
  3224. (mask:pio_nested_access; str:'NestedAccess'),
  3225. (mask:pio_thunk; str:'Thunk'),
  3226. (mask:pio_fastmath; str:'FastMath'),
  3227. (mask:pio_inline_forbidden; str:'InlineForbidden')
  3228. );
  3229. var
  3230. i: timplprocoption;
  3231. first: boolean;
  3232. begin
  3233. ppufile.getset(tppuset1(implprocoptions));
  3234. if implprocoptions<>[] then
  3235. begin
  3236. first:=true;
  3237. write([space,' Options : ']);
  3238. for i:=low(piopt) to high(piopt) do
  3239. begin
  3240. if i in implprocoptions then
  3241. begin
  3242. if first then
  3243. first:=false
  3244. else
  3245. write(', ');
  3246. write(piopt[i].str);
  3247. end;
  3248. end;
  3249. writeln;
  3250. end;
  3251. end;
  3252. procedure readarraydefoptions(ArrayDef: TPpuArrayDef);
  3253. { type tarraydefoption is in unit symconst }
  3254. const
  3255. symopt : array[tarraydefoption] of string = (
  3256. { ado_IsConvertedPointer } 'ConvertedPointer',
  3257. { ado_IsDynamicArray } 'IsDynamicArray',
  3258. { ado_IsVariant } 'IsVariant',
  3259. { ado_IsConstructor } 'IsConstructor',
  3260. { ado_IsArrayOfConst } 'ArrayOfConst',
  3261. { ado_IsConstString } 'ConstString',
  3262. { ado_IsBitPacked } 'BitPacked',
  3263. { ado_IsVector } 'Vector',
  3264. { ado_IsGeneric } 'Generic',
  3265. { ado_OpenArray } 'OpenArray'
  3266. );
  3267. var
  3268. symoptions: tarraydefoptions;
  3269. i: tarraydefoption;
  3270. first: boolean;
  3271. begin
  3272. ppufile.getset(tppuset2(symoptions));
  3273. if symoptions<>[] then
  3274. begin
  3275. if ado_IsDynamicArray in symoptions then Include(ArrayDef.Options, aoDynamic);
  3276. first:=true;
  3277. for i:=Low(symopt) to high(symopt) do
  3278. if (i in symoptions) then
  3279. begin
  3280. if first then
  3281. first:=false
  3282. else
  3283. write(', ');
  3284. write(symopt[i]);
  3285. end;
  3286. end;
  3287. writeln;
  3288. end;
  3289. (* options for properties
  3290. tpropertyoption=(ppo_none,
  3291. ppo_indexed,
  3292. ppo_defaultproperty,
  3293. ppo_stored,
  3294. ppo_hasparameters,
  3295. ppo_implements,
  3296. ppo_enumerator_current,
  3297. ppo_overrides,
  3298. ppo_dispid_write { no longer used }
  3299. );
  3300. tpropertyoptions=set of tpropertyoption;
  3301. *)
  3302. function readpropertyoptions:tpropertyoptions;
  3303. { type tarraydefoption is in unit symconst }
  3304. type
  3305. tpropopt=record
  3306. mask : tpropertyoption;
  3307. str : string[30];
  3308. end;
  3309. const
  3310. symopt : array[1..ord(high(tpropertyoption))] of tpropopt=(
  3311. (mask:ppo_indexed;str:'indexed'),
  3312. (mask:ppo_defaultproperty;str:'default'),
  3313. (mask:ppo_stored;str:'stored'),
  3314. (mask:ppo_hasparameters;str:'has parameters'),
  3315. (mask:ppo_implements;str:'implements'),
  3316. (mask:ppo_enumerator_current;str:'enumerator current'),
  3317. (mask:ppo_overrides;str:'overrides'),
  3318. (mask:ppo_dispid_write;str:'dispid write') { no longer used }
  3319. );
  3320. var
  3321. i : longint;
  3322. first : boolean;
  3323. begin
  3324. ppufile.getset(tppuset2(result));
  3325. if result<>[] then
  3326. begin
  3327. first:=true;
  3328. for i:=1 to high(symopt) do
  3329. if (symopt[i].mask in result) then
  3330. begin
  3331. if first then
  3332. first:=false
  3333. else
  3334. write(', ');
  3335. write(symopt[i].str);
  3336. end;
  3337. end;
  3338. writeln;
  3339. end;
  3340. function readmanagementoperatoroptions(const space : string;const name : string):tmanagementoperators;
  3341. { type is in unit symconst }
  3342. { Management operator options
  3343. tmanagementoperator=(
  3344. mop_none,
  3345. mop_initialize,
  3346. mop_finalize,
  3347. mop_addref,
  3348. mop_copy);
  3349. }
  3350. type
  3351. tmopopt=record
  3352. mask : tmanagementoperator;
  3353. str : string[10];
  3354. end;
  3355. const
  3356. managementoperatoropt : array[1..ord(high(tmanagementoperator))] of tmopopt=(
  3357. (mask:mop_initialize;str:'initialize'),
  3358. (mask:mop_finalize;str:'finalize'),
  3359. (mask:mop_addref;str:'addref'),
  3360. (mask:mop_copy;str:'copy')
  3361. );
  3362. var
  3363. i : longint;
  3364. first : boolean;
  3365. begin
  3366. ppufile.getset(tppuset1(result));
  3367. if result<>[] then
  3368. begin
  3369. first:=true;
  3370. for i:=1 to high(managementoperatoropt) do
  3371. if (managementoperatoropt[i].mask in result) then
  3372. begin
  3373. if first then
  3374. begin
  3375. write(space);
  3376. write(name);
  3377. write(': ');
  3378. first:=false;
  3379. end
  3380. else
  3381. write(', ');
  3382. write(managementoperatoropt[i].str);
  3383. end;
  3384. if not first then
  3385. writeln;
  3386. end;
  3387. end;
  3388. procedure readnodetree;
  3389. var
  3390. l : longint;
  3391. p : pointer;
  3392. begin
  3393. with ppufile do
  3394. begin
  3395. if space<>'' then
  3396. Writeln([space,'------ nodetree ------']);
  3397. if readentry=ibnodetree then
  3398. begin
  3399. l:=entrysize;
  3400. Writeln([space,'Tree size : ',l]);
  3401. { Read data to prevent error that entry is not completly read }
  3402. getmem(p,l);
  3403. getdata(p^,l);
  3404. freemem(p);
  3405. end
  3406. else
  3407. begin
  3408. WriteError('!! ibnodetree not found');
  3409. end;
  3410. end;
  3411. end;
  3412. procedure ReadCreatedObjTypes;
  3413. var
  3414. i,j,
  3415. len,
  3416. bssize: longint;
  3417. bs: pbyte;
  3418. begin
  3419. if ppufile.readentry<>ibcreatedobjtypes then
  3420. begin
  3421. WriteError('!! ibcreatedobjtypes entry not found');
  3422. ppufile.skipdata(ppufile.entrysize);
  3423. exit
  3424. end;
  3425. writeln;
  3426. writeln([space,'WPO info']);
  3427. writeln([space,'--------']);
  3428. len:=ppufile.getlongint;
  3429. writeln([space,'** Instantiated Object/Class types: ',len,' **']);
  3430. space:=space+' ';
  3431. for i:=0 to len-1 do
  3432. readderef(space);
  3433. setlength(space,length(space)-2);
  3434. len:=ppufile.getlongint;
  3435. writeln([space,'** Instantiated ClassRef types: ',len,' **']);
  3436. space:=space+' ';
  3437. for i:=0 to len-1 do
  3438. readderef(space);
  3439. setlength(space,length(space)-2);
  3440. len:=ppufile.getlongint;
  3441. writeln([space,'** Possibly instantiated ClassRef types : ',len,' **']);
  3442. space:=space+' ';
  3443. for i:=0 to len-1 do
  3444. readderef(space);
  3445. setlength(space,length(space)-2);
  3446. len:=ppufile.getlongint;
  3447. writeln([space,'** Class types with called virtual methods info : ',len,' **']);
  3448. space:=space+' ';
  3449. for i:=0 to len-1 do
  3450. begin
  3451. write([space,'Class def : ']);
  3452. readderef('');
  3453. write([space+' ','Called vmtentries : ']);
  3454. bssize:=ppufile.getlongint;
  3455. getmem(bs,bssize);
  3456. ppufile.readdata(bs^,bssize);
  3457. for j:=0 to bssize*8-1 do
  3458. if (((bs+j shr 3)^ shr (j and 7)) and 1) <> 0 then
  3459. write([j,', ']);
  3460. writeln;
  3461. freemem(bs);
  3462. end;
  3463. setlength(space,length(space)-2);
  3464. end;
  3465. {****************************************************************************
  3466. Read Symbols Part
  3467. ****************************************************************************}
  3468. procedure readsymbols(const s:string; ParentDef: TPpuContainerDef = nil);
  3469. function _finddef(symdef: TPpuDef): TPpuDef;
  3470. begin
  3471. Result:=nil;
  3472. if symdef.Ref.IsCurUnit then
  3473. begin;
  3474. Result:=CurUnit.FindById(symdef.Ref.Id);
  3475. if (Result <> nil) and (Result.Ref.Id = symdef.Id) then
  3476. begin
  3477. Result.Name:=symdef.Name;
  3478. Result.FilePos:=symdef.FilePos;
  3479. end
  3480. else
  3481. Result:=nil;
  3482. end;
  3483. end;
  3484. type
  3485. pguid = ^tguid;
  3486. tguid = packed record
  3487. D1: LongWord;
  3488. D2: Word;
  3489. D3: Word;
  3490. D4: array[0..7] of Byte;
  3491. end;
  3492. var
  3493. b : byte;
  3494. pc : pchar;
  3495. ch : dword;
  3496. startnewline : boolean;
  3497. i,j,len : longint;
  3498. prettyname, ss : ansistring;
  3499. ws: widestring;
  3500. guid : tguid;
  3501. realvalue : ppureal;
  3502. doublevalue : double;
  3503. singlevalue : single;
  3504. realstr : shortstring;
  3505. extended : TSplit80bitReal;
  3506. pw : pcompilerwidestring;
  3507. varoptions : tvaroptions;
  3508. propoptions : tpropertyoptions;
  3509. iexp: Tconstexprint;
  3510. def: TPpuDef;
  3511. constdef: TPpuConstDef absolute def;
  3512. begin
  3513. with ppufile do
  3514. begin
  3515. if space<>'' then
  3516. Writeln([space,'------ ',s,' ------']);
  3517. if readentry=ibstartsyms then
  3518. begin
  3519. Writeln([space,'Symtable count: ',getlongint]);
  3520. end
  3521. else
  3522. Writeln('!! ibstartsym not found');
  3523. repeat
  3524. def:=nil;
  3525. b:=readentry;
  3526. case b of
  3527. ibunitsym :
  3528. readcommonsym('Unit symbol ');
  3529. ibnamespacesym :
  3530. begin
  3531. readcommonsym('NameSpace symbol ');
  3532. write([space,' Hidden Unit : ']);
  3533. readderef('');
  3534. end;
  3535. iblabelsym :
  3536. readcommonsym('Label symbol ');
  3537. ibtypesym :
  3538. begin
  3539. def:=TPpuTypeRef.Create(nil);
  3540. readcommonsym('Type symbol ',def);
  3541. write([space,' Result Type : ']);
  3542. readderef('', def.Ref);
  3543. if _finddef(def) = nil then
  3544. def.Parent:=ParentDef;
  3545. prettyname:=getansistring;
  3546. if prettyname<>'' then
  3547. begin
  3548. write([space,' Pretty Name : ']);
  3549. Writeln(prettyname);
  3550. end;
  3551. end;
  3552. ibprocsym :
  3553. begin
  3554. def:=TPpuDef.Create(nil);
  3555. readcommonsym('Procedure symbol ', def);
  3556. len:=ppufile.getword;
  3557. for i:=1 to len do
  3558. begin
  3559. write([space,' Definition : ']);
  3560. readderef('', def.Ref);
  3561. _finddef(def);
  3562. end;
  3563. if def.GenericDummy then
  3564. begin
  3565. len:=ppufile.getword;
  3566. for i:=1 to len do
  3567. begin
  3568. write([space,' Gen Ovld : ']);
  3569. readderef('',def.Ref);
  3570. _finddef(def);
  3571. end;
  3572. end;
  3573. end;
  3574. ibconstsym :
  3575. begin
  3576. constdef:=TPpuConstDef.Create(ParentDef);
  3577. readcommonsym('Constant symbol ',constdef);
  3578. b:=getbyte;
  3579. case tconsttyp(b) of
  3580. constord :
  3581. begin
  3582. write ([space,' OrdinalType : ']);
  3583. readderef('',constdef.TypeRef);
  3584. iexp:=getexprint;
  3585. constdef.ConstType:=ctInt;
  3586. constdef.VInt:=iexp.svalue;
  3587. writeln([space,' Value : ',constexp.tostr(iexp)]);
  3588. end;
  3589. constpointer :
  3590. begin
  3591. write ([space,' PointerType : ']);
  3592. readderef('',constdef.TypeRef);
  3593. constdef.ConstType:=ctInt;
  3594. constdef.VInt:=int64(getptruint);
  3595. writeln([space,' Value : ',constdef.VInt])
  3596. end;
  3597. conststring,
  3598. constresourcestring :
  3599. begin
  3600. write ([space,' StringType : ']);
  3601. readderef('',constdef.TypeRef);
  3602. len:=getlongint;
  3603. getmem(pc,len+1);
  3604. getdata(pc^,len);
  3605. (pc+len)^:= #0;
  3606. writeln([space,' Length : ',len]);
  3607. writeln([space,' Value : "',pc,'"']);
  3608. constdef.ConstType:=ctStr;
  3609. SetString(constdef.VStr, pc, len);
  3610. constdef.VStr:=UTF8Encode(constdef.VStr);
  3611. freemem(pc,len+1);
  3612. end;
  3613. constreal :
  3614. begin
  3615. constdef.ConstType:=ctFloat;
  3616. write ([space,' RealType : ']);
  3617. readderef('',constdef.TypeRef);
  3618. write([space,' Value : ']);
  3619. if entryleft=sizeof(ppureal) then
  3620. begin
  3621. realvalue:=getrealsize(sizeof(ppureal));
  3622. constdef.VFloat:=realvalue;
  3623. system.str(realvalue,realstr);
  3624. writeln([realstr]);
  3625. end
  3626. else if entryleft=sizeof(double) then
  3627. begin
  3628. doublevalue:=getrealsize(sizeof(double));
  3629. constdef.VFloat:=doublevalue;
  3630. system.str(doublevalue,realstr);
  3631. writeln([realstr]);
  3632. end
  3633. else if entryleft=sizeof(single) then
  3634. begin
  3635. singlevalue:=getrealsize(sizeof(single));
  3636. constdef.VFloat:=singlevalue;
  3637. system.str(singlevalue,realstr);
  3638. writeln([realstr]);
  3639. end
  3640. else if entryleft=10 then
  3641. begin
  3642. getdata(extended,entryleft);
  3643. ss:=Real80bitToStr(extended,constdef.VFloat);
  3644. writeln(ss);
  3645. end
  3646. else
  3647. begin
  3648. realvalue:=0.0;
  3649. WriteError('Error reading real value');
  3650. end;
  3651. end;
  3652. constset :
  3653. begin
  3654. constdef.ConstType:=ctSet;
  3655. write ([space,' Set Type : ']);
  3656. readderef('',constdef.TypeRef);
  3657. for i:=1to 4 do
  3658. begin
  3659. write ([space,' Value : ']);
  3660. for j:=1to 8 do
  3661. begin
  3662. if j>1 then
  3663. write(',');
  3664. b:=getbyte;
  3665. if ppufile.change_endian then
  3666. b:=reverse_byte(b);
  3667. write(hexstr(b,2));
  3668. constdef.VSet[i*j-1]:=b;
  3669. end;
  3670. writeln;
  3671. end;
  3672. end;
  3673. constnil:
  3674. begin
  3675. write([space,' NIL pointer :']);
  3676. readderef('',constdef.TypeRef);
  3677. constdef.ConstType:=ctPtr;
  3678. constdef.VInt:=0;
  3679. end;
  3680. constwstring :
  3681. begin
  3682. initwidestring(pw);
  3683. setlengthwidestring(pw,getlongint);
  3684. if widecharsize=2 then
  3685. { don't use getdata, because the compilerwidechars may have to
  3686. be byteswapped
  3687. }
  3688. begin
  3689. for i:=0 to pw^.len-1 do
  3690. pw^.data[i]:=ppufile.getword;
  3691. SetString(ws, PWideChar(pw^.data), pw^.len);
  3692. constdef.VStr:=UTF8Encode(ws);
  3693. constdef.ConstType:=ctStr;
  3694. end
  3695. else if widecharsize=4 then
  3696. begin
  3697. for i:=0 to pw^.len-1 do
  3698. pw^.data[i]:=cardinal(ppufile.getlongint);
  3699. end
  3700. else
  3701. begin
  3702. WriteError('Unsupported tcompilerwidechar size');
  3703. end;
  3704. Write([space,'Wide string type']);
  3705. startnewline:=true;
  3706. for i:=0 to pw^.len-1 do
  3707. begin
  3708. if startnewline then
  3709. begin
  3710. writeln;
  3711. write(space);
  3712. startnewline:=false;
  3713. end;
  3714. ch:=pw^.data[i];
  3715. if widecharsize=2 then
  3716. write(hexstr(ch,4))
  3717. else
  3718. write(hexstr(ch,8));
  3719. if ((i + 1) mod 8)= 0 then
  3720. startnewline:=true
  3721. else
  3722. if i <> pw^.len-1 then
  3723. write(', ');
  3724. end;
  3725. donewidestring(pw);
  3726. Writeln;
  3727. end;
  3728. constguid:
  3729. begin
  3730. write ([space,' IntfType : ']);
  3731. readderef('',constdef.TypeRef);
  3732. getdata(guid,sizeof(guid));
  3733. write ([space,' IID String: {',hexstr(guid.d1,8),'-',hexstr(guid.d2,4),'-',hexstr(guid.d3,4),'-']);
  3734. for i:=0 to 7 do
  3735. begin
  3736. write(hexstr(guid.d4[i],2));
  3737. if i=1 then write('-');
  3738. end;
  3739. writeln('}');
  3740. end
  3741. else
  3742. Writeln (['!! Invalid unit format : Invalid const type encountered: ',b]);
  3743. end;
  3744. end;
  3745. ibabsolutevarsym :
  3746. begin
  3747. def:=TPpuVarDef.Create(ParentDef);
  3748. readabstractvarsym('Absolute variable symbol ',varoptions,TPpuVarDef(def));
  3749. Write ([space,' Relocated to ']);
  3750. b:=getbyte;
  3751. case absolutetyp(b) of
  3752. tovar :
  3753. readpropaccesslist(space+' Sym : ');
  3754. toasm :
  3755. Writeln(['Assembler name : ',getstring]);
  3756. toaddr :
  3757. begin
  3758. Write(['Address : ',getpuint]);
  3759. if tsystemcpu(ppufile.header.common.cpu)=cpu_i386 then
  3760. Write([' (Far: ',getbyte<>0,')']);
  3761. if tsystemcpu(ppufile.header.common.cpu)=cpu_i8086 then
  3762. if getbyte<>0 then
  3763. Write([' (Far: TRUE, Segment=',getaword,')'])
  3764. else
  3765. Write([' (Far: FALSE)']);
  3766. Writeln;
  3767. end;
  3768. else
  3769. Writeln (['!! Invalid unit format : Invalid absolute type encountered: ',b]);
  3770. end;
  3771. end;
  3772. ibfieldvarsym :
  3773. begin
  3774. def:=TPpuFieldDef.Create(ParentDef);
  3775. readabstractvarsym('Field Variable symbol ',varoptions,TPpuVarDef(def));
  3776. writeln([space,' Address : ',getasizeint]);
  3777. if vo_has_mangledname in varoptions then
  3778. writeln([space,' Mangled name : ',getstring]);
  3779. end;
  3780. ibstaticvarsym :
  3781. begin
  3782. def:=TPpuVarDef.Create(ParentDef);
  3783. readabstractvarsym('Global Variable symbol ',varoptions,TPpuVarDef(def));
  3784. write ([space,' DefaultConst : ']);
  3785. readderef('');
  3786. if (vo_has_mangledname in varoptions) then
  3787. writeln([space,'Mangledname : ',readsymstr(ppufile)]);
  3788. if vo_has_section in varoptions then
  3789. writeln(['Section name:',ppufile.getansistring]);
  3790. write ([space,' FieldVarSymDeref: ']);
  3791. readderef('');
  3792. end;
  3793. iblocalvarsym :
  3794. begin
  3795. readabstractvarsym('Local Variable symbol ',varoptions);
  3796. write ([space,' DefaultConst : ']);
  3797. readderef('');
  3798. end;
  3799. ibparavarsym :
  3800. begin
  3801. def:=TPpuParamDef.Create(ParentDef);
  3802. readabstractvarsym('Parameter Variable symbol ',varoptions,TPpuVarDef(def));
  3803. write ([space,' DefaultConst : ']);
  3804. readderef('',TPpuParamDef(def).DefaultValue);
  3805. writeln([space,' ParaNr : ',getword]);
  3806. writeln([space,' Univ : ',getboolean]);
  3807. writeln([space,' VarState : ',getbyte]);
  3808. writeln([space,' Refs : ',getbyte]);
  3809. if (vo_has_explicit_paraloc in varoptions) then
  3810. begin
  3811. readcgpara(space+' ');
  3812. end;
  3813. end;
  3814. ibenumsym :
  3815. begin
  3816. def:=TPpuConstDef.Create(nil);
  3817. readcommonsym('Enumeration symbol ',def);
  3818. write ([space,' Definition : ']);
  3819. readderef('');
  3820. TPpuConstDef(def).ConstType:=ctInt;
  3821. TPpuConstDef(def).VInt:=getlongint;
  3822. writeln([space,' Value : ',TPpuConstDef(def).VInt]);
  3823. if (ParentDef <> nil) and (ParentDef.DefType = dtEnum) then
  3824. def.Parent:=ParentDef;
  3825. end;
  3826. ibsyssym :
  3827. begin
  3828. readcommonsym('Internal system symbol ');
  3829. writeln([space,' Internal Nr : ',getlongint]);
  3830. end;
  3831. ibmacrosym :
  3832. begin
  3833. readcommonsym('Macro symbol ');
  3834. writeln([space,' Defined: ',getboolean]);
  3835. writeln([space,' Compiler var: ',getboolean]);
  3836. len:=getlongint;
  3837. writeln([space,' Value length: ',len]);
  3838. if len > 0 then
  3839. begin
  3840. getmem(pc,len+1);
  3841. getdata(pc^,len);
  3842. (pc+len)^:= #0;
  3843. writeln([space,' Value: "',pc,'"']);
  3844. freemem(pc,len+1);
  3845. end;
  3846. end;
  3847. ibpropertysym :
  3848. begin
  3849. def:=TPpuPropDef.Create(ParentDef);
  3850. readcommonsym('Property ',def);
  3851. write ([space,' Prop Options : ']);
  3852. propoptions:=readpropertyoptions;
  3853. if ppo_overrides in propoptions then
  3854. begin
  3855. write ([space,' OverrideProp : ']);
  3856. readderef('');
  3857. end;
  3858. if ppo_defaultproperty in propoptions then
  3859. Include(TPpuPropDef(def).Options, poDefault);
  3860. write ([space,' Prop Type : ']);
  3861. readderef('',TPpuPropDef(def).PropType);
  3862. writeln([space,' Index : ',getlongint]);
  3863. writeln([space,' Default : ',getlongint]);
  3864. write ([space,' Index Type : ']);
  3865. readderef('');
  3866. { palt_none }
  3867. write ([space,' Noneaccess : ']);
  3868. readpropaccesslist('');
  3869. write ([space,' Readaccess : ']);
  3870. readpropaccesslist(space+' Sym: ',TPpuPropDef(def).Getter);
  3871. write ([space,' Writeaccess : ']);
  3872. readpropaccesslist(space+' Sym: ',TPpuPropDef(def).Setter);
  3873. write ([space,' Storedaccess : ']);
  3874. readpropaccesslist(space+' Sym: ');
  3875. if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
  3876. begin
  3877. space:=' '+space;
  3878. readsymtable('parast',TPpuPropDef(def));
  3879. delete(space,1,4);
  3880. end;
  3881. end;
  3882. iberror :
  3883. begin
  3884. WriteError('!! Error in PPU');
  3885. exit;
  3886. end;
  3887. ibendsyms :
  3888. break;
  3889. else
  3890. begin
  3891. WriteError('!! Skipping unsupported PPU Entry in Symbols: '+IntToStr(b));
  3892. end;
  3893. end;
  3894. if assigned(def) then
  3895. readsymsubentries(def);
  3896. if (def <> nil) and (def.Parent = nil) then
  3897. def.Free;
  3898. if not EndOfEntry then
  3899. HasMoreInfos;
  3900. until false;
  3901. end;
  3902. end;
  3903. {****************************************************************************
  3904. Read defintions Part
  3905. ****************************************************************************}
  3906. procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef);
  3907. { type tordtype is in symconst unit }
  3908. {
  3909. uvoid,
  3910. u8bit,u16bit,u32bit,u64bit,u128bit,
  3911. s8bit,s16bit,s32bit,s64bit,s128bit,
  3912. bool8bit,bool16bit,bool32bit,bool64bit,
  3913. uchar,uwidechar,scurrency,customint
  3914. ); }
  3915. { type tobjecttyp is in symconst unit }
  3916. { type tvarianttype is in symconst unit }
  3917. { type thelpertype is in symconst unit }
  3918. var
  3919. b : byte;
  3920. otb : byte; { Object Type byte, needed later again }
  3921. l,j,tokenbufsize : longint;
  3922. tokenbuf : pbyte;
  3923. calloption : tproccalloption;
  3924. procoptions : tprocoptions;
  3925. implprocoptions: timplprocoptions;
  3926. defoptions: tdefoptions;
  3927. iexpr: Tconstexprint;
  3928. def: TPpuDef;
  3929. objdef: TPpuObjectDef absolute def;
  3930. arrdef: TPpuArrayDef absolute def;
  3931. enumdef: TPpuEnumDef absolute def;
  3932. setdef: TPpuSetDef absolute def;
  3933. orddef: TPpuOrdDef absolute def;
  3934. floatdef: TPpuFloatDef absolute def;
  3935. strdef: TPpuStringDef absolute def;
  3936. filedef: TPpuFileDef absolute def;
  3937. begin
  3938. with ppufile do
  3939. begin
  3940. if space<>'' then
  3941. Writeln([space,'------ ',s,' ------']);
  3942. if readentry<>ibstartdefs then
  3943. Writeln('!! ibstartdefs not found');
  3944. repeat
  3945. def:=nil;
  3946. b:=readentry;
  3947. case b of
  3948. ibpointerdef :
  3949. begin
  3950. def:=TPpuPointerDef.Create(ParentDef);
  3951. readcommondef('Pointer definition',defoptions,def);
  3952. write ([space,' Pointed Type : ']);
  3953. readderef('',TPpuPointerDef(def).Ptr);
  3954. writeln([space,' Has Pointer Math : ',(getbyte<>0)]);
  3955. if tsystemcpu(ppufile.header.common.cpu) in [cpu_i8086,cpu_i386,cpu_x86_64] then
  3956. begin
  3957. write([space,' X86 Pointer Type : ']);
  3958. b:=getbyte;
  3959. case tx86pointertyp(b) of
  3960. x86pt_near: writeln('Near');
  3961. x86pt_near_cs: writeln('Near ''CS''');
  3962. x86pt_near_ds: writeln('Near ''DS''');
  3963. x86pt_near_ss: writeln('Near ''SS''');
  3964. x86pt_near_es: writeln('Near ''ES''');
  3965. x86pt_near_fs: writeln('Near ''FS''');
  3966. x86pt_near_gs: writeln('Near ''GS''');
  3967. x86pt_far: writeln('Far');
  3968. x86pt_huge: writeln('Huge');
  3969. else
  3970. WriteWarning('Invalid x86 pointer type: ' + IntToStr(b));
  3971. end;
  3972. end;
  3973. if tsystemcpu(ppufile.header.common.cpu)=cpu_wasm32 then
  3974. writeln([space,' WASM externref : ',(getbyte<>0)]);
  3975. end;
  3976. iborddef :
  3977. begin
  3978. orddef:=TPpuOrdDef.Create(ParentDef);
  3979. readcommondef('Ordinal definition',defoptions,orddef);
  3980. write ([space,' Base type : ']);
  3981. b:=getbyte;
  3982. case tordtype(b) of
  3983. uvoid:
  3984. begin
  3985. writeln('uvoid');
  3986. orddef.OrdType:=otVoid;
  3987. end;
  3988. u8bit:
  3989. begin
  3990. writeln('u8bit');
  3991. orddef.OrdType:=otUInt;
  3992. orddef.Size:=1;
  3993. end;
  3994. u16bit:
  3995. begin
  3996. writeln('u16bit');
  3997. orddef.OrdType:=otUInt;
  3998. orddef.Size:=2;
  3999. end;
  4000. u32bit:
  4001. begin
  4002. writeln('u32bit');
  4003. orddef.OrdType:=otUInt;
  4004. orddef.Size:=4;
  4005. end;
  4006. u64bit:
  4007. begin
  4008. writeln('u64bit');
  4009. orddef.OrdType:=otUInt;
  4010. orddef.Size:=8;
  4011. end;
  4012. u128bit:
  4013. begin
  4014. writeln('u128bit');
  4015. orddef.OrdType:=otUInt;
  4016. orddef.Size:=16;
  4017. end;
  4018. s8bit:
  4019. begin
  4020. writeln('s8bit');
  4021. orddef.OrdType:=otSInt;
  4022. orddef.Size:=1;
  4023. end;
  4024. s16bit:
  4025. begin
  4026. writeln('s16bit');
  4027. orddef.OrdType:=otSInt;
  4028. orddef.Size:=2;
  4029. end;
  4030. s32bit:
  4031. begin
  4032. writeln('s32bit');
  4033. orddef.OrdType:=otSInt;
  4034. orddef.Size:=4;
  4035. end;
  4036. s64bit:
  4037. begin
  4038. writeln('s64bit');
  4039. orddef.OrdType:=otSInt;
  4040. orddef.Size:=8;
  4041. end;
  4042. s128bit:
  4043. begin
  4044. writeln('s128bit');
  4045. orddef.OrdType:=otSInt;
  4046. orddef.Size:=16;
  4047. end;
  4048. pasbool1:
  4049. begin
  4050. writeln('pasbool1');
  4051. orddef.OrdType:=otPasBool;
  4052. orddef.Size:=1;
  4053. end;
  4054. pasbool8:
  4055. begin
  4056. writeln('pasbool8');
  4057. orddef.OrdType:=otPasBool;
  4058. orddef.Size:=1;
  4059. end;
  4060. pasbool16:
  4061. begin
  4062. writeln('pasbool16');
  4063. orddef.OrdType:=otPasBool;
  4064. orddef.Size:=2;
  4065. end;
  4066. pasbool32:
  4067. begin
  4068. writeln('pasbool32');
  4069. orddef.OrdType:=otPasBool;
  4070. orddef.Size:=4;
  4071. end;
  4072. pasbool64:
  4073. begin
  4074. writeln('pasbool64');
  4075. orddef.OrdType:=otPasBool;
  4076. orddef.Size:=8;
  4077. end;
  4078. bool8bit:
  4079. begin
  4080. writeln('bool8bit');
  4081. orddef.OrdType:=otBool;
  4082. orddef.Size:=1;
  4083. end;
  4084. bool16bit:
  4085. begin
  4086. writeln('bool16bit');
  4087. orddef.OrdType:=otBool;
  4088. orddef.Size:=2;
  4089. end;
  4090. bool32bit:
  4091. begin
  4092. writeln('bool32bit');
  4093. orddef.OrdType:=otBool;
  4094. orddef.Size:=4;
  4095. end;
  4096. bool64bit:
  4097. begin
  4098. writeln('bool64bit');
  4099. orddef.OrdType:=otBool;
  4100. orddef.Size:=8;
  4101. end;
  4102. uchar:
  4103. begin
  4104. writeln('uchar');
  4105. orddef.OrdType:=otChar;
  4106. orddef.Size:=1;
  4107. end;
  4108. uwidechar:
  4109. begin
  4110. writeln('uwidechar');
  4111. orddef.OrdType:=otChar;
  4112. orddef.Size:=2;
  4113. end;
  4114. scurrency:
  4115. begin
  4116. writeln('scurrency');
  4117. orddef.OrdType:=otCurrency;
  4118. orddef.Size:=8;
  4119. end;
  4120. customint:
  4121. begin
  4122. writeln('customint');
  4123. orddef.OrdType:=otSint;
  4124. orddef.Size:=sizeof(ASizeInt);
  4125. end
  4126. else
  4127. WriteWarning('Invalid base type: ' + IntToStr(b));
  4128. end;
  4129. iexpr:=getexprint;
  4130. orddef.RangeLow:=iexpr.svalue;
  4131. write([space,' Range : ',constexp.tostr(iexpr)]);
  4132. iexpr:=getexprint;
  4133. orddef.RangeHigh:=iexpr.svalue;
  4134. writeln([' to ',constexp.tostr(iexpr)]);
  4135. end;
  4136. ibfloatdef :
  4137. begin
  4138. floatdef:=TPpuFloatDef.Create(ParentDef);
  4139. readcommondef('Float definition',defoptions,floatdef);
  4140. write ([space,' Float type : ']);
  4141. b:=getbyte;
  4142. case b of
  4143. ftSingle:
  4144. begin
  4145. writeln('Single');
  4146. floatdef.FloatType:=pftSingle;
  4147. end;
  4148. ftDouble:
  4149. begin
  4150. writeln('Double');
  4151. floatdef.FloatType:=pftDouble;
  4152. end;
  4153. ftExtended:
  4154. begin
  4155. writeln('Extended');
  4156. floatdef.FloatType:=pftExtended;
  4157. end;
  4158. ftComp:
  4159. begin
  4160. writeln('Comp');
  4161. floatdef.FloatType:=pftComp;
  4162. end;
  4163. ftCurr:
  4164. begin
  4165. writeln('Currency');
  4166. floatdef.FloatType:=pftCurrency;
  4167. end;
  4168. ftFloat128:
  4169. begin
  4170. writeln('Float128');
  4171. floatdef.FloatType:=pftFloat128;
  4172. end;
  4173. else
  4174. WriteWarning('Invalid float type: ' + IntToStr(b));
  4175. end;
  4176. end;
  4177. ibarraydef :
  4178. begin
  4179. arrdef:=TPpuArrayDef.Create(ParentDef);
  4180. readcommondef('Array definition',defoptions,arrdef);
  4181. write ([space,' Element type : ']);
  4182. readderef('',arrdef.ElType);
  4183. write ([space,' Range Type : ']);
  4184. readderef('',arrdef.RangeType);
  4185. arrdef.RangeLow:=getasizeint;
  4186. arrdef.RangeHigh:=getasizeint;
  4187. writeln([space,' Range : ',arrdef.RangeLow,' to ',arrdef.RangeHigh]);
  4188. write ([space,' Options : ']);
  4189. readarraydefoptions(arrdef);
  4190. if tsystemcpu(ppufile.header.common.cpu)=cpu_i8086 then
  4191. writeln([space,' Huge : ',(getbyte<>0)]);
  4192. readsymtable('symbols', arrdef);
  4193. end;
  4194. ibprocdef :
  4195. begin
  4196. def:=TPpuProcDef.Create(ParentDef);
  4197. readcommondef('Procedure definition',defoptions,def);
  4198. read_abstract_proc_def(calloption,procoptions,TPpuProcDef(def));
  4199. if (po_has_mangledname in procoptions) then
  4200. writeln([space,' Mangled name : ',readsymstr(ppufile)]);
  4201. writeln([space,' Number : ',getword]);
  4202. writeln([space,' Level : ',getbyte]);
  4203. write ([space,' Class : ']);
  4204. readderef('');
  4205. write ([space,' Procsym : ']);
  4206. readderef('', def.Ref);
  4207. write ([space,' File Pos : ']);
  4208. readposinfo(def);
  4209. write ([space,' Visibility : ']);
  4210. readvisibility(def);
  4211. write ([space,' SymOptions : ']);
  4212. readsymoptions(space+' ');
  4213. if (po_has_importdll in procoptions) then
  4214. writeln([space,' Import DLL : ',getstring]);
  4215. if (po_has_importname in procoptions) then
  4216. writeln([space,' Import Name : ',getstring]);
  4217. writeln([space,' Import Nr : ',getword]);
  4218. if (po_msgint in procoptions) then
  4219. writeln([space,' MsgInt : ',getlongint]);
  4220. if (po_msgstr in procoptions) then
  4221. writeln([space,' MsgStr : ',getstring]);
  4222. if (po_dispid in procoptions) then
  4223. writeln([space,' DispID: ',ppufile.getlongint]);
  4224. readprocimploptions(space,implprocoptions);
  4225. if (pio_has_inlininginfo in implprocoptions) then
  4226. begin
  4227. write ([space,' FuncretSym : ']);
  4228. readderef('');
  4229. readprocinfooptions(space);
  4230. end;
  4231. b:=ppufile.getbyte;
  4232. if b<>0 then
  4233. begin
  4234. write ([space,' Alias names : ']);
  4235. for j:=1 to b do
  4236. begin
  4237. write(ppufile.getstring);
  4238. if j<b then
  4239. write(', ');
  4240. end;
  4241. writeln;
  4242. end;
  4243. tokenbufsize:=ppufile.getlongint;
  4244. if tokenbufsize<>0 then
  4245. begin
  4246. space:=space + ' ';
  4247. write ([space,'Declaration token buffer : size = ',tokenbufsize]);
  4248. tokenbuf:=allocmem(tokenbufsize);
  4249. ppufile.getdata(tokenbuf^,tokenbufsize);
  4250. displaytokenbuffer(tokenbuf,tokenbufsize);
  4251. freemem(tokenbuf);
  4252. delete(space,1,4);
  4253. end;
  4254. if po_syscall_has_libsym in procoptions then
  4255. begin
  4256. { library symbol for AmigaOS/MorphOS/AROS }
  4257. write ([space,' Library symbol : ']);
  4258. readderef('');
  4259. end;
  4260. if not EndOfEntry then
  4261. HasMoreInfos;
  4262. space:=' '+space;
  4263. { parast }
  4264. readsymtable('parast', TPpuProcDef(def));
  4265. { localst }
  4266. if (pio_has_inlininginfo in implprocoptions) then
  4267. readsymtable('inline localst')
  4268. else if (df_generic in defoptions) then
  4269. readsymtable('generic localst');
  4270. if (pio_has_inlininginfo in implprocoptions) then
  4271. readnodetree;
  4272. delete(space,1,4);
  4273. end;
  4274. ibprocvardef :
  4275. begin
  4276. def:=TPpuProcTypeDef.Create(ParentDef);
  4277. readcommondef('Procedural type (ProcVar) definition',defoptions,def);
  4278. read_abstract_proc_def(calloption,procoptions, TPpuProcDef(def));
  4279. writeln([space,' Symtable level :',ppufile.getbyte]);
  4280. if tsystemcpu(ppufile.header.common.cpu)=cpu_jvm then
  4281. readderef('');
  4282. if not EndOfEntry then
  4283. HasMoreInfos;
  4284. space:=' '+space;
  4285. { parast }
  4286. readsymtable('parast',TPpuProcDef(def));
  4287. delete(space,1,4);
  4288. end;
  4289. ibshortstringdef :
  4290. begin
  4291. strdef:=TPpuStringDef.Create(ParentDef);
  4292. strdef.StrType:=stShort;
  4293. readcommondef('ShortString definition',defoptions,strdef);
  4294. strdef.Len:=getbyte;
  4295. writeln([space,' Length : ',strdef.Len]);
  4296. end;
  4297. ibwidestringdef :
  4298. begin
  4299. strdef:=TPpuStringDef.Create(ParentDef);
  4300. strdef.StrType:=stWide;
  4301. readcommondef('WideString definition',defoptions,strdef);
  4302. strdef.Len:=getasizeint;
  4303. writeln([space,' Length : ',strdef.Len]);
  4304. end;
  4305. ibunicodestringdef :
  4306. begin
  4307. strdef:=TPpuStringDef.Create(ParentDef);
  4308. strdef.StrType:=stUnicode;
  4309. readcommondef('UnicodeString definition',defoptions,strdef);
  4310. strdef.Len:=getasizeint;
  4311. writeln([space,' Length : ',strdef.Len]);
  4312. writeln([space,' Encoding : ',getword]);
  4313. end;
  4314. ibansistringdef :
  4315. begin
  4316. strdef:=TPpuStringDef.Create(ParentDef);
  4317. strdef.StrType:=stAnsi;
  4318. readcommondef('AnsiString definition',defoptions,strdef);
  4319. strdef.Len:=getasizeint;
  4320. writeln([space,' Length : ',strdef.Len]);
  4321. writeln([space,' Encoding : ',getword]);
  4322. end;
  4323. iblongstringdef :
  4324. begin
  4325. strdef:=TPpuStringDef.Create(ParentDef);
  4326. strdef.StrType:=stLong;
  4327. readcommondef('Longstring definition',defoptions,strdef);
  4328. strdef.Len:=getasizeint;
  4329. writeln([space,' Length : ',strdef.Len]);
  4330. end;
  4331. ibrecorddef :
  4332. begin
  4333. objdef:=TPpuRecordDef.Create(ParentDef);
  4334. readcommondef('Record definition',defoptions, objdef);
  4335. def.Name:=getstring;
  4336. writeln([space,' Name of Record : ',objdef.Name]);
  4337. writeln([space,' Import lib/pkg : ',getstring]);
  4338. write ([space,' Options : ']);
  4339. readobjectdefoptions(objdef);
  4340. writeln([space,' Extended RTTI : ']);
  4341. readextendedrtti;
  4342. if (df_copied_def in defoptions) then
  4343. begin
  4344. Include(TPpuRecordDef(def).Options, ooCopied);
  4345. write([space,' Copied from : ']);
  4346. readderef('',objdef.Ancestor);
  4347. end
  4348. else
  4349. begin
  4350. writeln([space,' FieldAlign : ',shortint(getbyte)]);
  4351. writeln([space,' RecordAlign : ',shortint(getbyte)]);
  4352. writeln([space,' PadAlign : ',shortint(getbyte)]);
  4353. writeln([space,'UseFieldAlignment : ',shortint(getbyte)]);
  4354. writeln([space,' RecordAlignMin : ',shortint(getbyte)]);
  4355. objdef.Size:=getasizeint;
  4356. writeln([space,' DataSize : ',objdef.Size]);
  4357. writeln([space,' PaddingSize : ',getword]);
  4358. readmanagementoperatoroptions(space,'Management operators');
  4359. end;
  4360. {read the record definitions and symbols}
  4361. if not(df_copied_def in current_defoptions) then
  4362. begin
  4363. space:=' '+space;
  4364. readrecordsymtable('fields',TPpuRecordDef(def));
  4365. Delete(space,1,4);
  4366. end;
  4367. if not EndOfEntry then
  4368. HasMoreInfos;
  4369. end;
  4370. ibobjectdef :
  4371. begin
  4372. objdef:=TPpuObjectDef.Create(ParentDef);
  4373. readcommondef('Object/Class definition',defoptions,objdef);
  4374. objdef.Name:=getstring;
  4375. writeln([space,' Name of Class : ',objdef.Name]);
  4376. writeln([space,' Import lib/pkg : ',getstring]);
  4377. write ([space,' Options : ']);
  4378. readobjectdefoptions(objdef);
  4379. writeln([space,' Extended RTTI : ']);
  4380. readextendedrtti;
  4381. otb:=getbyte;
  4382. write ([space,' Type : ']);
  4383. case tobjecttyp(otb) of
  4384. odt_class : writeln('class');
  4385. odt_object : writeln('object');
  4386. odt_interfacecom : writeln('interfacecom');
  4387. odt_interfacecorba : writeln('interfacecorba');
  4388. odt_cppclass : writeln('cppclass');
  4389. odt_dispinterface : writeln('dispinterface');
  4390. odt_objcclass : writeln('objcclass');
  4391. odt_objcprotocol : writeln('objcprotocol');
  4392. odt_helper : writeln('helper');
  4393. odt_objccategory : writeln('objccategory');
  4394. odt_javaclass : writeln('Java class');
  4395. odt_interfacejava : writeln('Java interface');
  4396. else WriteWarning('Invalid object type: ' + IntToStr(b));
  4397. end;
  4398. case tobjecttyp(otb) of
  4399. odt_class, odt_cppclass, odt_objcclass, odt_javaclass:
  4400. objdef.ObjType:=otClass;
  4401. odt_object:
  4402. objdef.ObjType:=otObject;
  4403. odt_interfacecom, odt_interfacecorba, odt_interfacejava, odt_dispinterface:
  4404. objdef.ObjType:=otInterface;
  4405. odt_helper:
  4406. objdef.ObjType:=otHelper;
  4407. end;
  4408. b:=getbyte;
  4409. write ([space,' Helper Type : ']);
  4410. case thelpertype(b) of
  4411. ht_none : writeln('none');
  4412. ht_class : writeln('class helper');
  4413. ht_record : writeln('record helper');
  4414. ht_type : writeln('type helper');
  4415. else WriteWarning('Invalid helper type: ' + IntToStr(b));
  4416. end;
  4417. writeln([space,' External name : ',getstring]);
  4418. objdef.Size:=getasizeint;
  4419. writeln([space,' DataSize : ',objdef.Size]);
  4420. writeln([space,' PaddingSize : ',getword]);
  4421. writeln([space,' FieldAlign : ',shortint(getbyte)]);
  4422. writeln([space,' RecordAlign : ',shortint(getbyte)]);
  4423. writeln([space,' RecordAlignMin : ',shortint(getbyte)]);
  4424. write ([space, ' VmtField : ']);
  4425. readderef('',nil);
  4426. write ([space, ' Ancestor Class : ']);
  4427. readderef('',objdef.Ancestor);
  4428. if tobjecttyp(otb) in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
  4429. begin
  4430. { IIDGUID }
  4431. for j:=1to 16 do
  4432. getbyte;
  4433. objdef.IID:=getstring;
  4434. writeln([space,' IID String : ',objdef.IID]);
  4435. end;
  4436. l:=getlongint;
  4437. if l > 0 then
  4438. objdef.Options:=objdef.Options + [ooAbstractMethods];
  4439. writeln([space,' Abstract methods : ',l]);
  4440. if tobjecttyp(otb)=odt_helper then
  4441. begin
  4442. write([space,' Helper parent : ']);
  4443. readderef('',objdef.HelperParent);
  4444. end;
  4445. l:=getlongint;
  4446. writeln([space,' VMT entries: ',l]);
  4447. for j:=1 to l do
  4448. begin
  4449. write([space,' ']);
  4450. readderef('');
  4451. write([space,' Visibility: ']);
  4452. readvisibility;
  4453. end;
  4454. if tobjecttyp(otb) in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
  4455. begin
  4456. l:=getlongint;
  4457. writeln([space,' Impl Intf Count : ',l]);
  4458. for j:=1 to l do
  4459. begin
  4460. write ([space,' - Definition : ']);
  4461. readderef('');
  4462. write ([space,' - Getter Def : ']);
  4463. readderef('');
  4464. writeln([space,' IOffset : ',getlongint]);
  4465. writeln([space,' Entry type : ',IntfEntryType2Str(getbyte)]);
  4466. end;
  4467. end;
  4468. if df_copied_def in current_defoptions then
  4469. begin
  4470. Include(objdef.Options, ooCopied);
  4471. writeln(' Copy of def: ');
  4472. readderef('',objdef.Ancestor);
  4473. end
  4474. else
  4475. begin
  4476. {read the record definitions and symbols}
  4477. space:=' '+space;
  4478. readrecordsymtable('fields',objdef);
  4479. Delete(space,1,4);
  4480. end;
  4481. if not EndOfEntry then
  4482. HasMoreInfos;
  4483. end;
  4484. ibfiledef :
  4485. begin
  4486. filedef:=TPpuFileDef.Create(ParentDef);
  4487. ReadCommonDef('File definition',defoptions,filedef);
  4488. write ([space,' Type : ']);
  4489. case getbyte of
  4490. 0 : begin
  4491. writeln('Text');
  4492. filedef.FileType:=ftText;
  4493. end;
  4494. 1 : begin
  4495. writeln('Typed');
  4496. filedef.FileType:=ftTyped;
  4497. write ([space,' File of Type : ']);
  4498. readderef('',filedef.TypeRef);
  4499. end;
  4500. 2 : begin
  4501. writeln('Untyped');
  4502. filedef.FileType:=ftUntyped;
  4503. end;
  4504. end;
  4505. end;
  4506. ibformaldef :
  4507. begin
  4508. def:=TPpuFormalDef.Create(ParentDef);
  4509. readcommondef('Generic definition (void-typ)',defoptions,def);
  4510. TPpuFormalDef(def).IsTyped:=(getbyte<>0);
  4511. writeln([space,' Is Typed : ',TPpuFormalDef(def).IsTyped]);
  4512. end;
  4513. ibundefineddef :
  4514. begin
  4515. def:=TPpuUndefinedDef.Create(ParentDef);
  4516. readcommondef('Undefined definition (generic parameter)',defoptions,def);
  4517. end;
  4518. ibenumdef :
  4519. begin
  4520. enumdef:=TPpuEnumDef.Create(ParentDef);
  4521. readcommondef('Enumeration type definition',defoptions,enumdef);
  4522. enumdef.ElLow:=getaint;
  4523. writeln([space,' Smallest element : ',enumdef.ElLow]);
  4524. enumdef.ElHigh:=getaint;
  4525. writeln([space,' Largest element : ',enumdef.ElHigh]);
  4526. enumdef.Size:=byte(getaint);
  4527. writeln([space,' Size : ',enumdef.Size]);
  4528. if df_copied_def in defoptions then
  4529. begin
  4530. write([space,'Base enumeration type : ']);
  4531. readderef('',enumdef.CopyFrom);
  4532. end
  4533. else
  4534. begin
  4535. space:=' '+space;
  4536. readsymtable('elements',enumdef);
  4537. delete(space,1,4);
  4538. end;
  4539. if tsystemcpu(ppufile.header.common.cpu)=cpu_jvm then
  4540. begin
  4541. write([space,' Class def : ']);
  4542. readderef('');
  4543. end;
  4544. end;
  4545. ibclassrefdef :
  4546. begin
  4547. def:=TPpuClassRefDef.Create(ParentDef);
  4548. readcommondef('Class reference definition',defoptions,def);
  4549. write ([space,' Pointed Type : ']);
  4550. readderef('',TPpuClassRefDef(def).ClassRef);
  4551. end;
  4552. ibsetdef :
  4553. begin
  4554. setdef:=TPpuSetDef.Create(ParentDef);
  4555. readcommondef('Set definition',defoptions,setdef);
  4556. write ([space,' Element type : ']);
  4557. readderef('',setdef.ElType);
  4558. setdef.Size:=getasizeint;
  4559. writeln([space,' Size : ',setdef.Size]);
  4560. setdef.SetBase:=getasizeint;
  4561. writeln([space,' Set Base : ',setdef.SetBase]);
  4562. setdef.SetMax:=getasizeint;
  4563. writeln([space,' Set Max : ',setdef.SetMax]);
  4564. end;
  4565. ibvariantdef :
  4566. begin
  4567. def:=TPpuVariantDef.Create(ParentDef);
  4568. readcommondef('Variant definition',defoptions,def);
  4569. write ([space,' Varianttype : ']);
  4570. b:=getbyte;
  4571. case tvarianttype(b) of
  4572. vt_normalvariant :
  4573. writeln('Normal');
  4574. vt_olevariant :
  4575. begin
  4576. TPpuVariantDef(def).IsOLE:=True;
  4577. writeln('OLE');
  4578. end
  4579. else
  4580. WriteWarning('Invalid varianttype: ' + IntToStr(b));
  4581. end;
  4582. end;
  4583. iberror :
  4584. begin
  4585. WriteError('!! Error in PPU');
  4586. exit;
  4587. end;
  4588. ibenddefs :
  4589. break;
  4590. else
  4591. begin
  4592. WriteError('!! Skipping unsupported PPU Entry in definitions: '+IntToStr(b));
  4593. end;
  4594. end;
  4595. if assigned(def) then
  4596. readdefsubentries(def);
  4597. if (def <> nil) and (def.Parent = nil) then
  4598. def.Free;
  4599. if not EndOfEntry then
  4600. HasMoreInfos;
  4601. until false;
  4602. end;
  4603. end;
  4604. procedure readmoduleoptions(space : string);
  4605. type
  4606. { tmoduleoption type is in unit fmodule }
  4607. tmoduleoption = (mo_none,
  4608. mo_hint_deprecated,
  4609. mo_hint_platform,
  4610. mo_hint_library,
  4611. mo_hint_unimplemented,
  4612. mo_hint_experimental,
  4613. mo_has_deprecated_msg
  4614. );
  4615. tmoduleoptions = set of tmoduleoption;
  4616. tmoduleopt=record
  4617. mask : tmoduleoption;
  4618. str : string[30];
  4619. end;
  4620. const
  4621. moduleopts=ord(high(tmoduleoption));
  4622. moduleopt : array[1..moduleopts] of tmoduleopt=(
  4623. (mask:mo_hint_deprecated; str:'Hint Deprecated'),
  4624. (mask:mo_hint_platform; str:'Hint Platform'),
  4625. (mask:mo_hint_library; str:'Hint Library'),
  4626. (mask:mo_hint_unimplemented; str:'Hint Unimplemented'),
  4627. (mask:mo_hint_experimental; str:'Hint Experimental'),
  4628. (mask:mo_has_deprecated_msg; str:'Has Deprecated Message')
  4629. );
  4630. var
  4631. moduleoptions : tmoduleoptions;
  4632. i : longint;
  4633. first : boolean;
  4634. begin
  4635. ppufile.getset(tppuset1(moduleoptions));
  4636. if moduleoptions<>[] then
  4637. begin
  4638. first:=true;
  4639. for i:=1to moduleopts do
  4640. if (moduleopt[i].mask in moduleoptions) then
  4641. begin
  4642. if first then
  4643. first:=false
  4644. else
  4645. write(', ');
  4646. write(moduleopt[i].str);
  4647. end;
  4648. end;
  4649. writeln;
  4650. if mo_has_deprecated_msg in moduleoptions then
  4651. writeln([space,'Deprecated : ', ppufile.getstring]);
  4652. end;
  4653. {****************************************************************************
  4654. Read General Part
  4655. ****************************************************************************}
  4656. procedure readinterface(silent : boolean);
  4657. var
  4658. b : byte;
  4659. sourcenumber, i : longint;
  4660. feature : tfeature;
  4661. features : tfeatures;
  4662. s : string;
  4663. begin
  4664. with ppufile do
  4665. begin
  4666. repeat
  4667. b:=readentry;
  4668. case b of
  4669. ibmodulename :
  4670. begin
  4671. CurUnit.Name:=getstring;
  4672. if not silent then
  4673. Writeln(['Module Name: ',CurUnit.Name]);
  4674. end;
  4675. ibfeatures :
  4676. begin
  4677. getset(tppuset4(features));
  4678. Writeln('Features: ');
  4679. for feature:=low(tfeatures) to high(tfeature) do
  4680. if feature in features then
  4681. begin
  4682. str(feature,s);
  4683. s:=copy(s,3,255);
  4684. writeln([s]);
  4685. end;
  4686. end;
  4687. ibmoduleoptions:
  4688. if not silent then
  4689. readmoduleoptions(' ');
  4690. ibsourcefiles :
  4691. begin
  4692. sourcenumber:=1;
  4693. if not silent then
  4694. while not EndOfEntry do
  4695. begin
  4696. with TPpuSrcFile.Create(CurUnit.SourceFiles) do begin
  4697. Name:=getstring;
  4698. i:=getlongint;
  4699. try
  4700. if i >= 0 then
  4701. FileTime:=FileDateToDateTime(i);
  4702. Writeln(['Source file ',sourcenumber,' : ',Name,' ',filetimestring(i)]);
  4703. except
  4704. end;
  4705. end;
  4706. inc(sourcenumber);
  4707. end;
  4708. end;
  4709. {$IFDEF MACRO_DIFF_HINT}
  4710. ibusedmacros :
  4711. begin
  4712. if not silent then
  4713. while not EndOfEntry do
  4714. begin
  4715. Write('Conditional ',getstring);
  4716. if getboolean then
  4717. write(' defined at startup')
  4718. else
  4719. write(' not defined at startup');
  4720. if getboolean then
  4721. writeln(' was used')
  4722. else
  4723. writeln;
  4724. end;
  4725. end;
  4726. {$ENDIF}
  4727. ibloadunit :
  4728. if not silent then
  4729. ReadLoadUnit;
  4730. iblinkunitofiles :
  4731. if not silent then
  4732. ReadLinkContainer('Link unit object file: ');
  4733. iblinkunitstaticlibs :
  4734. if not silent then
  4735. ReadLinkContainer('Link unit static lib: ');
  4736. iblinkunitsharedlibs :
  4737. if not silent then
  4738. ReadLinkContainer('Link unit shared lib: ');
  4739. iblinkotherofiles :
  4740. if not silent then
  4741. ReadLinkContainer('Link other object file: ');
  4742. iblinkotherstaticlibs :
  4743. if not silent then
  4744. ReadLinkContainer('Link other static lib: ');
  4745. iblinkothersharedlibs :
  4746. if not silent then
  4747. ReadLinkContainer('Link other shared lib: ');
  4748. iblinkotherframeworks:
  4749. if not silent then
  4750. ReadLinkContainer('Link framework: ');
  4751. ibjvmnamespace:
  4752. Writeln('JVM name space: '+getString);
  4753. ibmainname:
  4754. if not silent then
  4755. Writeln(['Specified main program symbol name: ',getstring]);
  4756. ibImportSymbols :
  4757. if not silent then
  4758. ReadImportSymbols;
  4759. ibderefdata :
  4760. ReadDerefData;
  4761. ibderefmap :
  4762. ReadDerefMap;
  4763. ibwpofile :
  4764. if not silent then
  4765. ReadWpoFileInfo;
  4766. ibresources :
  4767. if not silent then
  4768. ReadContainer('Resource file: ');
  4769. iborderedsymbols:
  4770. if not silent then
  4771. ReadContainer('Ordered symbol: ');
  4772. iberror :
  4773. begin
  4774. WriteError('Error in PPU');
  4775. exit;
  4776. end;
  4777. ibendinterface :
  4778. break;
  4779. else
  4780. begin
  4781. WriteError('!! Skipping unsupported PPU Entry in General Part: '+IntToStr(b));
  4782. end;
  4783. end;
  4784. until false;
  4785. end;
  4786. end;
  4787. {****************************************************************************
  4788. Read Implementation Part
  4789. ****************************************************************************}
  4790. procedure readimplementation;
  4791. var
  4792. b : byte;
  4793. begin
  4794. with ppufile do
  4795. begin
  4796. repeat
  4797. b:=readentry;
  4798. case b of
  4799. ibasmsymbols :
  4800. ReadAsmSymbols;
  4801. ibloadunit :
  4802. ReadLoadUnit;
  4803. ibunitimportsyms :
  4804. ReadUnitImportSyms;
  4805. iberror :
  4806. begin
  4807. WriteError('Error in PPU');
  4808. exit;
  4809. end;
  4810. ibendimplementation :
  4811. break;
  4812. else
  4813. begin
  4814. WriteError('!! Skipping unsupported PPU Entry in Implementation: '+IntToStr(b));
  4815. end;
  4816. end;
  4817. until false;
  4818. end;
  4819. end;
  4820. function parseextraheader(module: TPpuModuleDef; ppufile: tppufile): boolean;
  4821. var
  4822. b: byte;
  4823. begin
  4824. result:=false;
  4825. b:=ppufile.readentry;
  4826. if b<>ibextraheader then
  4827. exit;
  4828. CurUnit.LongVersion:=cardinal(ppufile.getlongint);
  4829. Writeln(['LongVersion: ',CurUnit.LongVersion]);
  4830. ppufile.getset(tppuset4(CurUnit.ModuleFlags));
  4831. result:=ppufile.EndOfEntry and (CurUnit.LongVersion=CurrentPPULongVersion);
  4832. if mf_symansistr in CurUnit.ModuleFlags then
  4833. SymAnsiStr:=true;
  4834. end;
  4835. procedure dofile (filename : string);
  4836. begin
  4837. { reset }
  4838. space:='';
  4839. { fix filename }
  4840. if pos('.',filename)=0 then
  4841. filename:=filename+'.ppu';
  4842. ppufile:=tppudumpfile.create(filename);
  4843. if not ppufile.openfile then
  4844. begin
  4845. WriteError('IO-Error when opening : '+filename+', Skipping');
  4846. exit;
  4847. end;
  4848. { PPU File is open, check for PPU Id }
  4849. if not ppufile.CheckPPUID then
  4850. begin
  4851. WriteError(Filename+' : Not a valid PPU file, Skipping');
  4852. exit;
  4853. end;
  4854. { Check PPU Version }
  4855. ppuversion:=ppufile.getversion;
  4856. Writeln(['Analyzing ',filename,' (v',PPUVersion,')']);
  4857. if not SkipVersionCheck and (PPUVersion <> CurrentPPUVersion) then
  4858. begin
  4859. WriteError(Format('Unsupported PPU version %d. Expecting PPU version %d.', [PPUVersion, CurrentPPUVersion]));
  4860. exit;
  4861. end;
  4862. CurUnit:=TPpuModuleDef.Create(UnitList);
  4863. CurUnit.Version:=ppuversion;
  4864. if not parseextraheader(CurUnit, ppufile) then
  4865. begin
  4866. WriteError(Format('Unsupported PPU sub-version %d. Expecting PPU sub-version %d.', [CurUnit.LongVersion, CurrentPPULongVersion]));
  4867. end;
  4868. { Write PPU Header Information }
  4869. if (verbose and v_header)<>0 then
  4870. begin
  4871. Writeln;
  4872. Writeln('Header');
  4873. Writeln('-------');
  4874. with ppufile.header do
  4875. begin
  4876. Writeln(['Compiler version : ',ppufile.header.common.compiler shr 14,'.',
  4877. (ppufile.header.common.compiler shr 7) and $7f,'.',
  4878. ppufile.header.common.compiler and $7f]);
  4879. WriteLn(['Target processor : ',Cpu2Str(common.cpu)]);
  4880. WriteLn(['Target operating system : ',Target2Str(common.target)]);
  4881. Writeln(['Unit flags : ',PPUFlags2Str(common.flags)]);
  4882. Writeln(['FileSize (w/o header) : ',common.size]);
  4883. Writeln(['Checksum : ',hexstr(checksum,8)]);
  4884. Writeln(['Interface Checksum : ',hexstr(interface_checksum,8)]);
  4885. Writeln(['Indirect Checksum : ',hexstr(indirect_checksum,8)]);
  4886. Writeln(['Definitions stored : ',tostr(deflistsize)]);
  4887. Writeln(['Symbols stored : ',tostr(symlistsize)]);
  4888. end;
  4889. end;
  4890. with ppufile.header do
  4891. begin
  4892. CurUnit.Crc:=checksum;
  4893. CurUnit.IntfCrc:=interface_checksum;
  4894. CurUnit.TargetCPU:=Cpu2Str(common.cpu);
  4895. CurUnit.TargetOS:=Target2Str(common.target);
  4896. end;
  4897. {read the general stuff}
  4898. if (verbose and v_interface)<>0 then
  4899. begin
  4900. Writeln;
  4901. Writeln('Interface section');
  4902. Writeln('------------------');
  4903. readinterface(false);
  4904. end
  4905. { We need derefdata from Interface }
  4906. else if verbose and (v_defs or v_syms or v_implementation)<>0 then
  4907. readinterface(true)
  4908. else
  4909. ppufile.skipuntilentry(ibendinterface);
  4910. Writeln;
  4911. Writeln('Interface symtable');
  4912. Writeln('----------------------');
  4913. readsymtableoptions('interface');
  4914. {read the definitions}
  4915. if (verbose and v_defs)<>0 then
  4916. begin
  4917. Writeln;
  4918. Writeln('Interface definitions');
  4919. Writeln('----------------------');
  4920. readdefinitions('interface', CurUnit);
  4921. end
  4922. else
  4923. ppufile.skipuntilentry(ibenddefs);
  4924. {read the symbols}
  4925. if (verbose and v_syms)<>0 then
  4926. begin
  4927. Writeln;
  4928. Writeln('Interface Symbols');
  4929. Writeln('------------------');
  4930. readsymbols('interface',CurUnit);
  4931. end
  4932. else
  4933. ppufile.skipuntilentry(ibendsyms);
  4934. {read the macro symbols}
  4935. if (verbose and v_syms)<>0 then
  4936. begin
  4937. Writeln;
  4938. Writeln('Interface Macro Symbols');
  4939. Writeln('-----------------------');
  4940. end;
  4941. if ppufile.readentry<>ibexportedmacros then
  4942. begin
  4943. WriteError('!! Error in PPU');
  4944. exit;
  4945. end;
  4946. if ppufile.getboolean then
  4947. begin
  4948. readsymtableoptions('interface macro');
  4949. {skip the definition section for macros (since they are never used) }
  4950. ppufile.skipuntilentry(ibenddefs);
  4951. {read the macro symbols}
  4952. if (verbose and v_syms)<>0 then
  4953. readsymbols('interface macro')
  4954. else
  4955. ppufile.skipuntilentry(ibendsyms);
  4956. end
  4957. else
  4958. Writeln('(no exported macros)');
  4959. {read the implementation stuff}
  4960. if (verbose and v_implementation)<>0 then
  4961. begin
  4962. Writeln;
  4963. Writeln('Implementation section');
  4964. Writeln('-----------------------');
  4965. readimplementation;
  4966. end
  4967. else
  4968. ppufile.skipuntilentry(ibendimplementation);
  4969. {read the static symtable}
  4970. Writeln;
  4971. Writeln('Implementation symtable');
  4972. Writeln('----------------------');
  4973. readsymtableoptions('implementation');
  4974. if (mf_local_symtable in CurUnit.ModuleFlags) then
  4975. begin
  4976. if (verbose and v_defs)<>0 then
  4977. begin
  4978. Writeln;
  4979. Writeln('Static definitions');
  4980. Writeln('----------------------');
  4981. readdefinitions('implementation', nil);
  4982. end
  4983. else
  4984. ppufile.skipuntilentry(ibenddefs);
  4985. {read the symbols}
  4986. if (verbose and v_syms)<>0 then
  4987. begin
  4988. Writeln;
  4989. Writeln('Static Symbols');
  4990. Writeln('------------------');
  4991. readsymbols('implementation');
  4992. end
  4993. else
  4994. ppufile.skipuntilentry(ibendsyms);
  4995. end;
  4996. ReadCreatedObjTypes;
  4997. FreeDerefdata;
  4998. {shutdown ppufile}
  4999. ppufile.closefile;
  5000. ppufile.free;
  5001. Writeln;
  5002. end;
  5003. procedure WriteLogo;
  5004. begin
  5005. writeln(Title+' Version '+version_string);
  5006. writeln(Copyright);
  5007. writeln;
  5008. end;
  5009. procedure help;
  5010. begin
  5011. WriteLogo;
  5012. writeln('usage: ppudump [options] <filename1> <filename2>...');
  5013. writeln;
  5014. writeln('[options] can be:');
  5015. writeln(' -F<format> Set output format to <format>');
  5016. writeln(' t - text format (default)');
  5017. writeln(' j - JSON format');
  5018. writeln(' x - XML format');
  5019. writeln(' -M Exit with ExitCode=2 if more information is available');
  5020. writeln(' -S Skip PPU version check. May lead to reading errors');
  5021. writeln(' -V<verbose> Set verbosity to <verbose>');
  5022. writeln(' H - Show header info');
  5023. writeln(' I - Show interface');
  5024. writeln(' M - Show implementation');
  5025. writeln(' S - Show interface symbols');
  5026. writeln(' D - Show interface definitions');
  5027. writeln(' A - Show all');
  5028. writeln(' -h, -? This helpscreen');
  5029. halt;
  5030. end;
  5031. var
  5032. startpara,
  5033. nrfile,i : longint;
  5034. para : string;
  5035. const
  5036. error_on_more : boolean = false;
  5037. begin
  5038. if paramcount<1 then
  5039. help;
  5040. { turn verbose on by default }
  5041. verbose:=v_all;
  5042. { read options }
  5043. startpara:=1;
  5044. while copy(paramstr(startpara),1,1)='-' do
  5045. begin
  5046. para:=paramstr(startpara);
  5047. case upcase(para[2]) of
  5048. 'F' : begin
  5049. FreeAndNil(pout);
  5050. if Length(para) > 2 then
  5051. case upcase(para[3]) of
  5052. 'T':
  5053. nostdout:=False;
  5054. 'J':
  5055. begin
  5056. nostdout:=True;
  5057. pout:=TPpuJsonOutput.Create(StdOutputHandle);
  5058. end;
  5059. 'X':
  5060. begin
  5061. nostdout:=True;
  5062. pout:=TPpuXmlOutput.Create(StdOutputHandle);
  5063. end;
  5064. else
  5065. begin
  5066. WriteError('Invalid output format: ' + para[3]);
  5067. Halt(1);
  5068. end;
  5069. end;
  5070. end;
  5071. 'M' : error_on_more:=true;
  5072. 'S' : SkipVersionCheck:=True;
  5073. 'V' : begin
  5074. verbose:=0;
  5075. for i:=3 to length(para) do
  5076. case upcase(para[i]) of
  5077. 'H' : verbose:=verbose or v_header;
  5078. 'I' : verbose:=verbose or v_interface;
  5079. 'M' : verbose:=verbose or v_implementation;
  5080. 'D' : verbose:=verbose or v_defs;
  5081. 'S' : verbose:=verbose or v_syms;
  5082. 'A' : verbose:=verbose or v_all;
  5083. end;
  5084. end;
  5085. 'H' : help;
  5086. '?' : help;
  5087. else
  5088. begin
  5089. WriteError('Invalid option: ' + para);
  5090. Halt(1);
  5091. end;
  5092. end;
  5093. inc(startpara);
  5094. end;
  5095. if not nostdout then
  5096. WriteLogo;
  5097. UnitList:=TPpuContainerDef.Create(nil);
  5098. try
  5099. UnitList.ItemsName:='';
  5100. { process files }
  5101. for nrfile:=startpara to paramcount do
  5102. dofile (paramstr(nrfile));
  5103. if not has_errors and (pout <> nil) then
  5104. begin
  5105. pout.Init;
  5106. UnitList.Write(pout);
  5107. pout.Done;
  5108. end;
  5109. finally
  5110. UnitList.Free;
  5111. pout.Free;
  5112. end;
  5113. if has_errors then
  5114. Halt(1);
  5115. if error_on_more and
  5116. (has_more_infos or has_warnings) then
  5117. Halt(2);
  5118. end.