ppudump.pp 170 KB

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