1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553 |
- MODULE Release; (** AUTHOR "staubesv"; PURPOSE "Release build tool"; *)
- (**
- *
- * Usage:
- *
- * Release.Analyze [Options] ~ analyzes the package description file
- *
- * Option f, file : Package description file to be analyzed [default: Release.Tool]
- *
- * Release.CheckFiles [Options] filemask ~ lists all files that match to filemask but are not listed in the package description file
- *
- * Option f, file : Package description file to be analyzed [default: Release.Tool]
- *
- * Release.Check [Options] ~ builds all builds described in the package description file to a RAM disk
- *
- * Option f, file : Specify the package description file [default: Release.Tool]
- *
- * Release.Build [Options] BuildName ~
- *
- * Option b, build : Compile the specified build (otherwise, open Notepad with compile command)
- * Option c,compiler : Override compiler specified in the package description file
- * Option exclude : Exclude packages (specified as space separated list of package names)
- * Option e, extension : Override the extension option specified in the package description file
- * Option f, file : Specify the package description file [default: Release.Tool]
- * Option n, nocheck : Skip file existence and import order checks
- * Option o, options : Override the compiler options specified in the package description file
- * Option only : Only compile the packages provided in a list. No other effect applies
- i.e. packages are fully taken into account otherwise.
- if packages need to be excluded, use exclude instead
- * Option p, path : Override the path option specified in the package description file
- * Option s, symbolFileExtension : Ovveride the symbolFileExtension option specified in the package description file
- * Option t, target : Override the target option specified in the package description file
- * Option v, verbose : Show compiler output (only useful in combination with option --build)
- * Option w, workers : Number of worker threads for parallel compilation
- * Option x, xml : Generate XML package description file needed by WMInstaller.Mod
- * Option z, zip : Generate ZIP file for each package (for now, only together with --build option)
- *
- * Argument BuildName: Name of build to be built
- *
- * Release.FindPosition [Options] BuildName FileName ~ finds the first position in the package description file
- * where the specified file could be inserted (compile order)
- *
- * Option f, file : Specify the package description file [default: Release.Tool]
- *
- *
- * System.Free Release ~
- *
- * Based on Release.Mod by pjm
- *
- *
- * BuildDescription = Header Import BuildSection Packages
- * BuildSection = BUILDS {Build} END
- * Build = buildName OPENSECTION {BuildParameter} CLOSESECTION
- * Build = INCLUDE '"' [buildprefix {" " buildprefix} ] '"' |
- * COMPILER '"' compileCommand '"' | COMPILEROPTIONS '"' compileOptions '"' |
- * LINKER '"' linkCommand '"' | LINKEROPTIONS '"' linkOptions '"' |
- * TARGET '"' target '"' |
- * EXTENSION '"' objectFileExtension '"' | PATH '"' objectFilePath '"' |
- * EXCLUDEPACKAGES '"' [ exludedPackage {" " excludedPackage} ] '"'
- * DISABLED "TRUE" | "FALSE"
- *
- * Packages = { PackageSpec FileList }
- * PackageSpec = PACKAGE packageName ARCHIVE ArchiveName SOURCE SourceName ENDSECTION
- * FileList = { Filename | ReleaseSpec OPENSECTION [ {filename } ] CLOSESECTION }
- * ReleaseSpec = ReleaseName [ { SEPARATOR ReleaseName } ]
- *)
- IMPORT
- Modules, Streams, Commands, Options, Files, Dates, Strings, Texts, TextUtilities, ReleaseThreadPool, Diagnostics, WMGraphics, Zip,
- CompilerInterface, Compiler, SyntaxTree := FoxSyntaxTree ;
- CONST
- VersionMajor = 1;
- VersionMinor = 0;
- DefaultPackagesFile = "Release.Tool";
- (* Default build settings *)
- DefaultCompiler = "Compiler.Compile";
- DefaultCompileOptions = "";
- DefaultTarget = "" (* default chosen by compiler *);
- DefaultExtension = ""; (* default chosen by compiler *)
- DefaultSymbolFileExtension = ""; (* default chosen by compiler *)
- DefaultPath = "";
- DefaultDisabled = FALSE;
- (** If the prefix of a filename Prefix.Mid.Suffix matches <ReleasePrefix>, both Prefix.Mid.Suffix and Mid.Suffix will be
- included in the archive package. This is only valid for files that do not have the extension (Suffix) Mod *)
- ReleasePrefix = "Release";
- ToolFilename = "CompileCommand.Tool";
- InstallerPackageFile = "InstallerPackages.XML";
- DateTimeFormat = "wwww, mmmm d, yyyy hh:nn:ss";
- NoFile = -1;
- NoPackages = -2;
- (* Load Oberon text files ignoring text format *)
- OptimizedLoads = TRUE;
- (* If set to TRUE, the file references are re-used for different steps of the build process *)
- KeepFilesOpen = FALSE;
- (* File.flags *)
- ImportsSystem = 0;
- SourceCode = 1;
- HasReleasePrefix = 2; (* filename has prefix <ReleasePrefix> *)
- (* Package.installMode *)
- Undefined = 0;
- Required = 1; (* package must be installed *)
- Yes = 2; (* per default, install package *)
- No = 3; (* per default, don't install package *)
- (* File.release*)
- MaxBuilds = 128;
- MaxPrefixes = 128;
- MaxNofImports = 128; (* Maximum number of entries in a module import section *)
- Tab = 9X;
- Mode_ShowImported = 0;
- Mode_ShowImporting = 1;
- SetSize = MAX(SET)+1;
- TYPE
- Name = ARRAY 72 OF CHAR;
- Set = ARRAY (MaxPrefixes-1) DIV SetSize + 1 OF SET;
- TYPE
- Statistic = RECORD
- nofFiles : LONGINT;
- nofSources : LONGINT;
- END;
- Statistics = OBJECT
- VAR
- stats : ARRAY MaxPrefixes OF Statistic;
- (* Total number of files and sources *)
- nofFiles : LONGINT;
- nofSources : LONGINT;
- (* Number of files and sources that are contained in all releases *)
- nofFilesAll : LONGINT;
- nofSourcesAll : LONGINT;
- PROCEDURE Get(VAR nofFiles, nofSources : LONGINT; CONST release : Set);
- VAR i : LONGINT;
- BEGIN
- nofFiles := 0; nofSources := 0;
- FOR i := 0 TO MaxPrefixes-1 DO
- IF In(release, i) THEN
- nofFiles := nofFiles + stats[i].nofFiles;
- nofSources := nofSources + stats[i].nofSources;
- END;
- END;
- END Get;
- PROCEDURE AddFile(file : File);
- VAR i : LONGINT;
- BEGIN
- INC(nofFiles);
- IF file.IsSourceCode() THEN INC(nofSources); END;
- IF file.release # NIL THEN
- FOR i := 0 TO MaxPrefixes-1 DO
- IF (file.release = NIL) OR file.release.Has(i) THEN
- INC(stats[i].nofFiles);
- IF file.IsSourceCode() THEN INC(stats[i].nofSources); END;
- END;
- END;
- ELSE
- INC(nofFilesAll);
- IF file.IsSourceCode() THEN INC(nofSourcesAll); END;
- END;
- END AddFile;
- PROCEDURE &Reset;
- VAR i : LONGINT;
- BEGIN
- nofFiles := 0;
- nofSources := 0;
- FOR i := 0 TO LEN(stats)-1 DO
- stats[i].nofFiles := 0;
- stats[i].nofSources := 0;
- END;
- END Reset;
- END Statistics;
- TYPE
- ExpressionModel = ENUM Prefix, Not, And, Or END;
- Expression = OBJECT
- VAR model: ExpressionModel;
- VAR index: LONGINT;
- VAR left, right: Expression;
- PROCEDURE Test (CONST set: Set): BOOLEAN;
- BEGIN
- CASE model OF
- | ExpressionModel.Prefix:
- RETURN In(set, index);
- | ExpressionModel.Not:
- RETURN ~left.Test (set);
- | ExpressionModel.And:
- RETURN left.Test (set) & right.Test (set);
- | ExpressionModel.Or:
- RETURN left.Test (set) OR right.Test (set);
- END;
- END Test;
- PROCEDURE Has(index: LONGINT): BOOLEAN;
- BEGIN
- CASE model OF
- | ExpressionModel.Prefix:
- RETURN SELF.index = index;
- | ExpressionModel.Not:
- RETURN ~left.Has (index);
- | ExpressionModel.And:
- RETURN left.Has (index) & right.Has (index);
- | ExpressionModel.Or:
- RETURN left.Has (index) OR right.Has (index);
- END;
- END Has;
- END Expression;
- (* The bitmap is used to analyze dependencies between modules *)
- Bitmap = OBJECT
- VAR
- map : POINTER TO ARRAY OF SET;
- size : LONGINT;
- PROCEDURE IsSet(bit : LONGINT) : BOOLEAN;
- BEGIN
- ASSERT(( 0 <= bit) & (bit < size));
- RETURN (bit MOD SIZEOF(SET)) IN map[bit DIV SIZEOF(SET)];
- END IsSet;
- PROCEDURE Set(bit : LONGINT);
- BEGIN
- ASSERT((0 <= bit) & (bit < size));
- INCL(map[bit DIV SIZEOF(SET)], bit MOD SIZEOF(SET));
- END Set;
- PROCEDURE NofBitsSet() : LONGINT;
- VAR nofBitsSet, index, subindex : LONGINT;
- BEGIN
- nofBitsSet := 0;
- FOR index := 0 TO LEN(map)-1 DO
- FOR subindex := 0 TO SIZEOF(SET)-1 DO
- IF subindex IN map[index] THEN INC(nofBitsSet); END;
- END;
- END;
- RETURN nofBitsSet;
- END NofBitsSet;
- PROCEDURE Union(bitmap : Bitmap);
- VAR i : LONGINT;
- BEGIN
- ASSERT((bitmap # NIL) & (bitmap.size = size));
- FOR i := 0 TO LEN(map)-1 DO
- map[i] := map[i] + bitmap.map[i];
- END;
- END Union;
- PROCEDURE &Init(size : LONGINT);
- VAR i : LONGINT;
- BEGIN
- ASSERT(size > 0);
- SELF.size := size;
- NEW(map, (size + SIZEOF(SET)-1) DIV SIZEOF(SET));
- FOR i := 0 TO LEN(map)-1 DO map[i] := {}; END;
- END Init;
- END Bitmap;
- TYPE
- Package* = OBJECT
- VAR
- name-, archive-, source- : ARRAY 32 OF CHAR;
- description- : ARRAY 256 OF CHAR;
- installMode : LONGINT; (* Required, Yes, No *)
- nofFiles- : LONGINT;
- nofSources- : LONGINT;
- position- : LONGINT;
- next : Package;
- PROCEDURE &Init(CONST name, archive, source, description : ARRAY OF CHAR; position : LONGINT);
- BEGIN
- COPY(name, SELF.name);
- COPY(archive, SELF.archive);
- COPY(source, SELF.source);
- COPY(description, SELF.description);
- SELF.position := position;
- installMode := Undefined;
- nofFiles := 0;
- nofSources := 0;
- position := -1;
- next := NIL;
- END Init;
- END Package;
- TYPE
- PackageArray* = POINTER TO ARRAY OF Package;
- PackageList* = OBJECT
- VAR
- head, tail : Package;
- nofPackages : LONGINT;
- (* Find the package with the specified name. Returns NIL if package not found *)
- PROCEDURE FindPackage(CONST name : ARRAY OF CHAR) : Package;
- VAR package : Package;
- BEGIN
- package := head.next;
- WHILE (package # NIL) & (package.name # name) DO package := package.next; END;
- RETURN package;
- END FindPackage;
- (* Add package to list. Returns FALSE if a package in the list has the same name *)
- PROCEDURE Add(package : Package) : BOOLEAN;
- BEGIN
- ASSERT((package # NIL) & (package.next = NIL));
- IF FindPackage(package.name) = NIL THEN
- tail.next := package;
- tail := package;
- INC(nofPackages);
- RETURN TRUE;
- ELSE
- RETURN FALSE;
- END;
- END Add;
- PROCEDURE GetAll*() : PackageArray;
- VAR packageArray : PackageArray; package : Package; i : LONGINT;
- BEGIN
- IF (nofPackages > 0) THEN
- NEW(packageArray, nofPackages);
- package := head.next;
- i := 0;
- WHILE (i < nofPackages) DO
- packageArray[i] := package;
- package := package.next;
- INC(i);
- END;
- ELSE
- packageArray := NIL;
- END;
- RETURN packageArray;
- END GetAll;
- PROCEDURE ToStream(out : Streams.Writer);
- VAR package : Package; nofPackages : LONGINT;
- BEGIN
- ASSERT(out # NIL);
- out.String("Packages: "); out.Ln;
- nofPackages := 0;
- package := head.next;
- WHILE (package # NIL) DO
- out.String(" "); out.String(package.name); out.Int(package.nofFiles, 4);
- out.String(" Files ("); out.Int(package.nofSources, 4); out.String(" source code files)"); out.Ln;
- INC(nofPackages);
- package := package.next;
- END;
- out.String(" "); out.Int(nofPackages, 0); out.String(" packages"); out.Ln;
- END ToStream;
- PROCEDURE &Init;
- BEGIN
- NEW(head, "Head", "", "", "", -1);
- tail := head;
- nofPackages := 0;
- END Init;
- END PackageList;
- TYPE
- ModuleInfo = RECORD
- name, context : Name;
- imports : ARRAY MaxNofImports OF Name; (* directly imported modules *)
- nofImports : LONGINT;
- flags : SET;
- isParsed : BOOLEAN;
- END;
- TYPE
- File* = OBJECT
- VAR
- module : ModuleInfo; (* if source code *)
- name-, uppercaseName : Files.FileName;
- doCompile : BOOLEAN;
- (* When using array indexes instead of names *)
- index : LONGINT; (* position of this File object in array *)
- importIndices : ARRAY MaxNofImports OF LONGINT;
- (* number of modules that directly or indirectly import this module *)
- nofDependentModules : LONGINT;
- (* number of modules directly or indirectly imported by this module *)
- nofRequiredModules : LONGINT;
- (* job ID in case of using the thread pool for parallel compilation of modules *)
- jobID : LONGINT;
- package- : Package;
- options: ARRAY 8 OF CHAR;
- release- : Expression;
- flags-: SET;
- file : Files.File;
- pos : LONGINT; (* Position in package description file *)
- builds : Builds;
- prev-, next- : File;
- PROCEDURE &Init(builds : Builds);
- VAR i : LONGINT;
- BEGIN
- ASSERT(builds # NIL);
- SELF.builds := builds;
- module.name := ""; module.context := "";
- FOR i := 0 TO LEN(module.imports)-1 DO module.imports[i] := ""; END;
- module.nofImports := 0;
- module.flags := {};
- module.isParsed := FALSE;
- COPY("", name);
- doCompile := TRUE;
- package := NIL;
- COPY("", options);
- release := NIL;
- flags := {};
- file := NIL;
- pos := 0;
- prev := NIL; next := NIL;
- END Init;
- PROCEDURE IsInRelease*(CONST release : Set) : BOOLEAN;
- BEGIN
- RETURN (SELF.release = NIL) OR SELF.release.Test (release);
- END IsInRelease;
- PROCEDURE IsSourceCode*() : BOOLEAN;
- BEGIN
- RETURN SourceCode IN flags;
- END IsSourceCode;
- PROCEDURE CheckImports*(diagnostics : Diagnostics.Diagnostics; build : BuildObj; VAR error : BOOLEAN);
- VAR file : File; i : LONGINT; temp, message : ARRAY 256 OF CHAR;
- BEGIN
- ASSERT((diagnostics # NIL) & (build # NIL));
- error := FALSE;
- FOR i := 0 TO module.nofImports-1 DO
- file := prev;
- LOOP
- IF (file = NIL) THEN EXIT; END;
- IF (file.module.name = module.imports[i]) & file.IsInRelease(build.include) & ~build.PackageIsExcluded(file.package) THEN (* found *) EXIT; END;
- file := file.prev;
- END;
- IF (file = NIL) THEN
- error := TRUE;
- COPY(build.name, temp);
- Strings.Append(temp, ": Import # not found in file #");
- MakeMessage(message, temp, module.imports[i], name);
- diagnostics.Error(builds.source, pos, message);
- END;
- END;
- END CheckImports;
- PROCEDURE ParseModule*(diagnostics : Diagnostics.Diagnostics);
- VAR
- reader : Streams.Reader;
- pre, mid, suf: Files.FileName;
- message : ARRAY 256 OF CHAR;
- error : BOOLEAN;
- BEGIN
- IF module.isParsed OR ~IsSourceCode() THEN RETURN; END;
- reader := GetReader(SELF, diagnostics);
- IF (reader # NIL) THEN
- GetModuleInfo(reader, module, builds.source, name, pos, diagnostics, error);
- IF ~error THEN
- module.isParsed := TRUE;
- flags := flags + module.flags;
- SplitName(name, pre, mid, suf);
- IF (module.name # mid) THEN
- MakeMessage(message, "Module name not equal to filename in #", name, "");
- diagnostics.Warning(builds.source, pos, message);
- END;
- CreateContext(module.name, module.context);
- END;
- END;
- END ParseModule;
- PROCEDURE Show*(w : Streams.Writer);
- BEGIN
- w.String(name);
- END Show;
- END File;
- TYPE
- WorkerParameters = OBJECT
- VAR
- file : File;
- diagnostics : Diagnostics.Diagnostics;
- importCache : SyntaxTree.ModuleScope;
- PROCEDURE &Init(file : File; diagnostics : Diagnostics.Diagnostics; importCache : SyntaxTree.ModuleScope);
- BEGIN
- ASSERT((file # NIL) & (diagnostics # NIL) & (importCache # NIL));
- SELF.file := file;
- SELF.diagnostics := diagnostics;
- SELF.importCache := importCache;
- END Init;
- END WorkerParameters;
- TYPE
- BuildObj* = OBJECT
- VAR
- name- : Name;
- prefixes : ARRAY MaxPrefixes OF Name;
- excludedPackages : Strings.StringArray;
- onlyPackages: Strings.StringArray;
- compileOptions, linkOptions: Options.Parameter;
- compiler, linker: ARRAY 128 OF CHAR;
- target : ARRAY 32 OF CHAR;
- extension : ARRAY 8 OF CHAR;
- symbolFileExtension : ARRAY 8 OF CHAR;
- path : Files.FileName;
- disabled : BOOLEAN;
- link: BOOLEAN; (* link packages instead of compiling *)
- (* Used for dependencies analysis *)
- modules : POINTER TO ARRAY OF File;
- bitmap : POINTER TO ARRAY OF Bitmap;
- marked : BOOLEAN; (* Used by Check command *)
- (* List of all files and packages declared in the package description file *)
- files : File;
- packages : PackageList;
- (* Name of the package description file *)
- builds : Builds;
- include : Set;
- position- : LONGINT;
- PROCEDURE &Init;
- VAR i : LONGINT;
- BEGIN
- COPY("", name);
- FOR i := 0 TO LEN(prefixes)-1 DO prefixes[i] := ""; END;
- excludedPackages := NIL;
- onlyPackages := NIL;
- COPY(DefaultCompiler, compiler);
- COPY(DefaultCompileOptions, compileOptions);
- COPY(DefaultTarget, target);
- COPY(DefaultExtension, extension);
- COPY(DefaultSymbolFileExtension, symbolFileExtension);
- COPY(DefaultPath, path);
- disabled := DefaultDisabled;
- modules := NIL; bitmap := NIL;
- marked := FALSE;
- files := NIL;
- packages := NIL;
- builds := NIL;
- SetEmpty(include);
- position := -1;
- END Init;
- PROCEDURE CompileThisPackage(package: Package): BOOLEAN;
- VAR i : LONGINT;
- BEGIN
- IF (onlyPackages # NIL) THEN
- FOR i := 0 TO LEN(onlyPackages)-1 DO
- IF (package.name = onlyPackages[i]^) THEN
- RETURN TRUE
- END;
- END;
- RETURN FALSE
- END;
- RETURN TRUE
- END CompileThisPackage;
- PROCEDURE PackageIsExcluded(package : Package) : BOOLEAN;
- VAR i : LONGINT;
- BEGIN
- IF (package = NIL) THEN RETURN FALSE; END;
- IF (excludedPackages # NIL) THEN
- FOR i := 0 TO LEN(excludedPackages)-1 DO
- IF (package.name = excludedPackages[i]^) THEN
- RETURN TRUE;
- END;
- END;
- END;
- RETURN FALSE;
- END PackageIsExcluded;
- PROCEDURE SetOptions(options : Options.Options);
- VAR string : ARRAY 512 OF CHAR;
- BEGIN
- ASSERT(options # NIL);
- IF (options # NIL) THEN
- link := options.GetFlag("link");
- IF options.GetString("compiler", compiler) THEN END;
- IF link THEN
- IF options.GetString("options", linkOptions) THEN END;
- ELSE
- IF options.GetString("options", compileOptions) THEN END;
- END;
- IF options.GetString("target", target) THEN END;
- IF options.GetString("extension", extension) THEN END;
- IF options.GetString("symbolFileExtension", symbolFileExtension) THEN END;
- IF options.GetString("path", path) THEN END;
- IF options.GetString("exclude", string) THEN
- Strings.TrimWS(string);
- excludedPackages := Strings.Split(string, " ");
- END;
- IF options.GetString("only",string) THEN
- Strings.TrimWS(string);
- onlyPackages := Strings.Split(string, " ");
- END;
- END;
- END SetOptions;
- (** List all source code files included in this build to a stream *)
- PROCEDURE ToStream*(w : Streams.Writer; charactersPerLine : LONGINT);
- VAR file : File; color : LONGINT; characterCount : LONGINT; name: Files.FileName;
- BEGIN
- characterCount := 0;
- file := files;
- WHILE (file # NIL) DO
- IF file.IsSourceCode() & file.IsInRelease(include) & ~PackageIsExcluded(file.package) & file.doCompile & CompileThisPackage(file.package) THEN
- IF (w IS TextUtilities.TextWriter) THEN
- IF (ImportsSystem IN file.flags) THEN
- color := WMGraphics.Red;
- ELSE
- color := WMGraphics.Black;
- END;
- w(TextUtilities.TextWriter).SetFontColor(color);
- END;
- IF link THEN
- COPY(file.module.name, name)
- ELSE
- COPY(file.name, name)
- END;
- characterCount := characterCount + Strings.Length(name);
- IF (characterCount > charactersPerLine) THEN
- characterCount := 0;
- w.Ln;
- END;
- w.String(name); w.String(" ");
- END;
- file := file.next;
- END;
- IF (w IS TextUtilities.TextWriter) THEN
- w(TextUtilities.TextWriter).SetFontColor(WMGraphics.Black);
- END;
- w.Update;
- END ToStream;
- (** Generate a file that contains the list of all source code files of this build in compile order *)
- PROCEDURE GenerateToolFile*(CONST filename : Files.FileName; VAR res : WORD);
- VAR text : Texts.Text; tw : TextUtilities.TextWriter; dateTime : Dates.DateTime; temp : ARRAY 256 OF CHAR;
- BEGIN
- NEW(text); NEW(tw, text);
- tw.SetFontColor(LONGINT(808080FFH)); (* comment grey *)
- tw.String("# "); tw.String(name); tw.Ln;
- dateTime := Dates.Now();
- Strings.FormatDateTime(DateTimeFormat, dateTime, temp);
- tw.String("# "); tw.String(temp); tw.Ln;
- tw.String("# This file has been automatically generated using Release.Mod."); tw.Ln;
- tw.String("# Red colors indicate that a module imports SYSTEM."); tw.Ln;
- tw.SetFontColor(WMGraphics.Black);
- (* Compile command *)
- tw.SetFontStyle({WMGraphics.FontBold});
- tw.String("System.DoCommands"); tw.Ln;
- tw.SetFontStyle({});
- tw.String("System.Timer start ~"); tw.Ln;
- IF link THEN
- tw.String(linker);
- GetLinkerOptions(temp);
- ELSE
- tw.String(compiler);
- GetCompilerOptions(temp);
- END;
- tw.String(" "); tw.String(temp); tw.Ln;
- ToStream(tw, 80); (* file list *) tw.Ln; tw.String("~"); tw.Ln;
- tw.String("System.Show Time elapsed: ~ System.Ln ~"); tw.Ln;
- tw.String("System.Timer elapsed ~ System.Ln ~"); tw.Ln;
- tw.String("~");
- tw.Update;
- TextUtilities.StoreOberonText(text, filename, res);
- END GenerateToolFile;
- (* Generate a XML file describing the packages use by WMInstaller.Mod *)
- PROCEDURE GeneratePackageFile(CONST filename : ARRAY OF CHAR; VAR res : WORD);
- VAR
- packageArray : PackageArray; package : Package;
- fullname : Files.FileName; file : Files.File; w : Files.Writer;
- packageNbr, i : LONGINT;
- PROCEDURE WritePackage(package : Package; sources : BOOLEAN; packageNbr : LONGINT; w : Streams.Writer);
- VAR filename : Files.FileName; description : ARRAY 300 OF CHAR; name, installMode : ARRAY 128 OF CHAR;
- BEGIN
- ASSERT((package # NIL) & (w # NIL));
- COPY(package.description, description);
- IF sources THEN
- COPY(package.name, name); Strings.Append(name, " Sources");
- COPY(package.source, filename); Strings.Append(description, " sources");
- ELSE
- COPY(package.name, name);
- COPY(package.archive, filename);
- END;
- w.Char(Tab);
- w.String('<Package nr="'); w.Int(packageNbr, 0);
- w.String('" name="'); w.String(name);
- w.String('" file="'); w.String(filename);
- w.String('" description="'); w.String(description);
- IF (package.installMode = Required) THEN installMode := "required";
- ELSIF (package.installMode = Yes) THEN installMode := "yes";
- ELSIF (package.installMode = No) THEN installMode := "no";
- ELSE installMode := "undefined";
- END;
- w.String('" install="'); w.String(installMode); w.String('"/>'); w.Ln;
- END WritePackage;
- BEGIN
- res := Files.Ok;
- packageArray := packages.GetAll();
- IF (packageArray # NIL) THEN
- COPY(path, fullname); Strings.Append(fullname, filename);
- file := Files.New(fullname);
- IF (file # NIL) THEN
- packageNbr := 1;
- Files.OpenWriter(w, file, 0);
- w.String('<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'); w.Ln; w.Ln;
- w.String("<!-- This has been automatically generated by Release.Mod -->"); w.Ln; w.Ln;
- w.String("<Packages>"); w.Ln;
- FOR i := 0 TO LEN(packageArray)-1 DO
- package := packageArray[i];
- IF ~PackageIsExcluded(package) THEN
- WritePackage(package, FALSE, packageNbr, w);
- INC(packageNbr);
- IF (package.source # "") THEN
- WritePackage(package, TRUE, packageNbr, w);
- INC(packageNbr);
- END;
- END;
- END;
- w.String("</Packages>"); w.Ln; w.Update;
- Files.Register(file);
- ELSE
- res := NoFile;
- END;
- ELSE
- res := NoPackages;
- END;
- END GeneratePackageFile;
- PROCEDURE GenerateZipFiles(out, error : Streams.Writer; diagnostics : Diagnostics.Diagnostics; VAR err : BOOLEAN);
- VAR packageArray : PackageArray; i, res : LONGINT;
- PROCEDURE AddFile(archive: Zip.Archive; CONST srcname, dstname: ARRAY OF CHAR; VAR res: WORD);
- VAR f: Files.File; r: Files.Rider; pathName, fileName: Files.FileName;
- BEGIN
- f := Files.Old(srcname);
- IF f = NIL THEN
- res := Zip.BadName
- ELSE
- f.Set(r, 0);
- Files.SplitPath(dstname, pathName, fileName);
- Zip.AddEntry(archive, fileName, r, f.Length(), 9, 2, res);
- END;
- END AddFile;
- PROCEDURE DeleteFile(filename : ARRAY OF CHAR; VAR nofFilesDeleted : LONGINT);
- VAR file : Files.File;
- BEGIN
- file := Files.Old(filename);
- IF (file # NIL) THEN
- Files.Delete(filename, res);
- IF (res = Files.Ok) THEN
- INC(nofFilesDeleted);
- ELSE
- out.String(" could not delete existing file, res: "); out.Int(res, 0); out.Ln;
- END;
- END;
- END DeleteFile;
- PROCEDURE GetObjectFileName(file : File; CONST prefix : ARRAY OF CHAR; VAR fileName: ARRAY OF CHAR);
- BEGIN
- COPY(prefix, fileName);
- Strings.Append(fileName, file.module.name);
- Strings.Append(fileName, ".");
- Strings.Append(fileName, extension);
- END GetObjectFileName;
- PROCEDURE GetSymbolFileName(file : File; CONST prefix : ARRAY OF CHAR; VAR fileName : ARRAY OF CHAR);
- BEGIN
- COPY(prefix, fileName);
- Strings.Append(fileName, file.module.name);
- Strings.Append(fileName, ".");
- Strings.Append(fileName, symbolFileExtension);
- END GetSymbolFileName;
- PROCEDURE GetPackageFileName(package : Package; sourceCode : BOOLEAN; VAR filename : ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- ASSERT(package # NIL);
- COPY(path, filename);
- IF ~sourceCode THEN
- Strings.Append(filename, package.archive);
- ELSE
- Strings.Append(filename, package.source);
- END;
- RETURN (filename # path);
- END GetPackageFileName;
- PROCEDURE DeleteOldZipFiles(packageArray : PackageArray);
- VAR filename : Files.FileName; nofFilesDeleted, i : LONGINT;
- BEGIN
- ASSERT(packageArray # NIL);
- out.String("Deleting old archive files ... "); out.Update;
- nofFilesDeleted := 0;
- FOR i := 0 TO LEN(packageArray)-1 DO
- IF GetPackageFileName(packageArray[i], TRUE, filename) THEN DeleteFile(filename, nofFilesDeleted); END;
- IF GetPackageFileName(packageArray[i], FALSE, filename) THEN DeleteFile(filename, nofFilesDeleted); END;
- END;
- out.Int(nofFilesDeleted, 0); out.String(" files deleted."); out.Ln;
- END DeleteOldZipFiles;
- PROCEDURE StripReleasePrefix(file : File; VAR filename: ARRAY OF CHAR);
- VAR pre, mid, suf : Files.FileName;
- BEGIN
- SplitName(file.name, pre, mid, suf);
- ASSERT(pre = ReleasePrefix);
- COPY (mid, filename); Strings.Append(filename, "."); Strings.Append(filename, suf);
- END StripReleasePrefix;
- PROCEDURE GenerateZipFile(package : Package; sourceCode : BOOLEAN; VAR res : WORD);
- VAR
- file : File; archiveName, source, dest : Files.FileName;
- archive : Zip.Archive;
- nofFilesAdded : LONGINT;
- BEGIN
- ASSERT(package # NIL);
- res := Zip.Ok;
- IF GetPackageFileName(package, sourceCode, archiveName) THEN
- out.String("Creating archive "); out.String(archiveName); out.String(" ... "); out.Update;
- archive := Zip.CreateArchive(archiveName, res);
- IF (res # Zip.Ok) THEN
- error.String("error: "); Zip.ShowError(res, error); error.Ln;
- RETURN;
- END;
- nofFilesAdded := 0;
- file := files;
- WHILE (file # NIL) DO
- IF (file.package = package) & file.IsInRelease(include) THEN
- IF sourceCode THEN
- IF file.IsSourceCode() THEN
- AddFile(archive, file.name, file.name, res);
- INC(nofFilesAdded);
- END;
- ELSE
- IF file.IsSourceCode() THEN
- GetObjectFileName(file, path, source); GetObjectFileName(file, "", dest);
- AddFile(archive, source, dest, res);
- INC(nofFilesAdded);
- IF (res = Zip.Ok) & (package.source = "") THEN (* Also add source code since no source code package is defined *)
- AddFile(archive, file.name, file.name, res);
- END;
- IF symbolFileExtension # extension THEN
- GetSymbolFileName(file, path, source); GetSymbolFileName(file, "", dest);
- AddFile(archive, source, dest, res);
- INC(nofFilesAdded);
- END
- ELSE
- AddFile(archive, file.name, file.name, res);
- INC(nofFilesAdded);
- IF (res = Zip.Ok) & (HasReleasePrefix IN file.flags) THEN
- StripReleasePrefix(file, dest); AddFile(archive, file.name, dest, res);
- INC(nofFilesAdded);
- END;
- END;
- END;
- IF (res # Zip.Ok) THEN
- error.Ln; error.String("Could not add file "); error.String(file.name);
- error.String(": "); Zip.ShowError(res, error); error.Ln;
- error.Update;
- RETURN;
- END;
- END;
- file := file.next;
- END;
- out.Int(nofFilesAdded, 0); out.String(" files added."); out.Ln; out.Update;
- END;
- END GenerateZipFile;
-
- PROCEDURE PackageIsExcludedFromZip(package: Package): BOOLEAN;
- VAR k: SIZE;
- BEGIN
- IF PackageIsExcluded(package) THEN
- RETURN TRUE;
- END;
- IF onlyPackages # NIL THEN
- k := 0;
- WHILE (k < LEN(onlyPackages)) & (package.name # onlyPackages[k]^) DO
- INC(k);
- END;
- IF k = LEN(onlyPackages) THEN
- RETURN TRUE;
- END;
- END;
- RETURN FALSE;
- END PackageIsExcludedFromZip;
- BEGIN
- packageArray := packages.GetAll();
- IF (packageArray # NIL) THEN
- DeleteOldZipFiles(packageArray);
- FOR i := 0 TO LEN(packageArray)-1 DO
- IF ~PackageIsExcludedFromZip(packageArray[i]) THEN
- GenerateZipFile(packageArray[i], TRUE, res);
- IF (res # Zip.Ok) THEN err := TRUE; RETURN END;
- GenerateZipFile(packageArray[i], FALSE, res);
- IF (res # Zip.Ok) THEN err := TRUE; RETURN END;
- END;
- END;
- ELSE
- diagnostics.Error("", Streams.Invalid, "No packages");
- END;
- END GenerateZipFiles;
- PROCEDURE FindPosition*(CONST filename : ARRAY OF CHAR; diagnostics : Diagnostics.DiagnosticsList) : LONGINT;
- VAR
- file, ref : File; position : LONGINT; pre, suf : ARRAY 32 OF CHAR;
- importOk : ARRAY MaxNofImports OF BOOLEAN; i : LONGINT;
- PROCEDURE Done() : BOOLEAN;
- VAR i : LONGINT;
- BEGIN
- i := 0; WHILE (i < LEN(importOk)) & (importOk[i] = TRUE) DO INC(i); END;
- RETURN (i >= LEN(importOk));
- END Done;
- PROCEDURE Process(f : File);
- VAR i : LONGINT;
- BEGIN
- IF f.IsSourceCode() & f.IsInRelease(include) & ~PackageIsExcluded(f.package)THEN
- FOR i := 0 TO LEN(importOk)-1 DO
- IF (file.module.imports[i] = f.module.name) & ~PackageIsExcluded(file.package) THEN importOk[i] := TRUE; END;
- END;
- END;
- END Process;
- BEGIN
- NEW(file, builds);
- COPY(filename, file.name);
- SplitName(file.name, pre, file.module.name, suf);
- IF (suf = "Mod") OR (suf="Mdf") OR (suf="Mos") THEN
- INCL(file.flags, SourceCode);
- file.ParseModule(diagnostics);
- IF (diagnostics.nofErrors = 0) THEN
- FOR i := 0 TO LEN(importOk)-1 DO
- IF (file.module.imports[i] # "") THEN importOk[i] := FALSE; ELSE importOk[i] := TRUE; END;
- END;
- position := 0;
- ref := files;
- LOOP
- IF Done() THEN EXIT; END;
- IF (ref = NIL) THEN EXIT; END;
- Process(ref);
- IF (ref.next # NIL) THEN position := ref.next.pos; ELSE position := ref.pos + 100; END;
- ref := ref.next;
- END;
- ELSE
- position := -1;
- END;
- ELSE
- position := 0;
- END;
- RETURN position;
- END FindPosition;
- PROCEDURE FindModule(CONST moduleName : Modules.Name) : File;
- VAR file : File;
- BEGIN
- file := files;
- WHILE (file # NIL) DO
- IF file.IsInRelease(include) & file.IsSourceCode() & ~PackageIsExcluded(file.package) THEN
- IF (file.module.name = moduleName) THEN
- RETURN file;
- END;
- END;
- file := file.next;
- END;
- RETURN NIL;
- END FindModule;
- PROCEDURE FindFile(CONST filename : Files.FileName) : File;
- VAR file : File;
- BEGIN
- file := files;
- WHILE (file # NIL) DO
- IF file.IsInRelease(include) & file.IsSourceCode() & ~PackageIsExcluded(file.package) THEN
- IF (file.name = filename) THEN
- RETURN file;
- END;
- END;
- file := file.next;
- END;
- RETURN NIL;
- END FindFile;
- (** For all files contained in this build check whether they exist. Also try to parse the import section of the source code files *)
- PROCEDURE CheckFiles*(diagnostics : Diagnostics.Diagnostics);
- VAR file : File; message : ARRAY 256 OF CHAR;
- BEGIN
- file := files;
- WHILE (file # NIL) DO
- IF file.IsInRelease(include) & ~PackageIsExcluded(file.package) THEN
- IF (file.file = NIL) THEN
- file.file := Files.Old(file.name);
- END;
- IF (file.file = NIL) THEN
- MakeMessage(message, "File # does not exists (Package #)", file.name, file.package.name);
- diagnostics.Warning(builds.source, file.pos, message);
- ELSIF file.IsSourceCode() THEN
- file.ParseModule(diagnostics);
- END;
- IF ~KeepFilesOpen THEN
- file.file := NIL;
- END;
- END;
- file := file.next;
- END;
- END CheckFiles;
- (** Check the source code files of this build for the import order *)
- PROCEDURE CheckModules*(diagnostics : Diagnostics.Diagnostics; VAR error : BOOLEAN);
- VAR file : File; tempError : BOOLEAN;
- BEGIN
- error := FALSE;
- file := files;
- WHILE (file # NIL) DO
- IF file.IsSourceCode() & file.IsInRelease(include) & ~PackageIsExcluded(file.package) THEN
- tempError := FALSE;
- file.CheckImports(diagnostics, SELF, tempError);
- error := error OR tempError;
- END;
- file := file.next;
- END;
- END CheckModules;
- (** Call both CheckFiles and CheckModules *)
- PROCEDURE DoChecks*(out : Streams.Writer; diagnostics : Diagnostics.Diagnostics; VAR error : BOOLEAN);
- VAR start, start0 : Dates.DateTime;
- BEGIN
- ASSERT((diagnostics # NIL));
- IF (out # NIL) THEN out.String(name); out.String(": Check if all files are present... "); out.Update; END;
- start0 := Dates.Now();
- CheckFiles(diagnostics);
- Strings.ShowTimeDifference(start0, Dates.Now(), out);
- IF (out # NIL) THEN out.String(" done."); out.Ln; out.Update; END;
- IF (out # NIL) THEN out.String(name); out.String(": Check modules and imports... "); out.Update; END;
- start := Dates.Now();
- error := FALSE;
- CheckModules(diagnostics, error);
- Strings.ShowTimeDifference(start, Dates.Now(), out);
- IF (out # NIL) THEN out.String(" done."); out.Ln; out.Update; END;
- END DoChecks;
- (* Analyzes the import dependencies between all modules *)
- PROCEDURE AnalyzeDependencies(out : Streams.Writer);
- VAR
- nofModules : LONGINT;
- file : File;
- ignore, index, i, j : LONGINT;
- PROCEDURE GetIndexOf(file : File; CONST moduleName : Name) : LONGINT;
- VAR f : File;
- BEGIN
- f := file.prev;
- LOOP
- ASSERT(f # NIL);
- IF f.IsSourceCode() & f.IsInRelease(include) & ~PackageIsExcluded(f.package) & (f.module.name = moduleName) THEN
- EXIT;
- END;
- f := f.prev;
- END;
- RETURN f.index;
- END GetIndexOf;
- BEGIN
- modules:= NIL;
- nofModules := GetNofSources(ignore);
- IF (out # NIL) THEN out.String("Analyzing dependencies of "); out.Int(nofModules, 0); out.String(" modules... "); END;
- IF (nofModules > 0) THEN
- (* Initialize the array of File 'modules' and the fields File.index and File.importIndices. After initialization,
- all File.importIndices contain the indices of directly imported modules *)
- NEW(modules, nofModules);
- index := 0;
- file := files;
- WHILE (file # NIL) DO
- IF file.IsSourceCode() & file.IsInRelease(include) & ~PackageIsExcluded(file.package) THEN
- file.index := index;
- modules[index] := file;
- FOR i := 0 TO file.module.nofImports-1 DO
- modules[index].importIndices[i] := GetIndexOf(file, file.module.imports[i]);
- END;
- INC(index);
- END;
- file := file.next;
- END;
- (* Create a two-dimensional bitmap where bitmap[i] is the import bitmap of the file with file.index = i.
- The import bitmap[i] has all bits j set where j is directly or indirectly imported by the file i . *)
- NEW(bitmap, nofModules);
- FOR i := 0 TO nofModules-1 DO
- NEW(bitmap[i], nofModules);
- FOR j := 0 TO modules[i].module.nofImports-1 DO
- bitmap[i].Set(modules[i].importIndices[j]);
- bitmap[i].Union(bitmap[modules[i].importIndices[j]]);
- END;
- END;
- (* Initialize fields File.nofDependetModules and File.nofRequiredModules *)
- FOR i := 0 TO nofModules-1 DO
- modules[i].nofDependentModules := 0;
- FOR j := 0 TO nofModules-1 DO
- IF bitmap[j].IsSet(i) THEN INC(modules[i].nofDependentModules); END;
- END;
- modules[i].nofRequiredModules := bitmap[i].NofBitsSet();
- END;
- END;
- IF (out # NIL) THEN out.String("done."); out.Ln; END;
- END AnalyzeDependencies;
- PROCEDURE ShowDependencies(out : Streams.Writer);
- VAR i, j : LONGINT; temp : File;
- BEGIN
- ASSERT(out # NIL);
- ASSERT((modules # NIL) & (bitmap # NIL));
- (* bubble sort *)
- FOR i := 0 TO LEN(modules)-1 DO
- FOR j := 0 TO LEN(modules)-2 DO
- IF (modules[j].nofDependentModules < modules[j+1].nofDependentModules) THEN
- temp := modules[j];
- modules[j] := modules[j+1];
- modules[j+1] := temp;
- END;
- END;
- END;
- FOR i := 0 TO LEN(modules)-1 DO
- out.String(modules[i].name); out.String(" -- ");
- out.Int(modules[i].nofDependentModules, 0);
- out.String(" ("); out.Int(modules[i].module.nofImports, 0);
- out.String("/"); out.Int(modules[i].nofRequiredModules, 0);
- out.String(")");
- out.Ln;
- END;
- END ShowDependencies;
- (** Clear the doCompile flag of all source code files contained in this build and not excluded *)
- PROCEDURE ClearMarks;
- VAR file : File;
- BEGIN
- file := files;
- WHILE (file # NIL) DO
- IF file.IsSourceCode() & file.IsInRelease(include) & ~PackageIsExcluded(file.package) THEN
- file.doCompile := FALSE;
- END;
- file := file.next;
- END;
- END ClearMarks;
- (** Set the doCompile flag of all non-excluded source code files in this build that depend on the specified file *)
- PROCEDURE MarkFiles(CONST filename : Files.FileName; VAR inBuild : BOOLEAN; VAR nofNewMarks : LONGINT);
- VAR file : File; nofModules, i, ignore : LONGINT;
- BEGIN
- nofNewMarks := 0;
- file := FindFile(filename);
- IF (file # NIL) THEN
- inBuild := TRUE;
- IF ~file.doCompile THEN
- file.doCompile := TRUE;
- INC(nofNewMarks);
- END;
- nofModules := GetNofSources(ignore);
- FOR i := 0 TO nofModules-1 DO
- IF bitmap[i].IsSet(file.index) THEN
- IF ~modules[i].doCompile THEN
- INC(nofNewMarks);
- modules[i].doCompile := TRUE;
- END;
- END;
- END;
- ELSE
- inBuild := FALSE;
- END;
- END MarkFiles;
- PROCEDURE ShowDependentModules(CONST modulename : Modules.Name; mode : LONGINT; out : Streams.Writer);
- CONST CharactersPerLine = 60;
- VAR module : File; ignore, nofModules, characterCount, i : LONGINT;
- BEGIN
- ASSERT(out # NIL);
- module := FindModule(modulename);
- IF (module # NIL) THEN
- characterCount := 0;
- nofModules := GetNofSources(ignore);
- IF (mode = Mode_ShowImporting) THEN
- FOR i := 0 TO nofModules-1 DO
- IF bitmap[i].IsSet(module.index) THEN
- out.String(modules[i].name); out.String(" ");
- characterCount := characterCount + Strings.Length(modules[i].name);
- IF (characterCount > CharactersPerLine) THEN characterCount := 0; out.Ln; out.Update; END;
- END;
- END;
- ELSE
- FOR i := 0 TO nofModules-1 DO
- IF bitmap[module.index].IsSet(i) THEN
- out.String(modules[i].name); out.String(" ");
- characterCount := characterCount + Strings.Length(modules[i].name);
- IF (characterCount > CharactersPerLine) THEN characterCount := 0; out.Ln; out.Update; END;
- END;
- END;
- END;
- ELSE
- out.String("Module "); out.String(modulename); out.String(" not found"); out.Ln;
- END;
- out.Update;
- END ShowDependentModules;
- PROCEDURE GetCompilerOptions(VAR options: ARRAY OF CHAR);
- BEGIN
- COPY(compileOptions, options);
- IF target # "" THEN
- Strings.Append(options, " -b="); Strings.Append(options, target);
- END;
- IF extension # "" THEN
- Strings.Append(options, " --objectFileExtension="); Strings.Append(options, "."); Strings.Append(options, extension);
- Strings.Append(options, " --symbolFileExtension="); Strings.Append(options, "."); Strings.Append(options, symbolFileExtension);
- END;
- IF path # "" THEN
- Strings.Append(options, " --destPath="); Strings.Append(options, path);
- END;
- END GetCompilerOptions;
- PROCEDURE GetLinkerOptions(VAR options: ARRAY OF CHAR);
- BEGIN
- COPY(linkOptions, options);
- END GetLinkerOptions;
- (* Count the number of source codes files in a specific build *)
- PROCEDURE GetNofSources(VAR nofMarked : LONGINT) : LONGINT;
- VAR file : File; nofSources : LONGINT;
- BEGIN
- nofSources := 0;
- file := files;
- WHILE (file # NIL) DO
- IF file.IsSourceCode() & file.IsInRelease(include) & ~PackageIsExcluded(file.package) & CompileThisPackage(file.package) THEN
- INC(nofSources);
- IF file.doCompile THEN INC(nofMarked); END;
- END;
- file := file.next;
- END;
- RETURN nofSources;
- END GetNofSources;
- PROCEDURE GetInfo*(VAR nofSources, nofFiles : LONGINT);
- VAR file : File;
- BEGIN
- nofSources := 0; nofFiles := 0;
- file := files;
- WHILE (file # NIL) DO
- IF file.IsInRelease(include) & ~PackageIsExcluded(file.package) THEN
- INC(nofFiles);
- IF file.IsSourceCode() THEN
- INC(nofSources);
- END;
- END;
- file := file.next;
- END;
- END GetInfo;
- PROCEDURE CompileFile(file : File; diagnostics : Diagnostics.Diagnostics; log : Streams.Writer; VAR error : BOOLEAN; importCache : SyntaxTree.ModuleScope);
- VAR
- reader : Streams.Reader;
- options : ARRAY 1024 OF CHAR;
- optionsReader : Streams.StringReader;
- message : ARRAY 512 OF CHAR;
- compilerOptions: Compiler.CompilerOptions;
- BEGIN
- ASSERT((file # NIL) & (diagnostics # NIL) & (importCache # NIL));
- reader := GetReader(file, diagnostics);
- IF ~KeepFilesOpen THEN
- file.file := NIL;
- END;
- IF (reader # NIL) THEN
- GetCompilerOptions(options);
- NEW(optionsReader, LEN(options));
- optionsReader.Set(options);
- error := ~Compiler.GetOptions(optionsReader, log, diagnostics, compilerOptions);
- IF ~error THEN
- error := ~Compiler.Modules(file.name, reader, 0, diagnostics, log, compilerOptions, importCache);
- END;
- ELSE
- MakeMessage(message, "File # not found", file.name, "");
- diagnostics.Error("", file.pos, message);
- error := TRUE;
- END;
- END CompileFile;
- (* Job procedure called by worker thread *)
- PROCEDURE CompileJob(parameters : ANY; VAR error : BOOLEAN);
- BEGIN
- ASSERT(
- (parameters # NIL) & (parameters IS WorkerParameters) &
- (parameters(WorkerParameters).file # NIL) & (parameters(WorkerParameters).diagnostics # NIL) &
- (parameters(WorkerParameters).importCache # NIL)
- );
- CompileFile(
- parameters(WorkerParameters).file,
- parameters(WorkerParameters).diagnostics,
- NIL,
- error,
- parameters(WorkerParameters).importCache
- );
- END CompileJob;
- PROCEDURE CreateJob(threadpool : ReleaseThreadPool.ThreadPool; file : File; diagnostics : Diagnostics.Diagnostics; importCache : SyntaxTree.ModuleScope);
- VAR parameters : WorkerParameters; dependencies : ReleaseThreadPool.Dependencies; i, priority : LONGINT;
- BEGIN
- ASSERT((threadpool # NIL) & (file # NIL) & (diagnostics # NIL) & (importCache # NIL));
- NEW(parameters, file, diagnostics, importCache);
- priority := file.nofDependentModules;
- i := 0;
- WHILE (i < file.module.nofImports) DO
- dependencies[i] := modules[file.importIndices[i]].jobID;
- INC(i);
- END;
- dependencies[i] := ReleaseThreadPool.NoMoreDependencies;
- file.jobID := threadpool.CreateJob(CompileJob, parameters, priority, dependencies);
- END CreateJob;
- (** Compile all sources included in this build *)
- PROCEDURE Compile*(nofWorkers : LONGINT; out, error : Streams.Writer; verbose : BOOLEAN; diagnostics : Diagnostics.DiagnosticsList; VAR err : BOOLEAN);
- VAR
- file : File; nofFiles, nofSources, nofMarked, step, steps : LONGINT;
- importCache : SyntaxTree.ModuleScope;
- startTime : Dates.DateTime;
- log : Streams.Writer;
- dummyWriter : Streams.StringWriter;
- threadpool : ReleaseThreadPool.ThreadPool;
- BEGIN
- ASSERT(nofWorkers >= 0);
- nofSources := GetNofSources(nofMarked);
- IF (nofWorkers > 0) THEN
- AnalyzeDependencies(out);
- NEW(threadpool, nofWorkers);
- out.String("Generating jobs to compile build ");
- ELSE
- out.String("Compiling build ");
- END;
- out.String(name); out.String(" (");
- IF (nofMarked # nofSources) THEN out.Int(nofMarked, 0); out.Char("/"); END;
- out.Int(nofSources, 0); out.String(" files)");
- IF (nofWorkers > 0) THEN
- out.String(" using "); out.Int(nofWorkers, 0); out.String(" worker threads");
- END;
- out.String(" ... ");
- IF verbose THEN
- log := out;
- ELSE
- NEW(dummyWriter, 2);
- log := dummyWriter;
- step := ((nofMarked-1) DIV 10) +1; steps := 1;
- out.String(" 00% "); out.Update;
- END;
- startTime := Dates.Now();
- importCache := SyntaxTree.NewModuleScope();
- nofFiles := 0; err := FALSE;
- file := files;
- WHILE (file # NIL) DO
- IF file.IsSourceCode() & file.IsInRelease(include) & ~PackageIsExcluded(file.package) & file.doCompile & CompileThisPackage(file.package) THEN
- IF (nofWorkers = 0) THEN
- CompileFile(file, diagnostics, log, err, importCache);
- IF err THEN
- error.Ln; error.Ln;
- error.String("Error(s) in file "); error.String(file.name); error.Ln;
- diagnostics.ToStream(error, {Diagnostics.TypeError}); error.Ln;
- diagnostics.Reset;
- RETURN;
- END;
- ELSE
- CreateJob(threadpool, file, diagnostics, importCache);
- END;
- INC(nofFiles);
- IF ~verbose & (step # 0) & (nofFiles MOD step = 0) THEN
- out.Int(steps * 10, 0); out.String("% "); out.Update;
- INC(steps);
- END;
- END;
- file := file.next;
- END;
- IF verbose THEN
- out.Int(nofFiles, 0); out.String(" files done in ");
- ELSIF (steps < 11) THEN
- out.String("100% ");
- END;
- out.String(" done in "); Strings.ShowTimeDifference(startTime, Dates.Now(), out);
- out.Ln; out.Update;
- IF (nofWorkers > 0) THEN
- threadpool.AwaitAllDone;
- threadpool.Close;
- err := diagnostics.nofErrors > 0;
- IF (diagnostics.nofMessages > 0) THEN
- diagnostics.ToStream(error, Diagnostics.All); error.Ln;
- END;
- out.String("Compilation time: "); Strings.ShowTimeDifference(startTime, Dates.Now(), out);
- out.Ln; out.Update;
- END;
- END Compile;
- END BuildObj;
- TYPE
- Version = RECORD
- major, minor : LONGINT;
- END;
- Builds* = OBJECT
- VAR
- version : Version;
- (* All builds described in the build description file *)
- builds- : ARRAY MaxBuilds OF BuildObj;
- nofBuilds : LONGINT;
- packages- : PackageList;
- (* In the build description file, the user may group files using prefixes, e.g.
- WIN,NATIVE { filename }. In this example, WIN and NATIVE are prefixes.
- The prefixes array contains each prefix exactly once. The index of specific prefix in this
- are will be used as bit position for the BuildObj.include set. *)
- prefixes : ARRAY MaxPrefixes OF Name;
- nofPrefixes : LONGINT;
- (* Name of the package description file *)
- source : Files.FileName;
- (* All files of all builds in the build description file *)
- files : File;
- (* number of files / sources in <files> list *)
- nofFiles- : LONGINT;
- nofSources- : LONGINT;
- PROCEDURE &Init;
- VAR i : LONGINT;
- BEGIN
- FOR i := 0 TO LEN(builds)-1 DO builds[i] := NIL; END;
- nofBuilds := 0;
- NEW(packages);
- FOR i := 0 TO LEN(prefixes)-1 DO prefixes[i] := ""; END;
- nofPrefixes := 0;
- source := "";
- files := NIL;
- nofFiles := 0;
- nofSources := 0;
- END Init;
- (* Add the specified prefix to the prefixes array if its not already contained *)
- PROCEDURE AddPrefix(CONST prefix : Name; diagnostics : Diagnostics.Diagnostics) : BOOLEAN;
- VAR error : BOOLEAN; i : LONGINT; j: LONGINT;
- BEGIN
- ASSERT((prefix # "") & (diagnostics # NIL));
- error := FALSE;
- (* check whether prefix is already registered *)
- i := 0; WHILE (i < LEN(prefixes)) & (prefixes[i] # prefix) DO INC(i); END;
- IF (i >= LEN(prefixes)) THEN (* new prefix, add it *)
- IF (nofPrefixes < LEN(prefixes)) THEN
- prefixes[nofPrefixes] := prefix;
- INC(nofPrefixes);
- ELSE
- error := TRUE;
- diagnostics.Warning("", Streams.Invalid, "Maximum number of prefixes exceeded");
- FOR j := 0 TO LEN(prefixes)-1 DO
- TRACE(prefixes[j]);
- END;
- END;
- END;
- RETURN ~error;
- END AddPrefix;
- (* Get the index of the specified prefix in the prefixes array. Returns -1 if prefix not found *)
- PROCEDURE GetPrefixIndex(CONST prefix : ARRAY OF CHAR) : LONGINT;
- VAR index : LONGINT;
- BEGIN
- index := 0;
- WHILE (index < nofPrefixes) & (prefixes[index] # prefix) DO INC(index); END;
- IF (index >= nofPrefixes) THEN index := -1; END;
- RETURN index;
- END GetPrefixIndex;
- (* Do checks for all builds *)
- PROCEDURE CheckAll*(out : Streams.Writer; diagnostics : Diagnostics.Diagnostics);
- VAR file : File; build : LONGINT; message : ARRAY 256 OF CHAR; error : BOOLEAN;
- BEGIN
- ASSERT(diagnostics # NIL);
- (* Check whether all files exist and parse modules*)
- out.String("Checking files for all builds... "); out.Update;
- file := files;
- WHILE (file # NIL) DO
- IF (file.file = NIL) THEN
- file.file := Files.Old(file.name);
- END;
- IF (file.file = NIL) THEN
- MakeMessage(message, "File # does not exists (Package #)", file.name, file.package.name);
- IF file.IsSourceCode() THEN
- diagnostics.Error(source, file.pos, message);
- ELSE
- diagnostics.Warning(source, file.pos, message);
- END;
- ELSIF file.IsSourceCode() THEN
- file.ParseModule(diagnostics);
- END;
- IF ~KeepFilesOpen THEN
- file.file := NIL;
- END;
- file := file.next;
- END;
- out.String("done."); out.Ln;
- build := 0;
- WHILE (build < LEN(builds)) & (builds[build] # NIL) DO
- out.String("Checking imports of builds "); out.String(builds[build].name); out.String("... "); out.Update;
- error := FALSE;
- builds[build].CheckModules(diagnostics, error);
- out.String("done."); out.Ln;
- INC(build);
- END;
- out.Update;
- END CheckAll;
- (* Show build statistics *)
- PROCEDURE Show*(w : Streams.Writer; details : BOOLEAN);
- VAR
- statistics : Statistics; build, prefix, nofFiles, nofSources : LONGINT; file : File; options : ARRAY 256 OF CHAR;
- diagnostics : Diagnostics.DiagnosticsList;
- error : BOOLEAN;
- BEGIN
- NEW(statistics);
- w.String("Release statistics:"); w.Ln;
- nofFiles := 0; nofSources := 0;
- file := files;
- WHILE (file # NIL) DO
- statistics.AddFile(file);
- file := file.next;
- END;
- w.Int(statistics.nofFiles, 0); w.String(" files ("); w.Int(statistics.nofSources, 0); w.String(" sources)"); w.Ln;
- w.String("Builds: ");
- IF (builds[0].name # "") THEN
- w.Ln;
- FOR build := 0 TO LEN(builds)-1 DO
- IF (builds[build] # NIL) THEN
- w.String(builds[build].name); w.Ln;
- w.Char(Tab); w.String("Includes: ");
- FOR prefix := 0 TO LEN(builds[build].prefixes)-1 DO
- IF (builds[build].prefixes[prefix] # "") THEN
- w.String(" ["); w.String(builds[build].prefixes[prefix]); w.String("]");
- END;
- END;
- w.Ln;
- w.Char(Tab); w.String("Compile: ");
- w.String(builds[build].compiler); w.String(" "); builds[build].GetCompilerOptions(options); w.String(options); w.Ln;
- statistics.Get(nofFiles, nofSources, builds[build].include);
- nofFiles := nofFiles + statistics.nofFilesAll;
- nofSources := nofSources + statistics.nofSourcesAll;
- w.Char(Tab); w.Int(nofFiles, 0); w.String(" files ("); w.Int(nofSources, 0); w.String(" sources)"); w.Ln;
- END;
- END;
- ELSE
- w.String("none"); w.Ln;
- END;
- packages.ToStream(w);
- IF details THEN
- prefix := 0;
- WHILE (prefix < LEN(prefixes)) & (prefixes[prefix] # "") DO
- w.String(prefixes[prefix]); w.Ln;
- nofFiles := 0;
- file := files;
- WHILE (file # NIL) DO
- IF (file.release = NIL) OR file.release.Has(prefix) THEN
- w.Char(Tab); w.String(file.name); w.Ln;
- INC(nofFiles);
- END;
- file := file.next;
- END;
- w.Char(Tab); w.Int(nofFiles, 0); w.String(" files"); w.Ln;
- INC(prefix);
- END;
- NEW(diagnostics);
- FOR build := 0 TO LEN(builds)-1 DO
- IF (builds[build] # NIL) THEN
- w.String("*** Import statistics for build "); w.String(builds[build].name); w.String(" ***"); w.Ln;
- error := FALSE;
- builds[build].DoChecks(w, diagnostics, error); w.Ln;
- IF ~error THEN
- diagnostics.Reset;
- builds[build].AnalyzeDependencies(w); w.Ln;
- builds[build].ShowDependencies(w);
- w.Ln;
- ELSE
- diagnostics.ToStream(w, Diagnostics.All); w.Ln;
- END;
- END;
- END;
- END;
- w.Update;
- END Show;
- PROCEDURE GetReleaseSet(build : BuildObj; VAR release : Set): BOOLEAN;
- VAR prefix, index, i : LONGINT;
- BEGIN
- SetEmpty(release);
- FOR prefix := 0 TO LEN(build.prefixes)-1 DO
- IF (build.prefixes[prefix] # "") THEN
- index := GetPrefixIndex(build.prefixes[prefix]);
- IF (index >= 0) THEN
- Incl(release, index);
- ELSE
- TRACE("GETRELEASE SET FAILED", build.prefixes[prefix], index);
- RETURN FALSE;
- END;
- END;
- END;
- RETURN TRUE;
- END GetReleaseSet;
- (** Get a reference to a BuildObj by name *)
- PROCEDURE GetBuild*(CONST buildname : ARRAY OF CHAR) : BuildObj;
- VAR build : BuildObj; i : LONGINT;
- BEGIN
- build := NIL;
- i := 0; WHILE (i < LEN(builds)) & (builds[i] # NIL) & (builds[i].name # buildname) DO INC(i); END;
- IF (i < LEN(builds)) THEN
- build := builds[i];
- END;
- RETURN build;
- END GetBuild;
- PROCEDURE AddBuild(build : BuildObj; diagnostics : Diagnostics.Diagnostics) : BOOLEAN;
- VAR error : BOOLEAN; i : LONGINT;
- BEGIN
- ASSERT((build # NIL) & (diagnostics # NIL));
- error := FALSE;
- IF (nofBuilds < LEN(builds)) THEN
- build.builds := SELF;
- builds[nofBuilds] := build;
- FOR i := 0 TO LEN(build.prefixes)-1 DO
- IF (build.prefixes[i] # "") THEN error := error OR ~AddPrefix(build.prefixes[i], diagnostics); END;
- END;
- INC(nofBuilds);
- ELSE
- error := TRUE;
- diagnostics.Error(source, Streams.Invalid, "Maximum number of builds exceeded");
- END;
- RETURN ~error;
- END AddBuild;
- PROCEDURE AddFile(CONST filename : ARRAY OF CHAR; release : Expression; package : Package; pos : LONGINT);
- VAR file, f : File; pre, suf : Files.FileName;
- BEGIN
- ASSERT(package # NIL);
- NEW(file, SELF);
- COPY(filename, file.name);
- COPY(filename, file.uppercaseName);
- Strings.UpperCase(file.uppercaseName);
- SplitName(file.name, pre, file.module.name, suf);
- IF (pre = ReleasePrefix) THEN
- INCL(file.flags, HasReleasePrefix);
- END;
- IF (suf = "Mod") OR (suf="Mdf") OR (suf = "Mos") THEN
- INCL(file.flags, SourceCode);
- INC(nofSources);
- INC(package.nofSources);
- END;
- INC(package.nofFiles);
- file.package := package;
- file.release := release;
- file.pos := pos;
- IF (files = NIL) THEN
- files := file;
- ELSE (* append to list *)
- f := files;
- WHILE (f.next # NIL) DO f := f.next; END;
- f.next := file;
- file.prev := f;
- END;
- INC(nofFiles);
- END AddFile;
- PROCEDURE FindFile(CONST filename : ARRAY OF CHAR) : File;
- VAR file : File;
- BEGIN
- file := files;
- WHILE (file # NIL) & (file.name # filename) DO file := file.next; END;
- RETURN file;
- END FindFile;
- PROCEDURE FindFileCheckCase(CONST filename : ARRAY OF CHAR; VAR caseEqual : BOOLEAN) : File;
- VAR result, file : File; fn : Name;
- BEGIN
- result := NIL;
- COPY(filename, fn); Strings.UpperCase(fn);
- file := files;
- WHILE (file # NIL) & (result = NIL) DO
- IF (filename = file.name) THEN
- caseEqual := TRUE;
- result := file;
- ELSIF (fn = file.uppercaseName) THEN
- caseEqual := FALSE;
- result := file;
- END;
- file := file.next;
- END;
- RETURN result;
- END FindFileCheckCase;
- (* Called by the Parser after parsing is finished *)
- PROCEDURE Initialize(diagnostics : Diagnostics.Diagnostics; VAR error : BOOLEAN);
- VAR build, package : LONGINT; message : ARRAY 256 OF CHAR;
- BEGIN
- ASSERT(diagnostics # NIL);
- FOR build := 0 TO LEN(builds)-1 DO
- IF (builds[build] # NIL) THEN
- IF GetReleaseSet(builds[build], builds[build].include) THEN
- builds[build].files := files;
- builds[build].packages := packages;
- IF (builds[build].excludedPackages # NIL) THEN
- FOR package := 0 TO LEN(builds[build].excludedPackages)-1 DO
- IF (packages.FindPackage(builds[build].excludedPackages[package]^) = NIL) THEN
- error := TRUE;
- MakeMessage(message, "Excluded package '#' in build '#' does not exist",
- builds[build].excludedPackages[package]^,
- builds[build].name);
- diagnostics.Error(source, Streams.Invalid, message);
- END;
- END;
- END;
- END;
- END;
- END;
- END Initialize;
- END Builds;
- CONST
- (* Tokens*)
- PACKAGE = "PACKAGE";
- ARCHIVE = "ARCHIVE";
- SOURCE = "SOURCE";
- DESCRIPTION = "DESCRIPTION";
- OPENSECTION = "{";
- CLOSESECTION = "}";
- SEPARATOR = ",";
- ENDSECTION = "END";
- HEADER = "HEADER";
- VERSION = "VERSION";
- BUILDS = "BUILDS";
- INCLUDE="INCLUDE";
- tIMPORT = "IMPORT";
- COMPILER = "COMPILER";
- COMPILEOPTIONS = "COMPILEOPTIONS";
- LINKER = "LINKER";
- LINKEROPTIONS = "LINKEROPTIONS";
- TARGET = "TARGET";
- EXTENSION="EXTENSION";
- SYMBOLEXTENSION="SYMBOLEXTENSION";
- PATH="PATH";
- EXCLUDEPACKAGES = "EXCLUDEPACKAGES";
- DISABLED = "DISABLED";
- TYPE
- Token = ARRAY 256 OF CHAR;
- Scanner = OBJECT
- VAR
- source: Name;
- reader : Streams.Reader;
- diagnostics : Diagnostics.Diagnostics;
- error : BOOLEAN;
- peekMode, peekBufferValid : BOOLEAN;
- peekToken : ARRAY 256 OF CHAR;
- peekError : BOOLEAN;
- pos : LONGINT;
- name : ARRAY 256 OF CHAR;
- PROCEDURE Error(pos : LONGINT; CONST msg, par1, par2 : ARRAY OF CHAR);
- VAR message : ARRAY 128 OF CHAR;
- BEGIN
- error := TRUE;
- MakeMessage(message, msg, par1, par2);
- diagnostics.Error(source, pos, message);
- END Error;
- PROCEDURE Check(CONST token : Token) : BOOLEAN;
- VAR temp : Token;
- BEGIN
- IF Get(temp) & (temp = token) THEN
- RETURN TRUE
- ELSE
- Error(reader.Pos(), "Expected '#' token", token, "");
- RETURN FALSE;
- END;
- END Check;
- PROCEDURE IsIdentifier(CONST token : ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- RETURN
- (token # PACKAGE) & (token # ARCHIVE) & (token # SOURCE) & (token # DESCRIPTION) &
- (token # OPENSECTION) & (token # CLOSESECTION) & (token # ENDSECTION) &
- (token # SEPARATOR) & (token # BUILDS) & (token # HEADER) & (token # VERSION) &
- (token # INCLUDE) & (token # COMPILER) & (token # COMPILEOPTIONS) & (token # TARGET) & (token # EXTENSION) & (token # SYMBOLEXTENSION) &
- (token # PATH) & (token # EXCLUDEPACKAGES);
- END IsIdentifier;
- PROCEDURE GetIdentifier(VAR identifier : ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- IF Get(identifier) THEN
- IF IsIdentifier(identifier) THEN
- RETURN TRUE;
- ELSE
- Error(pos, "Identifier expected but found token #", identifier, "");
- END;
- END;
- RETURN FALSE;
- END GetIdentifier;
- PROCEDURE Peek(VAR token : ARRAY OF CHAR);
- BEGIN
- IF (peekMode = FALSE) THEN
- IF Get(token) THEN
- peekMode := TRUE;
- peekError := FALSE;
- COPY(token, peekToken);
- ELSE
- peekError := TRUE;
- COPY("", peekToken);
- END;
- END;
- COPY(peekToken, token);
- END Peek;
- PROCEDURE Get(VAR token : ARRAY OF CHAR) : BOOLEAN;
- VAR delimiter, ch : CHAR; i : LONGINT; useDelimiter : BOOLEAN;
- BEGIN
- IF (peekMode) THEN
- COPY(peekToken, token);
- peekBufferValid := TRUE;
- peekMode := FALSE;
- IF (peekError) THEN
- Error(reader.Pos(), "ERROR", "", "");
- END;
- RETURN ~peekError;
- END;
- name := "";
- SkipComments;
- delimiter := reader.Peek(); useDelimiter := (delimiter = "'") OR (delimiter = '"');
- IF useDelimiter THEN reader.Char(ch); END;
- pos := reader.Pos();
- i := 0;
- REPEAT
- reader.Char(ch); (* Since we skipped the comments and whitespace, ch cannot be "#" or whitespace *)
- IF useDelimiter & (ch = delimiter) OR (ch=0X) THEN
- ELSE
- token[i] := ch; INC(i);
- END;
- IF (~useDelimiter & (ch # "{") & (ch # "}") & (ch # ",") & (ch # "~") & (ch # "|") & (ch # "(") & (ch # ")")) THEN
- ch := reader.Peek();
- END;
- UNTIL
- (i >= LEN(token)-1) OR ((reader.res = Streams.EOF) & (ch = 0X)) OR
- (~useDelimiter & (IsWhitespace(ch) OR (ch = "#") OR (ch ="(") OR (ch=")") OR (ch ="{") OR (ch="}") OR (ch = ",") OR (ch = "~"))) OR
- (useDelimiter & (ch = delimiter));
- IF (i = 0) & (reader.res = Streams.EOF) THEN (* end of text *)
- RETURN FALSE
- ELSIF (i < LEN(token)) THEN
- token[i] := 0X;
- COPY(token, name);
- RETURN TRUE;
- ELSE
- Error(reader.Pos(), "Token too long", "", "");
- RETURN FALSE;
- END;
- END Get;
- PROCEDURE IsWhitespace(ch : CHAR) : BOOLEAN;
- BEGIN
- RETURN (ch <= " ");
- END IsWhitespace;
- PROCEDURE SkipComments;
- VAR ch : CHAR;
- BEGIN
- reader.SkipWhitespace;
- ch := reader.Peek();
- WHILE (ch = "#") DO reader.SkipLn; reader.SkipWhitespace; ch := reader.Peek(); END;
- END SkipComments;
- PROCEDURE &Init(CONST source: ARRAY OF CHAR; reader : Streams.Reader; diagnostics : Diagnostics.Diagnostics);
- BEGIN
- COPY (source, SELF.source);
- ASSERT((reader # NIL) & (diagnostics # NIL));
- SELF.reader := reader;
- SELF.diagnostics := diagnostics;
- peekMode := FALSE; peekToken := ""; peekError := FALSE;
- error := FALSE;
- END Init;
- END Scanner;
- TYPE
- Parser = OBJECT
- VAR
- scanner : Scanner;
- diagnostics : Diagnostics.Diagnostics;
- log: Streams.Writer;
- error : BOOLEAN;
- currentPackage : Package;
- PROCEDURE Error(pos : LONGINT; CONST msg, par1, par2 : ARRAY OF CHAR);
- VAR message : ARRAY 128 OF CHAR;
- BEGIN
- error := TRUE;
- MakeMessage(message, msg, par1, par2);
- diagnostics.Error(scanner.source, pos, message);
- END Error;
- PROCEDURE Warning(pos : LONGINT; CONST msg, par1, par2 : ARRAY OF CHAR);
- VAR message : ARRAY 128 OF CHAR;
- BEGIN
- MakeMessage(message, msg, par1, par2);
- diagnostics.Warning(scanner.source, pos, message);
- END Warning;
- PROCEDURE IsFilename(CONST token : Token) : BOOLEAN;
- VAR i : LONGINT;
- BEGIN
- i := 1; (* don't allow filenames to start with "." *)
- WHILE (i < LEN(token)) & (token[i] # ".") & (token[i] # 0X) DO INC(i); END;
- RETURN (i < LEN(token)) & (token[i] = ".");
- END IsFilename;
- PROCEDURE Parse(VAR builds : Builds) : BOOLEAN;
- VAR token : Token; v1, v2 : ARRAY 16 OF CHAR;
- BEGIN
- IF builds = NIL THEN NEW(builds) END;
- COPY(scanner.source, builds.source);
- IF ParseHeader(builds) THEN
- IF (builds.version.major = VersionMajor) & (builds.version.minor <= VersionMinor) THEN
- IF ParseImport(builds) THEN (* load included sections *)
- END;
- IF ParseBuilds(builds) THEN END; (* optional *)
- LOOP
- currentPackage := ParsePackageHeader();
- IF (currentPackage # NIL) THEN
- IF builds.packages.Add(currentPackage) THEN
- IF ~ParsePackage(builds, token) THEN
- EXIT;
- END;
- ELSE
- Error(scanner.pos, "Package # is already defined", currentPackage.name, "");
- EXIT;
- END;
- ELSE
- EXIT;
- END;
- scanner.SkipComments;
- IF scanner.reader.Available() < 5 THEN EXIT; END;
- END;
- IF ~error THEN builds.Initialize(diagnostics, error); END;
- ELSE
- VersionToString(VersionMajor, VersionMinor, v1);
- VersionToString(builds.version.major, builds.version.minor, v2);
- Error(Streams.Invalid, "Version mismatch, Release.Mod is version #, tool file is version #", v1, v2);
- END;
- END;
- RETURN ~(error OR scanner.error OR (builds = NIL));
- END Parse;
- (* Import = IMPORT Entries END whereas Entries = FileName *)
- PROCEDURE ParseImport(VAR builds : Builds) : BOOLEAN;
- VAR token : Token; ignore : BOOLEAN; filename: Files.FileName;
- BEGIN
- ASSERT(builds # NIL);
- scanner.Peek(token);
- IF (token = tIMPORT) THEN
- ignore := scanner.Get(token);
- LOOP
- scanner.Peek(token);
- IF (token = ENDSECTION) THEN
- ignore := scanner.Get(token);
- RETURN TRUE;
- ELSIF scanner.IsIdentifier(token) THEN (* filename *)
- IF IsFilename(token) THEN
- COPY(token, filename);
- IF ~ParseBuildFile(filename, builds, log, diagnostics) THEN
- Error(scanner.pos, "Could not include #", filename, "")
- END;
- ELSE
- Error(scanner.pos, "No filename #",token,"");
- RETURN FALSE
- END;
- ignore := scanner.Get(token);
- END;
- END;
- END;
- RETURN FALSE;
- END ParseImport;
- (* Header = HEADER Entries END whereas Entries = VERSION VersionString *)
- PROCEDURE ParseHeader(builds : Builds) : BOOLEAN;
- VAR token : Token; ignore : BOOLEAN;
- PROCEDURE ParseVersionString(CONST string : ARRAY OF CHAR) : BOOLEAN;
- VAR strings : Strings.StringArray;
- BEGIN
- strings := Strings.Split(string, ".");
- IF (LEN(strings) = 2) THEN
- Strings.StrToInt(strings[0]^, builds.version.major);
- Strings.StrToInt(strings[1]^, builds.version.minor);
- RETURN TRUE;
- ELSE
- Error(scanner.pos, "Expected version string major.minor, found #", string, "");
- RETURN FALSE;
- END;
- END ParseVersionString;
- BEGIN
- ASSERT(builds # NIL);
- scanner.Peek(token);
- IF (token = HEADER) THEN
- ignore := scanner.Get(token);
- LOOP
- scanner.Peek(token);
- IF (token = ENDSECTION) THEN
- ignore := scanner.Get(token);
- RETURN TRUE;
- ELSIF (token = VERSION) THEN
- ignore := scanner.Get(token);
- IF scanner.Get(token) THEN
- IF ~ParseVersionString(token) THEN
- Error(scanner.pos, "Invalid version string: #", token, "");
- EXIT;
- END;
- ELSE
- Error(scanner.pos, "Version number expected", "", "");
- EXIT;
- END;
- ELSE
- Error(scanner.pos, "Expected # or # token", HEADER, ENDSECTION);
- EXIT;
- END;
- END;
- ELSE
- Error(scanner.pos, "# section expected", HEADER, "");
- END;
- RETURN FALSE;
- END ParseHeader;
- (* Builds = [ BUILDS {Build} END ] whereas Build = BuildName "{" prefix {" " perfix} "}" *)
- PROCEDURE ParseBuilds(builds : Builds) : BOOLEAN;
- VAR token : Token; build : BuildObj;
- BEGIN
- IF builds = NIL THEN RETURN FALSE END;
- ASSERT(builds # NIL);
- scanner.Peek(token);
- IF (token = BUILDS) THEN
- IF scanner.Get(token) THEN END; (* consume BUILDS *)
- LOOP
- scanner.Peek(token);
- IF (token = ENDSECTION) THEN
- IF scanner.Get(token) THEN END; (* consume token *)
- RETURN TRUE;
- ELSE
- build := ParseBuild();
- IF (build # NIL) THEN
- IF ~builds.AddBuild(build, diagnostics) THEN
- EXIT;
- END;
- ELSE
- EXIT;
- END;
- END;
- END;
- END;
- RETURN FALSE;
- END ParseBuilds;
- (* Build = BuildName "{" prefix {"," perfix} "}" *)
- PROCEDURE ParseBuild() : BuildObj;
- VAR
- token : Token; prefix : LONGINT;
- string : ARRAY 256 OF CHAR; stringArray : Strings.StringArray;
- compilerSet, compileOptionsSet, linkerSet, linkOptionsSet, targetSet, includeSet, excludePackagesSet, extensionSet, symbolsSet, pathSet, disabledSet : BOOLEAN;
- build : BuildObj;
- PROCEDURE CheckOptions;
- BEGIN
- IF ~includeSet THEN Warning(scanner.pos, "# not set in build #", INCLUDE, build.name); END;
- IF ~compilerSet THEN Warning(scanner.pos, "# not set in build #", COMPILER, build.name); END;
- IF ~compileOptionsSet THEN Warning(scanner.pos, "# not set in build #", COMPILEOPTIONS, build.name); END;
- IF ~targetSet THEN Warning(scanner.pos, "# not set in build #", TARGET, build.name); END;
- IF ~extensionSet THEN Warning(scanner.pos, "# not set in build #", EXTENSION, build.name); END;
- IF ~symbolsSet THEN (* no warning since optional *) END;
- IF ~pathSet THEN Warning(scanner.pos, "# not set in build #", PATH, build.name); END;
- IF ~disabledSet THEN Warning(scanner.pos, "# not set in build #", DISABLED, build.name); END;
- END CheckOptions;
- BEGIN
- NEW(build);
- compilerSet := FALSE; compileOptionsSet := FALSE; linkerSet := FALSE; linkOptionsSet := FALSE; targetSet := FALSE; includeSet := FALSE;
- extensionSet := FALSE; symbolsSet := FALSE; pathSet := FALSE; excludePackagesSet := FALSE; disabledSet := FALSE;
- IF scanner.GetIdentifier(build.name) THEN
- build.position := scanner.pos;
- IF scanner.Check(OPENSECTION) THEN
- LOOP
- IF scanner.Get(token) THEN
- IF (token = CLOSESECTION) THEN
- CheckOptions;
- RETURN build;
- ELSIF (token = COMPILER) THEN
- IF compilerSet THEN Error(scanner.pos, "# already set in build #", COMPILER, build.name); ELSE compilerSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.compiler) THEN
- (* continue *)
- END;
- ELSIF (token = COMPILEOPTIONS) THEN
- IF compileOptionsSet THEN Error(scanner.pos, "# already set in build #", COMPILEOPTIONS, build.name); ELSE compileOptionsSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.compileOptions) THEN
- (* continue *)
- END;
- ELSIF (token = LINKER) THEN
- IF linkerSet THEN Error(scanner.pos, '# already set in build #', LINKER, build.name); ELSE linkerSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.linker) THEN
- (* continue *)
- END;
- ELSIF (token = LINKEROPTIONS) THEN
- IF linkOptionsSet THEN Error(scanner.pos, '# already set in build #', LINKEROPTIONS, build.name); ELSE linkOptionsSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.linkOptions) THEN
- (* continue *)
- END;
- ELSIF (token = TARGET) THEN
- IF targetSet THEN Error(scanner.pos, "# already set in build #", TARGET, build.name); ELSE targetSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.target) THEN
- (* continue *)
- END;
- ELSIF (token = EXTENSION) THEN
- IF extensionSet THEN Error(scanner.pos, "# already set in build #", EXTENSION, build.name); ELSE extensionSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.extension) THEN
- (* continue *)
- END;
- ELSIF (token = SYMBOLEXTENSION) THEN
- IF symbolsSet THEN Error(scanner.pos, "# already set in build #", SYMBOLEXTENSION, build.name); ELSE symbolsSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.symbolFileExtension) THEN
- (* continue *)
- END;
- ELSIF (token = PATH) THEN
- IF pathSet THEN Error(scanner.pos, "# already set in build #", PATH, build.name); ELSE pathSet := TRUE; END;
- IF ~scanner.GetIdentifier(build.path) THEN
- (* continue *)
- END;
- ELSIF (token = INCLUDE) THEN
- IF includeSet THEN Error(scanner.pos, "# already set in build #", INCLUDE, build.name); ELSE includeSet := TRUE; END;
- IF scanner.GetIdentifier(string) THEN
- stringArray := Strings.Split(string, " ");
- prefix := 0;
- IF LEN(stringArray) <= LEN(build.prefixes) THEN
- FOR prefix := 0 TO LEN(stringArray)-1 DO
- COPY(stringArray[prefix]^, build.prefixes[prefix]);
- END;
- ELSE
- Error(scanner.pos, "Maximum number of prefixes exceeded.", "", "");
- END;
- END;
- ELSIF (token = EXCLUDEPACKAGES) THEN
- IF excludePackagesSet THEN Error(scanner.pos, "# already set in build #", EXCLUDEPACKAGES, build.name);
- ELSE excludePackagesSet := TRUE;
- END;
- IF scanner.GetIdentifier(string) THEN
- Strings.TrimWS(string);
- IF (string # "") THEN
- build.excludedPackages := Strings.Split(string, " ");
- END;
- END;
- ELSIF (token = DISABLED) THEN
- IF disabledSet THEN Error(scanner.pos, "# already set in build #", DISABLED, build.name);
- ELSE disabledSet := TRUE;
- END;
- IF scanner.GetIdentifier(string) THEN
- Strings.TrimWS(string);
- Strings.UpperCase(string);
- IF (string = "TRUE") THEN
- build.disabled := TRUE;
- ELSIF (string = "FALSE") THEN
- build.disabled := FALSE;
- ELSE
- Warning(scanner.pos, "Wrong value for # in build #", DISABLED, build.name);
- build.disabled := TRUE;
- END;
- ELSE
- (* error reported by scanner.GetIdentifier *)
- END;
- ELSE
- IF includeSet & compilerSet & targetSet & extensionSet & pathSet THEN
- Error(scanner.pos, "Expected # or # token", CLOSESECTION, EXCLUDEPACKAGES);
- ELSE
- Error(scanner.pos, "Expected INCLUDE, COMPILER or COMPILEOPTIONS token", "", "");
- END;
- EXIT;
- END;
- ELSE
- EXIT;
- END;
- END;
- END;
- END;
- RETURN NIL;
- END ParseBuild;
- (* PackageHeader = PACKAGE PackageName ARCHIVE ArchiveName SOURCE SourceArchiveName DESCRIPTION description *)
- PROCEDURE ParsePackageHeader() : Package;
- VAR package : Package; name, archive, source : ARRAY 32 OF CHAR; description : ARRAY 256 OF CHAR; position : LONGINT;
- BEGIN
- package := NIL;
- IF scanner.Check(PACKAGE) THEN
- position := scanner.pos;
- IF scanner.GetIdentifier(name) &
- scanner.Check(ARCHIVE) & scanner.GetIdentifier(archive) &
- scanner.Check(SOURCE) & scanner.GetIdentifier(source) &
- scanner.Check(DESCRIPTION) & scanner.GetIdentifier(description)
- THEN
- NEW(package, name, archive, source, description, position);
- END;
- END;
- RETURN package;
- END ParsePackageHeader;
- (* Package = { FileList | Prefix "{" FileList "}" }
- Prefix = prefix {"," prefix}
- FileList = filename {" " filename} *)
- PROCEDURE ParsePackage(builds : Builds; VAR token : Token) : BOOLEAN;
- VAR currentRelease : Expression; index : LONGINT; pos : LONGINT; nbr : ARRAY 8 OF CHAR; caseEqual : BOOLEAN; file : File;
- BEGIN
- LOOP
- IF scanner.Get(token) THEN
- index := builds.GetPrefixIndex(token);
- IF (index >= 0) THEN
- IF currentRelease = NIL THEN
- IF ~ParseBuildPrefixes(builds, token, currentRelease, pos) THEN
- RETURN FALSE;
- END;
- ELSE
- Strings.IntToStr(pos, nbr);
- Error(scanner.pos, "Expected closing brace for tag at position #", nbr, "");
- RETURN FALSE;
- END;
- ELSIF (token = "~") OR (token = "(") THEN
- IF ~ParseBuildPrefixes(builds, token, currentRelease, pos) THEN
- RETURN FALSE;
- END;
- ELSIF (token = CLOSESECTION) THEN
- IF currentRelease # NIL THEN
- currentRelease := NIL;
- ELSE
- Error(scanner.pos, "No matching opening bracket", "", "");
- RETURN FALSE;
- END;
- ELSIF (token = ENDSECTION) THEN
- RETURN TRUE;
- ELSIF scanner.IsIdentifier(token) THEN (* filename *)
- IF IsFilename(token) THEN
- file := builds.FindFileCheckCase(token, caseEqual);
- IF (file # NIL) THEN
- IF caseEqual THEN
- Warning(scanner.pos, "Duplicate file found: #", token, "");
- ELSE
- Warning(scanner.pos, "Same file name with different case found: # vs #", token, file.name);
- END;
- END;
- builds.AddFile(token, currentRelease, currentPackage, scanner.pos);
- ELSE
- diagnostics.Warning(scanner.source, scanner.pos, "Expected filename (not file extension?)");
- END;
- ELSE
- Error(scanner.pos, "Expected identifier, found #", token, "");
- END;
- ELSE
- EXIT;
- END;
- END;
- RETURN currentRelease = NIL;
- END ParsePackage;
- PROCEDURE ParseBuildPrefixes(builds : Builds; VAR token : Token; VAR release : Expression; VAR pos : LONGINT) : BOOLEAN;
- (* Factor = Identifier | '~' Factor | '(' Prefixes ')'. *)
- PROCEDURE Factor (VAR value: Expression): BOOLEAN;
- VAR index: LONGINT; message : ARRAY 128 OF CHAR;
- BEGIN
- IF token = "(" THEN
- IF ~scanner.Get(token) THEN RETURN FALSE END;
- IF ~Prefixes (value) THEN RETURN FALSE END;
- IF token # ")" THEN Error(scanner.pos, "Expected ')'", "", ""); RETURN FALSE END;
- IF ~scanner.Get(token) THEN RETURN FALSE END;
- ELSIF token = "~" THEN
- IF ~scanner.Get(token) THEN RETURN FALSE END;
- NEW (value);
- value.model := ExpressionModel.Not;
- IF ~Factor (value.left) THEN RETURN FALSE END;
- ELSE
- NEW (value);
- value.model := ExpressionModel.Prefix;
- value.index := builds.GetPrefixIndex(token);
- IF (value.index < 0) THEN
- MakeMessage(message, "Unknown build prefix #", token, "");
- diagnostics.Warning(scanner.source, scanner.pos, message);
- END;
- IF ~scanner.Get(token) THEN RETURN FALSE END;
- END;
- RETURN TRUE;
- END Factor;
- (* Term = Factor {'&' Factor}. *)
- PROCEDURE Term (VAR value: Expression): BOOLEAN;
- VAR left: Expression;
- BEGIN
- IF ~Factor (value) THEN RETURN FALSE END;
- WHILE token = "&" DO
- IF ~scanner.Get(token) THEN RETURN FALSE END;
- left := value;
- NEW (value);
- value.model := ExpressionModel.And;
- value.left := left;
- IF ~Factor (value.right) THEN RETURN FALSE END;
- END;
- RETURN TRUE;
- END Term;
-
- (* Prefixes = Term {('|'|',') Term}. *)
- PROCEDURE Prefixes (VAR value: Expression): BOOLEAN;
- VAR left: Expression;
- BEGIN
- IF ~Term (value) THEN RETURN FALSE END;
- WHILE (token = "|") OR (token = ",") DO
- IF ~scanner.Get (token) THEN RETURN FALSE END;
- left := value;
- NEW (value);
- value.model := ExpressionModel.Or;
- value.left := left;
- IF ~Term (value.right) THEN RETURN FALSE END;
- END;
- RETURN TRUE;
- END Prefixes;
- BEGIN
- IF ~Prefixes (release) THEN RETURN FALSE END;
- IF (token = OPENSECTION) THEN
- RETURN TRUE;
- ELSE
- Error(scanner.pos, "Expected '{' or ',' token", "", "");
- RETURN FALSE;
- END;
- END ParseBuildPrefixes;
- PROCEDURE &Init(scanner : Scanner; log: Streams.Writer; diagnostics : Diagnostics.Diagnostics);
- BEGIN
- ASSERT((scanner # NIL) & (diagnostics # NIL));
- SELF.scanner := scanner;
- SELF.diagnostics := diagnostics;
- SELF.log := log
- END Init;
- END Parser;
- PROCEDURE SetAll(VAR s: Set);
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(s)-1 DO
- s[i] := {MIN(SET)..MAX(SET)};
- END;
- END SetAll;
-
- PROCEDURE SetEmpty(VAR s: Set);
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(s)-1 DO
- s[i] := {};
- END;
- END SetEmpty;
-
- PROCEDURE IsAll(CONST s: Set): BOOLEAN;
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(s)-1 DO
- IF s[i] # {MIN(SET)..MAX(SET)} THEN RETURN FALSE END;
- END;
- RETURN TRUE;
- END IsAll;
-
- PROCEDURE IsEmpty(CONST s: Set): BOOLEAN;
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(s)-1 DO
- IF s[i] # {} THEN RETURN FALSE END;
- END;
- RETURN TRUE;
- END IsEmpty;
-
- PROCEDURE Incl(VAR s: Set; i: LONGINT);
- BEGIN
- INCL(s[i DIV SetSize], i MOD SetSize);
- END Incl;
- PROCEDURE Excl(VAR s: Set; i: LONGINT);
- BEGIN
- EXCL(s[i DIV SetSize], i MOD SetSize);
- END Excl;
-
- PROCEDURE Complement(VAR s: Set);
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(s)-1 DO
- s[i] := -s[i];
- END;
- END Complement;
-
- PROCEDURE Union(VAR s: Set; CONST t: Set);
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(s)-1 DO
- s[i] := s[i] + t[i];
- END;
- END Union;
-
- PROCEDURE Intersection(VAR s: Set; CONST t: Set);
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(s)-1 DO
- s[i] := s[i] * t[i];
- END;
- END Intersection;
-
- PROCEDURE In(CONST s: Set; i: LONGINT): BOOLEAN;
- BEGIN
- RETURN i MOD SetSize IN s[i DIV SetSize];
- END In;
-
- PROCEDURE GetModuleInfo(
- in : Streams.Reader;
- VAR mi : ModuleInfo;
- CONST source, filename : ARRAY OF CHAR;
- errorPosition : LONGINT;
- diagnostics : Diagnostics.Diagnostics;
- VAR error : BOOLEAN);
- PROCEDURE SkipComments(in : Streams.Reader);
- VAR level, oldLevel, oldPosition : LONGINT; ch, nextCh : CHAR;
- BEGIN
- ASSERT((in # NIL) & (in.CanSetPos()));
- level := 0;
- REPEAT
- ASSERT(level >= 0);
- in.SkipWhitespace;
- oldLevel := level;
- oldPosition := in.Pos();
- in.Char(ch); nextCh := in.Peek();
- IF (ch = "(") & (nextCh = "*") THEN
- INC(level); in.Char(ch);
- ELSIF (level > 0) & (ch = "*") & (nextCh = ")") THEN
- DEC(level); in.Char(ch);
- ELSIF (level = 0) THEN
- in.SetPos(oldPosition);
- END;
- UNTIL ((level = 0) & (oldLevel = 0)) OR (in.res # Streams.Ok);
- END SkipComments;
- PROCEDURE SkipProperties (in : Streams.Reader);
- VAR ch : CHAR;
- BEGIN
- in.SkipWhitespace;
- ch := in.Peek();
- IF ch = "{" THEN
- in.Char(ch);
- REPEAT
- in.Char(ch);
- UNTIL (ch = "}") OR (in.res # Streams.Ok)
- END;
- END SkipProperties;
- PROCEDURE GetIdentifier(in : Streams.Reader; VAR identifier : ARRAY OF CHAR);
- VAR ch : CHAR; i : LONGINT;
- BEGIN
- ASSERT(in # NIL);
- i := 0;
- ch := in.Peek();
- WHILE (('a' <= ch) & (ch <= 'z')) OR (('A' <= ch) & (ch <= 'Z')) OR (('0' <= ch) & (ch <= '9')) OR (ch = "_") & (i < LEN(identifier) - 1) DO
- in.Char(identifier[i]); INC(i);
- ch := in.Peek();
- END;
- identifier[i] := 0X;
- END GetIdentifier;
- PROCEDURE GetContext(in : Streams.Reader; ch1, ch2 : CHAR; VAR context : ARRAY OF CHAR; diagnostics : Diagnostics.Diagnostics; VAR error : BOOLEAN);
- VAR message : ARRAY 512 OF CHAR; ch : CHAR;
- BEGIN
- ASSERT((in # NIL) & (diagnostics # NIL));
- SkipComments(in);
- ch := in.Peek();
- IF (Strings.UP(ch) = ch1) THEN
- in.Char(ch); in.Char(ch);
- IF Strings.UP(ch) = ch2 THEN
- SkipComments(in);
- GetIdentifier(in, context); (* ignore context identifier *)
- IF (context = "") THEN
- error := TRUE;
- MakeMessage(message, "Context identifier missing in file #", filename, "");
- diagnostics.Error(source, errorPosition, message);
- END;
- SkipComments(in);
- ELSE
- error := TRUE;
- MakeMessage(message, "Expected 'IN' keyword in file #", filename, "");
- diagnostics.Error(source, errorPosition, message);
- END;
- END;
- END GetContext;
- PROCEDURE GetModuleNameAndContext(in : Streams.Reader; VAR name, context : Name; diagnostics : Diagnostics.Diagnostics; VAR error : BOOLEAN);
- VAR token, message : ARRAY 512 OF CHAR; ch : CHAR;
- BEGIN
- ASSERT((in # NIL) & (diagnostics # NIL) & (~error));
- name := ""; COPY(Modules.DefaultContext, context);
- SkipComments(in);
- in.SkipWhitespace; in.String(token); Strings.UpperCase(token);
- IF (token = "MODULE") OR (token = "CELLNET") THEN
- SkipComments(in);
- SkipProperties(in);
- SkipComments(in);
- GetIdentifier(in, name);
- IF (name # "") THEN
- SkipComments(in);
- GetContext(in, "I", "N", context, diagnostics, error);
- in.Char(ch);
- IF ~error & (ch # ";") THEN
- error := TRUE;
- MakeMessage(message, "Expected semicolon after module identifier in file #", filename, "");
- diagnostics.Error(source, errorPosition, message);
- END;
- ELSE
- error := TRUE;
- MakeMessage(message, "Module identifier missing in file #", filename, "");
- diagnostics.Error(source, errorPosition, message);
- END;
- ELSE
- error := TRUE;
- MakeMessage(message, "MODULE keyword missing in file #, first token is #", filename, token);
- diagnostics.Error(source, errorPosition, message);
- END;
- END GetModuleNameAndContext;
- PROCEDURE GetImport(in : Streams.Reader; VAR import, context : ARRAY OF CHAR; diagnostics : Diagnostics.Diagnostics; VAR error : BOOLEAN);
- VAR message : ARRAY 512 OF CHAR;
- BEGIN
- ASSERT((in # NIL) & (diagnostics # NIL));
- SkipComments(in);
- GetIdentifier(in, import);
- IF (import # "") THEN
- GetContext(in, ':', '=', import, diagnostics, error);
- IF ~error THEN GetContext(in, "I", "N", context, diagnostics, error); END;
- ELSE
- error := TRUE;
- MakeMessage(message, "Identifier expected in import section of file #", filename, "");
- diagnostics.Error(source, errorPosition, message);
- END;
- END GetImport;
- PROCEDURE GetImports(in : Streams.Reader; VAR mi : ModuleInfo; diagnostics : Diagnostics.Diagnostics; VAR error : BOOLEAN);
- VAR string, import, context, message : ARRAY 256 OF CHAR; ch : CHAR;
- BEGIN
- ASSERT((in # NIL) & (in.CanSetPos()) & (diagnostics #NIL) & (~error));
- SkipComments(in);
- GetIdentifier(in, string); Strings.UpperCase(string);
- IF (string = "IMPORT") THEN
- LOOP
- COPY(mi.context, context);
- GetImport(in, import, context, diagnostics, error);
- IF ~error THEN
- IF (import = "SYSTEM") OR (import = "system") THEN
- INCL(mi.flags, ImportsSystem);
- ELSIF (mi.nofImports < LEN(mi.imports)) THEN
- CreateContext(import, context);
- COPY(import, mi.imports[mi.nofImports]);
- INC(mi.nofImports);
- ELSE
- error := TRUE;
- MakeMessage(message, "Maximum number of supported imports exceeded in module #", filename, "");
- diagnostics.Error(source, Streams.Invalid, message);
- EXIT;
- END;
- SkipComments(in);
- in.Char(ch);
- IF (ch = ",") THEN
- (* continue *)
- ELSIF (ch = ";") THEN
- EXIT;
- ELSE
- error := TRUE;
- MakeMessage(message, "Parsing import section of module # failed", filename, "");
- diagnostics.Error(source, errorPosition, message);
- EXIT;
- END;
- ELSE
- EXIT;
- END;
- END;
- ELSE
- mi.nofImports := 0;
- END;
- END GetImports;
- BEGIN
- ASSERT((in # NIL) & (diagnostics # NIL));
- error := FALSE;
- GetModuleNameAndContext(in, mi.name, mi.context, diagnostics, error);
- IF ~error THEN
- ASSERT(mi.nofImports = 0);
- GetImports(in, mi, diagnostics, error);
- END;
- END GetModuleInfo;
- PROCEDURE VersionToString(major, minor : LONGINT; VAR string : ARRAY OF CHAR);
- VAR temp : ARRAY 16 OF CHAR;
- BEGIN
- Strings.IntToStr(major, string); Strings.Append(string, ".");
- Strings.IntToStr(minor, temp); Strings.Append(string, temp);
- END VersionToString;
- (** SplitName - Split a filename into prefix, middle and suffix, seperated by ".". The prefix may contain dots ("."). *)
- PROCEDURE SplitName(CONST name: ARRAY OF CHAR; VAR pre, mid, suf: ARRAY OF CHAR);
- VAR i, j, d0, d1: LONGINT;
- BEGIN
- i := 0; d0 := -1; d1 := -1;
- WHILE name[i] # 0X DO
- IF name[i] = "." THEN
- d0 := d1;
- d1 := i
- END;
- INC(i)
- END;
- i := 0;
- IF (d0 # -1) & (d1 # d0) THEN (* have prefix *)
- WHILE i # d0 DO pre[i] := name[i]; INC(i) END
- ELSE
- d0 := -1
- END;
- pre[i] := 0X;
- i := d0+1; j := 0;
- WHILE (name[i] # 0X) & (i # d1) DO mid[j] := name[i]; INC(i); INC(j) END;
- mid[j] := 0X; j := 0;
- IF d1 # -1 THEN
- i := d1+1;
- WHILE name[i] # 0X DO suf[j] := name[i]; INC(i); INC(j) END
- END;
- suf[j] := 0X
- END SplitName;
- PROCEDURE CreateContext (VAR name: ARRAY OF CHAR; CONST context: ARRAY OF CHAR);
- VAR temp: Name;
- BEGIN
- IF context # Modules.DefaultContext THEN
- COPY (name, temp);
- COPY (context, name);
- Strings.Append (name, ".");
- Strings.Append (name, temp);
- END;
- END CreateContext;
- PROCEDURE MakeMessage(VAR msg : ARRAY OF CHAR; CONST string, par0, par1 : ARRAY OF CHAR);
- VAR count, m, i, j : LONGINT; par : ARRAY 128 OF CHAR;
- BEGIN
- i := 0; m := 0; j := 0;
- FOR count := 0 TO 3 DO
- WHILE (m < LEN(msg)-1) & (i < LEN(string)) & (string[i] # "#") & (string[i] # 0X) DO
- msg[m] := string[i]; INC(m); INC(i);
- END;
- IF (string[i] = "#") THEN
- INC(i); j := 0;
- IF (count = 0) THEN COPY(par0, par);
- ELSIF (count = 1) THEN COPY(par1, par)
- ELSE par[0] := 0X;
- END;
- WHILE (m < LEN(msg)-1) & (j < LEN(par)) & (par[j] # 0X) DO
- msg[m] := par[j]; INC(m); INC(j);
- END;
- END;
- END;
- msg[m] := 0X;
- END MakeMessage;
- PROCEDURE GetReader(file : File; diagnostics : Diagnostics.Diagnostics) : Streams.Reader;
- VAR
- reader : Streams.Reader;
- fileReader : Files.Reader; ch1, ch2 : CHAR; offset : LONGINT;
- text : Texts.Text; textReader : TextUtilities.TextReader; format, res : LONGINT;
- message : ARRAY 256 OF CHAR;
- BEGIN
- ASSERT((file # NIL) & (diagnostics # NIL));
- reader := NIL;
- IF OptimizedLoads THEN
- IF (file.file = NIL) THEN file.file := Files.Old(file.name); END;
- IF (file.file # NIL) THEN
- Files.OpenReader(fileReader, file.file, 0);
- fileReader.Char(ch1);
- fileReader.Char(ch2);
- IF (ch1= 0F0X) & (ch2 = 01X) THEN (* formatted Oberon text, skip formatting information *)
- fileReader.RawLInt(offset);
- fileReader.SetPos(offset);
- ELSE
- fileReader.SetPos(0);
- END;
- reader := fileReader;
- ELSE
- MakeMessage(message, "Could not open file #", file.name, "");
- diagnostics.Error(file.name, file.pos, message);
- END;
- END;
- IF (reader = NIL) THEN
- NEW(text);
- TextUtilities.LoadAuto(text, file.name, format, res);
- IF (res = 0) THEN
- NEW(textReader, text);
- reader := textReader;
- ELSE
- MakeMessage(message, "Could not open file # (Package = )", file.name, "");
- diagnostics.Error(file.name, file.pos, message);
- END;
- END;
- RETURN reader;
- END GetReader;
- PROCEDURE CallCommand(CONST command, arguments : ARRAY OF CHAR; context : Commands.Context);
- VAR
- newContext : Commands.Context; arg : Streams.StringReader;
- msg : ARRAY 128 OF CHAR; res : WORD;
- BEGIN
- NEW(arg, 256); arg.Set(arguments);
- NEW(newContext, NIL, arg, context.out, context.error, context.caller);
- Commands.Activate(command, newContext, {Commands.Wait}, res, msg);
- IF (res #Commands.Ok) THEN
- context.error.String(msg); context.error.Ln;
- END;
- END CallCommand;
- PROCEDURE ParseBuildDescription*(text : Texts.Text; CONST source: ARRAY OF CHAR; VAR builds : Builds; log: Streams.Writer; diagnostics : Diagnostics.Diagnostics) : BOOLEAN;
- VAR
- parser : Parser; scanner : Scanner;
- reader : Streams.StringReader;
- buffer : POINTER TO ARRAY OF CHAR;
- length : LONGINT;
- BEGIN
- ASSERT((text # NIL) & (diagnostics # NIL));
- text.AcquireRead;
- length := text.GetLength();
- text.ReleaseRead;
- IF length = 0 THEN length := 1 END;
- NEW(buffer, length);
- TextUtilities.TextToStr(text, buffer^);
- NEW(reader, LEN(buffer)); reader.SetRaw(buffer^, 0, LEN(buffer));
- NEW(scanner, source, reader, diagnostics);
- NEW(parser, scanner, log, diagnostics);
- RETURN parser.Parse(builds);
- END ParseBuildDescription;
- PROCEDURE ParseBuildFile*(
- CONST filename : Files.FileName;
- VAR builds : Builds;
- log: Streams.Writer;
- diagnostics : Diagnostics.Diagnostics
- ) : BOOLEAN;
- VAR text : Texts.Text; format, res : LONGINT; message : ARRAY 256 OF CHAR;
- BEGIN
- log.String("Loading package description file "); log.String(filename); log.String(" ... ");
- log.Update;
- NEW(text);
- TextUtilities.LoadAuto(text, filename, format, res);
- IF (res = 0) THEN
- IF ParseBuildDescription(text, filename, builds, log, diagnostics) THEN
- log.String("done."); log.Ln;
- RETURN TRUE;
- ELSE
- log.Ln;
- RETURN FALSE;
- END;
- ELSE
- builds := NIL;
- MakeMessage(message, "Could not open file #", filename, "");
- diagnostics.Error("", Streams.Invalid, message);
- RETURN FALSE;
- END;
- END ParseBuildFile;
- PROCEDURE ParseText(
- text : Texts.Text;
- CONST source: ARRAY OF CHAR;
- pos: LONGINT; (* ignore *)
- CONST pc, opt: ARRAY OF CHAR;
- log: Streams.Writer; diagnostics : Diagnostics.Diagnostics; VAR error: BOOLEAN);
- VAR
- options : POINTER TO ARRAY OF CHAR;
- builds : Builds;
- BEGIN
- NEW(options,LEN(opt));
- ASSERT((text # NIL) & (diagnostics # NIL));
- error := ~ParseBuildDescription(text, source, builds, log, diagnostics);
- IF ~error THEN
- COPY(opt, options^);
- Strings.TrimWS(options^);
- IF (builds # NIL) & (options^ = "\check") THEN
- builds.CheckAll(log, diagnostics);
- END;
- END;
- IF error THEN
- log.String(" not done");
- ELSE
- log.String(" done");
- END;
- log.Update;
- END ParseText;
- PROCEDURE CheckBuilds(builds : Builds; nofWorkers : LONGINT; context : Commands.Context; diagnostics : Diagnostics.DiagnosticsList);
- VAR
- build : LONGINT; ignore : Streams.StringWriter; error, ignoreError, checkAll : BOOLEAN;
- PROCEDURE CreateRamDisk(context : Commands.Context) : BOOLEAN;
- VAR res : WORD; msg : ARRAY 128 OF CHAR; fs : Files.FileSystem;
- BEGIN
- Commands.Call("FSTools.Mount CHECKBUILDS RamFS 500000 4096", {Commands.Wait}, res, msg);
- IF (res # Commands.Ok) THEN
- context.error.String(msg); context.error.Ln;
- END;
- fs := Files.This("CHECKBUILDS");
- RETURN fs # NIL;
- END CreateRamDisk;
- PROCEDURE UnmountRamDisk(context : Commands.Context);
- VAR res : WORD; msg : ARRAY 128 OF CHAR;
- BEGIN
- Commands.Call("FSTools.Unmount CHECKBUILDS", {Commands.Wait}, res, msg);
- IF (res # Commands.Ok) THEN
- context.error.String(msg); context.error.Ln;
- END;
- END UnmountRamDisk;
- PROCEDURE DeleteFiles(CONST pattern : ARRAY OF CHAR);
- VAR
- enum : Files.Enumerator; flags : SET; time, date, size : LONGINT; name : Files.FileName;
- res : WORD;
- BEGIN
- NEW(enum); enum.Open(pattern, {});
- WHILE enum.GetEntry(name, flags, time, date, size) DO
- Files.Delete(name, res);
- END;
- enum.Close;
- END DeleteFiles;
- PROCEDURE DoCheckAll(builds : Builds) : BOOLEAN;
- VAR i : LONGINT; all : BOOLEAN;
- BEGIN
- ASSERT(builds # NIL);
- all := TRUE;
- WHILE all & (i < LEN(builds.builds)) & (builds.builds[i] # NIL) DO
- all := builds.builds[i].marked;
- INC(i);
- END;
- RETURN all;
- END DoCheckAll;
- BEGIN
- ASSERT((builds # NIL) & (context # NIL) &(diagnostics # NIL));
- checkAll := DoCheckAll(builds);
- IF checkAll THEN
- builds.CheckAll(context.out, diagnostics);
- END;
- IF (diagnostics.nofErrors = 0) THEN
- IF CreateRamDisk(context) THEN
- IF (diagnostics.nofErrors = 0) THEN
- NEW(ignore, 1);
- WHILE (build < LEN(builds.builds)) & (builds.builds[build] # NIL) DO
- diagnostics.Reset;
- IF ~checkAll OR ~builds.builds[build].disabled THEN
- error := FALSE;
- IF ~checkAll & builds.builds[build].marked THEN
- builds.builds[build].CheckFiles(diagnostics);
- builds.builds[build].CheckModules(diagnostics, error);
- END;
- IF ~error & builds.builds[build].marked THEN
- COPY("CHECKBUILDS:", builds.builds[build].path);
- (*
- COPY("Obt", builds.builds[build].extension);
- COPY("386", builds.builds[build].target);
- *)
- builds.builds[build].Compile(nofWorkers, context.out, context.error, FALSE, diagnostics, ignoreError);
- DeleteFiles("CHECKBUILDS:*.Obw");
- DeleteFiles("CHECKBUILDS:*.Obt");
- DeleteFiles("CHECKBUILDS:*.Obx");
- DeleteFiles("CHECKBUILDS:*.Sym");
- DeleteFiles("CHECKBUILDS:*.Gof");
- ELSE
- diagnostics.ToStream(context.out, Diagnostics.All);
- END;
- ELSE
- context.out.String("Build "); context.out.String(builds.builds[build].name);
- context.out.String(" is disabled."); context.out.Ln;
- END;
- context.out.Update; context.error.Update;
- INC(build);
- END;
- diagnostics.Reset; (* all error messages already shown *)
- ELSE
- diagnostics.ToStream(context.error, Diagnostics.All); context.error.Ln;
- END;
- UnmountRamDisk(context);
- ELSE
- context.error.String("Could not create RAM disk"); context.error.Ln;
- END;
- ELSE
- diagnostics.ToStream(context.out, Diagnostics.All);
- END;
- END CheckBuilds;
- (** Find files that match the filemask but are not listed in the build description file *)
- PROCEDURE CheckFiles*(context : Commands.Context); (** [Options] filemask ~*)
- VAR
- options : Options.Options; diagnostics : Diagnostics.Diagnostics;
- builds : Builds;
- buildFile, mask, fullname, path, filename : Files.FileName;
- enumerator : Files.Enumerator;
- flags : SET;
- ignore : LONGINT;
- BEGIN
- NEW(options);
- options.Add("f", "file", Options.String);
- IF options.Parse(context.arg, context.error) THEN
- COPY(DefaultPackagesFile, buildFile);
- IF options.GetString("file", buildFile) THEN END;
- IF context.arg.GetString(mask) THEN
- NEW(diagnostics);
- IF ParseBuildFile(buildFile, builds, context.out, diagnostics) THEN
- NEW(enumerator); enumerator.Open(mask, {});
- WHILE enumerator.GetEntry(fullname, flags, ignore, ignore, ignore) DO
- IF ~(Files.Directory IN flags) THEN
- Files.SplitPath(fullname, path, filename);
- IF (builds.FindFile(filename) = NIL) THEN
- context.out.String(filename); context.out.Ln;
- END;
- END;
- END;
- enumerator.Close;
- END;
- ELSE
- context.error.String("Expected mask argument."); context.error.Ln;
- END;
- END;
- END CheckFiles;
- (** Find the text position where the specified file could be inserted into the build description file *)
- PROCEDURE FindPosition*(context : Commands.Context); (** [Options] buildname modulename ~ *)
- VAR
- builds : Builds; build : BuildObj;
- buildFile, filename : Files.FileName; buildName : Name;
- diagnostics : Diagnostics.DiagnosticsList;
- position : LONGINT;
- options : Options.Options;
- BEGIN
- NEW(options);
- options.Add("f", "file", Options.String);
- IF options.Parse(context.arg, context.error) THEN
- COPY(DefaultPackagesFile, buildFile);
- IF options.GetString("file", buildFile) THEN END;
- context.arg.SkipWhitespace; context.arg.String(buildName);
- context.arg.SkipWhitespace; context.arg.String(filename);
- IF (buildName # "") & (filename # "") THEN
- NEW(diagnostics);
- IF ParseBuildFile(buildFile, builds, context.out, diagnostics) THEN
- build := builds.GetBuild(buildName);
- IF (build # NIL) THEN
- position := build.FindPosition(filename, diagnostics);
- IF (position # -1) THEN
- context.out.String("First text position where the file "); context.out.String(filename);
- context.out.String(" could be inserted: "); context.out.Int(position, 0); context.out.Ln;
- ELSE
- diagnostics.ToStream(context.error, {0..31}); context.error.Ln;
- END;
- ELSE
- context.error.String("Build "); context.error.String(buildName); context.error.String(" not found");
- context.error.Update;
- END;
- ELSE
- diagnostics.ToStream(context.error, {0..31}); context.error.Ln;
- END;
- ELSE
- context.error.String("Usage: Release.FindPosition Release.Tool [options] buildname filename ~ ");
- END;
- END;
- END FindPosition;
- (** Analyze the builds *)
- PROCEDURE Analyze*(context : Commands.Context); (** [Options] ~ *)
- VAR filename : Files.FileName; builds : Builds; diagnostics : Diagnostics.DiagnosticsList; options : Options.Options;
- BEGIN
- NEW(options);
- options.Add("d", "details", Options.Flag);
- options.Add("f", "file", Options.String);
- IF options.Parse(context.arg, context.error) THEN
- COPY(DefaultPackagesFile, filename);
- IF options.GetString("file", filename) THEN END;
- IF (filename # "") THEN
- NEW(diagnostics);
- IF ParseBuildFile(filename, builds, context.out, diagnostics) THEN
- builds.Show(context.out, options.GetFlag("details"));
- ELSE
- diagnostics.ToStream(context.error, Diagnostics.All); context.error.Ln;
- END;
- ELSE
- context.error.String("Usage: Release.Analyze [options] ~"); context.error.Ln;
- END;
- END;
- END Analyze;
- (** Build specified build (or all of none specified) to a RAM disk *)
- PROCEDURE Check*(context : Commands.Context); (** [Options] {buildname} ~ *)
- VAR
- filename : Files.FileName; builds : Builds; diagnostics : Diagnostics.DiagnosticsList;
- options : Options.Options; nofWorkers : LONGINT;
- PROCEDURE MarkBuilds(context : Commands.Context; builds : Builds) : BOOLEAN;
- VAR build : BuildObj; name : Name; nofMarked, i : LONGINT; error : BOOLEAN;
- BEGIN
- ASSERT((context # NIL) & (builds # NIL));
- nofMarked := 0;
- REPEAT
- name := "";
- context.arg.SkipWhitespace; context.arg.String(name);
- Strings.TrimWS(name);
- IF (name # "") THEN
- build := builds.GetBuild(name);
- IF (build # NIL) THEN
- INC(nofMarked);
- build.marked := TRUE;
- ELSE
- error := TRUE;
- context.error.String("Build "); context.error.String(name);
- context.error.String(" not found."); context.error.Ln;
- END;
- END;
- UNTIL (name = "");
- IF ~error & (nofMarked = 0) THEN
- FOR i := 0 TO LEN(builds.builds) - 1 DO
- IF (builds.builds[i] # NIL) THEN builds.builds[i].marked := TRUE; END;
- END;
- END;
- RETURN ~error;
- END MarkBuilds;
- BEGIN
- NEW(options);
- options.Add("f", "file", Options.String);
- IF options.Parse(context.arg, context.error) THEN
- COPY(DefaultPackagesFile, filename);
- IF options.GetString("file", filename) THEN END;
- IF (filename # "") THEN
- NEW(diagnostics);
- IF ParseBuildFile(filename, builds, context.out, diagnostics) THEN
- IF MarkBuilds(context, builds) THEN
- IF ~options.GetInteger("workers", nofWorkers) THEN nofWorkers := 0; END;
- CheckBuilds(builds, nofWorkers, context, diagnostics);
- END;
- ELSE
- diagnostics.ToStream(context.error, Diagnostics.All); context.error.Ln;
- END;
- ELSE
- context.error.String('Usage: Release.Check [options] ~'); context.error.Ln;
- END;
- END;
- END Check;
- PROCEDURE CheckDiagnostics(diagnostics : Diagnostics.DiagnosticsList; warnings: BOOLEAN; out : Streams.Writer) : BOOLEAN;
- BEGIN
- ASSERT((diagnostics # NIL) & (out # NIL));
- IF (diagnostics.nofErrors = 0) & (diagnostics.nofMessages > 0) THEN
- IF warnings THEN diagnostics.ToStream(out, Diagnostics.All)
- ELSE diagnostics.ToStream(out, {Diagnostics.TypeInformation, Diagnostics.TypeError})
- END;
- out.Update;
- diagnostics.Reset;
- END;
- RETURN diagnostics.nofErrors = 0;
- END CheckDiagnostics;
- PROCEDURE ImportInformation(mode : LONGINT; context : Commands.Context);
- VAR
- options : Options.Options; diagnostics : Diagnostics.DiagnosticsList;
- builds : Builds; build : BuildObj;
- filename : Files.FileName;
- modulename : Modules.Name;
- buildname : Name;
- error : BOOLEAN;
- BEGIN
- NEW(options);
- options.Add("f", "file", Options.String);
- options.Add(0X, "exclude", Options.String);
- IF options.Parse(context.arg, context.error) THEN
- IF ~options.GetString("file", filename) THEN COPY(DefaultPackagesFile, filename); END;
- modulename := "";
- context.arg.SkipWhitespace; context.arg.String(buildname);
- context.arg.SkipWhitespace; context.arg.String(modulename);
- IF (modulename # "") THEN
- NEW(diagnostics);
- IF ParseBuildFile(filename, builds, context.out, diagnostics) THEN
- IF CheckDiagnostics(diagnostics, FALSE, context.out) THEN
- build := builds.GetBuild(buildname);
- IF (build # NIL) THEN
- build.SetOptions(options);
- build.DoChecks(context.out, diagnostics, error);
- IF ~error THEN
- build.AnalyzeDependencies(context.out);
- build.ShowDependentModules(modulename, mode, context.out);
- context.out.Ln; context.out.Update;
- END;
- ELSE
- context.out.String("Build "); context.out.String(buildname); context.out.String(" not found"); context.out.Ln;
- context.result := Commands.CommandError;
- END;
- END;
- END;
- IF (diagnostics.nofMessages > 0) THEN
- diagnostics.ToStream(context.out, Diagnostics.All);
- END;
- IF error OR (diagnostics.nofErrors > 0) THEN
- context.result := Commands.CommandError;
- END;
- ELSE
- context.out.String("Usage: Release.WhoImports [options] buildname modulename ~"); context.out.Ln;
- context.result := Commands.CommandParseError;
- END;
- ELSE
- context.result := Commands.CommandParseError;
- END;
- END ImportInformation;
- PROCEDURE WhoImports*(context : Commands.Context);
- BEGIN
- ImportInformation(Mode_ShowImporting, context);
- END WhoImports;
- PROCEDURE RequiredModules*(context : Commands.Context);
- BEGIN
- ImportInformation(Mode_ShowImported, context);
- END RequiredModules;
- PROCEDURE Rebuild*(context : Commands.Context); (** [Options] buildname {filenames} ~ *)
- VAR
- options : Options.Options;
- diagnostics : Diagnostics.DiagnosticsList;
- builds : Builds; build : BuildObj;
- packagename, filename, fullname : Files.FileName;
- nofNewMarks, nofMarks : LONGINT;
- inBuild : BOOLEAN;
- buildname : ARRAY 32 OF CHAR;
- start0 : Dates.DateTime;
- error : BOOLEAN;
- nofWorkers, res : LONGINT;
- BEGIN
- NEW(options);
- options.Add("b", "build", Options.Flag);
- options.Add("c", "compiler", Options.String);
- options.Add("e", "extension", Options.String);
- options.Add("f", "file", Options.String);
- options.Add("o", "options", Options.String);
- options.Add("p", "path", Options.String);
- options.Add("t", "target", Options.String);
- options.Add("v", "verbose", Options.Flag);
- options.Add("w", "workers", Options.Integer);
- options.Add("y", "", Options.Flag);
- IF options.Parse(context.arg, context.error) THEN
- COPY(DefaultPackagesFile, packagename);
- IF options.GetString("file", packagename) THEN END;
- context.arg.SkipWhitespace; context.arg.String(buildname);
- IF (packagename # "") & (buildname # "") THEN
- start0 := Dates.Now();
- NEW(diagnostics);
- IF ParseBuildFile(packagename, builds, context.out, diagnostics) THEN
- build := builds.GetBuild(buildname);
- IF (build # NIL) THEN
- IF build.disabled THEN
- context.out.String("Warning: Build "); context.out.String(build.name);
- context.out.String(" is disabled."); context.out.Ln;
- context.out.Update;
- END;
- build.SetOptions(options);
- build.DoChecks(context.out, diagnostics, error);
- IF CheckDiagnostics(diagnostics, FALSE, context.out) & ~error THEN
- build.AnalyzeDependencies(context.out);
- build.ClearMarks;
- filename := ""; error := FALSE; nofMarks := 0;
- LOOP
- context.arg.SkipWhitespace; context.arg.String(filename);
- IF (filename = "") THEN EXIT; END;
- IF (Files.Old(filename) # NIL) THEN
- build.MarkFiles(filename, inBuild, nofNewMarks);
- IF inBuild THEN
- nofMarks := nofMarks + nofNewMarks;
- ELSE
- context.out.String("Warning: No depenencies on file "); context.out.String(filename);
- context.out.String("."); context.out.Ln; context.out.Update;
- END;
- ELSE
- context.out.String("Error: File "); context.out.String(filename);
- context.out.String(" does not exist."); context.out.Ln; context.out.Update;
- context.result := Commands.CommandError;
- error := TRUE;
- END;
- END;
- IF ~error THEN
- context.out.Int(nofMarks, 0); context.out.String(" files selected for compilation."); context.out.Ln;
- context.out.Update;
- IF ~options.GetString("path", fullname) THEN fullname := ""; END;
- Strings.Append(fullname, ToolFilename);
- context.out.String("Writing release file to "); context.out.String(fullname);
- context.out.String(" ... "); context.out.Update;
- build.GenerateToolFile(fullname, res);
- IF (res = 0) THEN
- context.out.String("done."); context.out.Ln; context.out.Update;
- IF options.GetFlag("build") THEN
- IF ~options.GetInteger("workers", nofWorkers) THEN nofWorkers := 0; END;
- build.Compile(nofWorkers, context.out, context.error, options.GetFlag("verbose"), diagnostics, error);
- ELSE
- CallCommand("Notepad.Open", fullname, context);
- END;
- ELSE
- IF ~options.GetFlag("build") THEN
- CallCommand("Notepad.Open", fullname, context);
- END;
- context.out.String("error, res: "); context.out.Int(res, 0); context.out.Ln;
- context.result := Commands.CommandError;
- END;
- END;
- END;
- ELSE
- context.error.String("Build "); context.error.String(buildname); context.error.String(" not found."); context.error.Ln;
- context.result := Commands.CommandError;
- END;
- END;
- IF (diagnostics.nofMessages > 0) THEN
- diagnostics.ToStream(context.out, Diagnostics.All);
- context.out.Ln;
- END;
- IF error OR (diagnostics.nofErrors > 0) THEN
- context.result := Commands.CommandError;
- END;
- ELSE
- context.error.String('Usage: Release.ReBuild [options] BuildName {filenames}'); context.error.Ln;
- context.result := Commands.CommandParseError;
- END;
- ELSE
- context.result := Commands.CommandParseError;
- END;
- END Rebuild;
- (** Build the specified build *)
- PROCEDURE Build*(context : Commands.Context); (** [Options] buildname ~ *)
- VAR
- filename, fullname : Files.FileName;
- builds : Builds; build : BuildObj;
- diagnostics : Diagnostics.DiagnosticsList;
- options : Options.Options;
- buildname : ARRAY 32 OF CHAR;
- start0 : Dates.DateTime;
- error : BOOLEAN;
- nofWorkers, res : LONGINT;
- BEGIN
- NEW(options);
- options.Add("b", "build", Options.Flag);
- options.Add("c", "compiler", Options.String);
- options.Add(0X, "exclude", Options.String);
- options.Add(0X, "only", Options.String);
- options.Add("e", "extension", Options.String);
- options.Add("f", "file", Options.String);
- options.Add("l", "link", Options.Flag);
- options.Add(0X, "list", Options.Flag);
- options.Add("n", "nocheck", Options.Flag);
- options.Add("o", "options", Options.String);
- options.Add("p", "path", Options.String);
- options.Add("s", "symbolFileExtension", Options.String);
- options.Add("t", "target", Options.String);
- options.Add("v", "verbose", Options.Flag);
- options.Add(0X, "workers", Options.Integer);
- options.Add("x", "xml", Options.Flag);
- options.Add("y", "", Options.Flag);
- options.Add("z", "zip", Options.Flag);
- options.Add("w","warnings",Options.Flag);
- IF options.Parse(context.arg, context.error) THEN
- COPY(DefaultPackagesFile, filename);
- IF options.GetString("file", filename) THEN END;
- context.arg.SkipWhitespace; context.arg.String(buildname);
- IF (filename # "") & (buildname # "") THEN
- start0 := Dates.Now();
- NEW(diagnostics);
- IF ParseBuildFile(filename, builds, context.out, diagnostics) THEN
- build := builds.GetBuild(buildname);
- IF (build # NIL) THEN
- IF build.disabled THEN
- context.out.String("Warning: Build "); context.out.String(build.name);
- context.out.String(" is disabled."); context.out.Ln;
- context.out.Update;
- END;
- build.SetOptions(options);
- IF ~options.GetInteger("workers", nofWorkers) THEN nofWorkers := 0; END;
- IF ~options.GetFlag("nocheck") THEN
- build.DoChecks(context.out, diagnostics, error);
- ELSIF (nofWorkers > 0) THEN
- context.error.String("Incompatible options: nocheck cannot be combined with workers");
- context.error.Ln; context.error.Update;
- context.result := Commands.CommandError;
- RETURN;
- END;
- IF CheckDiagnostics(diagnostics, options.GetFlag("warnings"), context.out) & ~error THEN
- IF options.GetFlag("list") THEN
- build.ToStream(context.out, 0); context.out.Ln;
- ELSE
- IF ~options.GetString("path", fullname) THEN fullname := ""; END;
- Strings.Append(fullname, ToolFilename);
- context.out.String("Writing release file to "); context.out.String(fullname);
- context.out.String(" ... "); context.out.Update;
- build.GenerateToolFile(fullname, res);
- IF (res = 0) THEN
- context.out.String("done."); context.out.Ln; context.out.Update;
- IF options.GetFlag("build") THEN
- IF options.GetFlag("link") THEN
- context.error.String("Incompatible options: link cannot automatically build");
- context.error.Ln; context.error.Update;
- context.result := Commands.CommandError;
- RETURN;
- END;
- build.Compile(nofWorkers, context.out, context.error, options.GetFlag("verbose"), diagnostics, error);
- ELSIF ~options.GetFlag("zip") THEN
- CallCommand("Notepad.Open", fullname, context);
- END;
- IF ~error & options.GetFlag("zip") & CheckDiagnostics(diagnostics, options.GetFlag("warnings"), context.out) THEN
- build.GenerateZipFiles(context.out, context.error, diagnostics, error);
- END;
- IF ~error & options.GetFlag("xml") THEN
- IF ~options.GetString("path", fullname) THEN fullname := ""; END;
- Strings.Append(fullname, InstallerPackageFile);
- context.out.String("Writing XML package description to "); context.out.String(fullname);
- context.out.String(" ... "); context.out.Update;
- build.GeneratePackageFile(InstallerPackageFile, res);
- IF (res = Files.Ok) THEN
- context.out.String("done.");
- ELSE
- context.out.String("error, res: "); context.out.Int(res, 0);
- context.result := Commands.CommandError;
- END;
- context.out.Ln;
- END;
- ELSE
- IF ~options.GetFlag("build") THEN
- CallCommand("Notepad.Open", fullname, context);
- END;
- context.out.String("error, res: "); context.out.Int(res, 0); context.out.Ln;
- END;
- END;
- END;
- ELSE
- context.error.String("Build "); context.error.String(buildname); context.error.String(" not found."); context.error.Ln;
- context.result := Commands.CommandError;
- END;
- END;
- IF (diagnostics.nofMessages > 0) THEN
- IF options.GetFlag("warnings") THEN
- diagnostics.ToStream(context.out, Diagnostics.All);
- ELSE
- diagnostics.ToStream(context.out, {Diagnostics.TypeError, Diagnostics.TypeInformation});
- END;
- context.out.Ln;
- END;
- IF error OR (diagnostics.nofErrors > 0) THEN
- context.result := Commands.CommandError;
- END;
- ELSE
- context.error.String('Usage: Release.Build [options] BuildName'); context.error.Ln;
- context.result := Commands.CommandParseError;
- END;
- ELSE
- context.result := Commands.CommandParseError;
- END;
- END Build;
- PROCEDURE Cleanup;
- BEGIN
- CompilerInterface.Unregister("ReleaseTool");
- END Cleanup;
- BEGIN
- CompilerInterface.Register("ReleaseTool", "Parse release description file", "Tool", ParseText);
- Modules.InstallTermHandler(Cleanup);
- END Release.
- System.Free Release ~
- Release.FindPosition Bios32 Usbdi.Mod ~
- Release.Analyze --details ~
- Release.Check ~
- Release.Build Bios32 ~
- Release.Build --path="../Test/" -b Bios32 ~
- Release.Build --path="../Test/" --xml Bios32 ~
- Release.CheckFiles -f=C2Release.Tool ../../CF/trunk/source/*.* ~
- Release.Build --path="../Test/" -z Bios32 ~
- Release.RequiredModules Bios32 WMTextView ~
- Release.WhoImports Bios32 WMComponents ~
- Release.Tool ~
- Release.Build --path="../Test" -b -x="Build Oberon Contributions " Bios32 ~
- Release.Rebuild -b Bios32 WMTextView.Mod ~
|