ppudump.pp 165 KB

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