123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578 |
- MODULE Visualizer; (** AUTHOR "staubesv"; PURPOSE "Generate class diagrams that can be visualized using graphviz"; *)
- (**
- * This tool generates textual descriptions for class diagrams in the DOT language. These descriptions can be converted in to graphs (postscript, bitmaps,...)
- * using the freeware tool graphviz (www.graphviz.org).
- *
- * Usage:
- *
- * Visualizer.Generate [options] filename {filename} ~
- *
- * Usage example:
- *
- * Visualizer.Generate --size="A3" --mode=2 --file="graph.txt" WMComponents.Mod ~ generates the file graph.txt
- *
- * Options:
- *
- * General:
- *
- * -s / --size A0, A1, ..., A10 paper size
- * -l / --landscape paper orientation = landscape (portrait otherwise)
- * -f / --file filename output filename
- * -o / --options string graph options for graphviz, e.g. --options='page = "A1"'
- * -e / --exclude string Whitespace-separated list of modules to be excluded from graph
- *
- * Visibilities:
- *
- * -h / --hasA none, public, all If none, no hasA relations are shown. If public, only hasA relations that are established by
- * public fields are shown. All hasA relations are shown when set this to 'all'
- * -d / --dependencies none, public, all Also include types that are parameters of procedures?
- * -t / --types none, pubilc, all Determines which type declarations are included
- * -v / --variables none, pubilc, all Determines which variables/fields are included
- * -p / --procedures none, public, all Determines which procedures are included
- *
- * Mode:
- *
- * -a / --all Show all type declarations (otherwise objects, records and pointer to records only)
- * -m / --mode Processing mode:
- * 0: Simple. Only show information that is provided directly by parsed modules
- * 1: Recursive, depth = :, if a type information is not available by the parsed modules, parse the module
- * that provides it and include it
- * 2: Recursive, depth = infinity: Do the same as for mode=1, but repeat this until all type information
- * is available
- *
- * Status: BETA
- *)
- IMPORT
- Streams, KernelLog, Commands, Options, Strings, Files, Texts, TextUtilities, Diagnostics, FoxScanner, ModuleParser;
- CONST
- None = 0;
- Public = 1;
- All = 2;
- DefaultTypes = All;
- DefaultVariables = Public;
- DefaultProcedures = Public;
- DefaultHasA = Public;
- DefaultDependencies = None;
- DefaultOutputFilename = "graph.txt";
- DependsOnFactor = 0.1;
- HasAFactor = 0.3;
- NodeFontName = "Arial";
- NodeFontSize = 48;
- (* Generator states *)
- Initialized = 0;
- Running = 1;
- Stopped = 2;
- (* Generator modes *)
- Simple = 0; (* default *)
- Better = 1;
- Extreme = 2;
- (* ModuleEntry.flags *)
- AddSuperType = 0;
- Parsed = 1;
- ScannedSuperTypes = 2;
- TYPE
- SizeString = ARRAY 16 OF CHAR;
- Entry = POINTER TO RECORD
- name : ARRAY 256 OF CHAR;
- isSetSuperClass : BOOLEAN;
- next : Entry;
- END;
- List = OBJECT
- VAR
- head : Entry;
- PROCEDURE Add(CONST name : ARRAY OF CHAR) : BOOLEAN;
- VAR entry : Entry;
- BEGIN {EXCLUSIVE}
- IF (Find(name) = NIL) THEN
- NEW(entry);
- COPY(name, entry.name);
- entry.isSetSuperClass := FALSE;
- entry.next := head.next;
- head.next := entry;
- RETURN TRUE;
- ELSE
- RETURN FALSE;
- END;
- END Add;
- PROCEDURE SetSuperClass(CONST name : ARRAY OF CHAR);
- VAR entry : Entry;
- BEGIN {EXCLUSIVE}
- entry := Find(name);
- IF (entry # NIL) THEN
- entry.isSetSuperClass := TRUE;
- END;
- END SetSuperClass;
- PROCEDURE IsSetSuperClass(CONST name : ARRAY OF CHAR) : BOOLEAN;
- VAR entry : Entry;
- BEGIN {EXCLUSIVE}
- entry := Find(name);
- IF (entry # NIL) THEN
- RETURN entry.isSetSuperClass;
- ELSE
- RETURN TRUE;
- END;
- END IsSetSuperClass;
- PROCEDURE Find(CONST name : ARRAY OF CHAR) : Entry; (* private *)
- VAR entry : Entry;
- BEGIN
- entry := head.next;
- WHILE (entry # NIL) & (entry.name # name) DO entry := entry.next; END;
- RETURN entry;
- END Find;
- PROCEDURE &Init; (* private *)
- BEGIN
- NEW(head); head.name := ""; head.next := NIL;
- END Init;
- END List;
- TYPE
- ModuleEntry = OBJECT
- VAR
- name : ARRAY 128 OF CHAR;
- module : ModuleParser.Module;
- flags : SET;
- next : ModuleEntry;
- PROCEDURE &Init(CONST name : ARRAY OF CHAR; module : ModuleParser.Module);
- BEGIN
- COPY(name, SELF.name);
- SELF.module := module;
- flags := {AddSuperType};
- next := NIL;
- END Init;
- END ModuleEntry;
- ModuleArray = POINTER TO ARRAY OF ModuleEntry;
- EnumeratorProc = PROCEDURE {DELEGATE} (entry : ModuleEntry; indent : LONGINT);
- ModuleList = OBJECT
- VAR
- head : ModuleEntry;
- nofEntries : LONGINT;
- PROCEDURE Add(CONST name : ARRAY OF CHAR; module : ModuleParser.Module) : BOOLEAN;
- VAR entry : ModuleEntry;
- BEGIN {EXCLUSIVE}
- IF (FindByNameX(name) = NIL) THEN
- NEW(entry, name, module);
- entry.next := head.next;
- head.next := entry;
- INC(nofEntries);
- RETURN TRUE;
- ELSE
- RETURN FALSE;
- END;
- END Add;
- PROCEDURE GetAll() : ModuleArray;
- VAR array : ModuleArray; entry : ModuleEntry; i : LONGINT;
- BEGIN {EXCLUSIVE}
- IF (nofEntries > 0) THEN
- NEW(array, nofEntries);
- entry := head.next;
- i := 0;
- WHILE (entry # NIL) DO
- array[i] := entry; INC(i);
- entry := entry.next;
- END;
- ELSE
- array := NIL;
- END;
- RETURN array;
- END GetAll;
- PROCEDURE Enumerate(proc : EnumeratorProc; indent : LONGINT);
- VAR array : ModuleArray; i : LONGINT;
- BEGIN
- array := GetAll();
- IF (array # NIL) THEN
- FOR i := 0 TO LEN(array)-1 DO
- IF (array[i] # NIL) THEN
- proc(array[i], indent);
- END;
- END;
- END;
- END Enumerate;
- PROCEDURE FindByName(CONST name : ARRAY OF CHAR) : ModuleEntry;
- BEGIN {EXCLUSIVE}
- RETURN FindByNameX(name);
- END FindByName;
- PROCEDURE FindByNameX(CONST name : ARRAY OF CHAR) : ModuleEntry;
- VAR entry : ModuleEntry;
- BEGIN
- entry := head.next;
- WHILE (entry # NIL) & (entry.name # name) DO entry := entry.next; END;
- RETURN entry;
- END FindByNameX;
- PROCEDURE InclFlag(CONST name : ARRAY OF CHAR; flag : LONGINT);
- VAR entry : ModuleEntry;
- BEGIN {EXCLUSIVE}
- entry := FindByNameX(name);
- IF (entry # NIL) THEN INCL(entry.flags, flag); END;
- END InclFlag;
- PROCEDURE ExclFlag(CONST name : ARRAY OF CHAR; flag : LONGINT);
- VAR entry : ModuleEntry;
- BEGIN {EXCLUSIVE}
- entry := FindByNameX(name);
- IF (entry # NIL) THEN EXCL(entry.flags, flag); END;
- END ExclFlag;
- PROCEDURE &Init;
- BEGIN
- NEW(head, "", NIL);
- nofEntries := 0;
- END Init;
- END ModuleList;
- Edge = POINTER TO RECORD
- from, to : ARRAY 128 OF CHAR;
- count : LONGINT;
- next : Edge;
- END;
- EdgeEnumerator = PROCEDURE {DELEGATE} (edge : Edge);
- EdgeList = OBJECT
- VAR
- head : Edge;
- PROCEDURE Add(CONST from, to : ARRAY OF CHAR);
- VAR edge : Edge;
- BEGIN
- edge := Find(from, to);
- IF (edge = NIL) THEN
- NEW(edge);
- COPY(from, edge.from);
- COPY(to, edge.to);
- edge.count := 1;
- edge.next := head.next;
- head.next := edge;
- ELSE
- INC(edge.count);
- END;
- END Add;
- PROCEDURE Find(CONST from, to : ARRAY OF CHAR) : Edge;
- VAR edge : Edge;
- BEGIN
- edge := head.next;
- WHILE (edge # NIL) & ((edge.from # from) OR (edge.to # to)) DO edge := edge.next; END;
- RETURN edge;
- END Find;
- PROCEDURE Enumerate(proc : EdgeEnumerator);
- VAR edge : Edge;
- BEGIN
- edge := head.next;
- WHILE (edge # NIL) DO
- proc(edge);
- edge := edge.next;
- END;
- END Enumerate;
- PROCEDURE &Init;
- BEGIN
- NEW(head); head.next := NIL;
- END Init;
- END EdgeList;
- TYPE
- Generator = OBJECT
- VAR
- out : Streams.Writer;
- list : List;
- modules : ModuleList;
- types, variables, procedures, hasA, dependencies : LONGINT; (* Enumeration: None | Public | All *)
- showAllTypes : BOOLEAN;
- mode : LONGINT;
- hasAEdges, dependsOnEdges : EdgeList;
- excludedModules : Strings.StringArray;
- state : LONGINT;
- PROCEDURE &Init(out : Streams.Writer); (* private *)
- BEGIN
- ASSERT(out # NIL);
- SELF.out := out;
- NEW(list);
- NEW(modules);
- NEW(hasAEdges); NEW(dependsOnEdges);
- state := Initialized;
- mode := Simple;
- END Init;
- PROCEDURE Visibility(identDef : ModuleParser.IdentDef);
- BEGIN
- ASSERT(identDef # NIL);
- IF (identDef.vis = ModuleParser.Public) THEN out.Char("+");
- ELSIF (identDef.vis = ModuleParser.PublicRO) THEN out.Char("-");
- END;
- END Visibility;
- PROCEDURE IsPublic(identDef : ModuleParser.IdentDef) :BOOLEAN;
- BEGIN
- ASSERT(identDef # NIL);
- RETURN (identDef.vis = ModuleParser.Public) OR (identDef.vis = ModuleParser.PublicRO);
- END IsPublic;
- PROCEDURE FormalPars(formalPars : ModuleParser.FormalPars);
- VAR module : ModuleParser.Module; fullname : ARRAY 256 OF CHAR; fpSection : ModuleParser.FPSection; ident : ModuleParser.IdentList;
- BEGIN
- IF (formalPars # NIL) THEN
- fpSection := formalPars.fpSectionList;
- out.Char("(");
- WHILE (fpSection # NIL) DO
- IF (fpSection.var) THEN out.String("VAR "); END;
- IF (fpSection.const) THEN out.String("CONST "); END;
- ident := fpSection.identList;
- WHILE (ident # NIL) DO
- Type(fpSection.type);
- IF (ident.next # NIL) THEN
- out.Char(",");
- ident := ident.next (ModuleParser.IdentList);
- ELSE
- ident := NIL;
- END;
- END;
- IF (fpSection.next # NIL) THEN
- fpSection := fpSection.next (ModuleParser.FPSection);
- out.Char(",");
- ELSE
- fpSection := NIL;
- END;
- END;
- out.Char(")");
- module := formalPars.GetModule();
- IF (formalPars.returnType # NIL) THEN
- out.String(" : "); Type(formalPars.returnType);
- END;
- END;
- END FormalPars;
- PROCEDURE Array(array : ModuleParser.Array);
- BEGIN
- ASSERT(array # NIL);
- out.String("ARRAY ");
- IF ~array.open THEN
- out.String(array.len.name^); out.Char(" ");
- END;
- out.String("OF ");
- Type(array.base);
- END Array;
- PROCEDURE Type(type : ModuleParser.Type);
- VAR module : ModuleParser.Module; name : Strings.String; fullname : ARRAY 256 OF CHAR;
- BEGIN
- ASSERT(type # NIL);
- module := type.GetModule();
- IF (type.qualident # NIL) THEN
- FixTypeName(module, type.qualident.ident.name^, fullname);
- out.String(fullname);
- ELSIF (type.array # NIL) THEN
- Array(type.array);
- ELSIF (type.record # NIL) THEN
- name := GetTypeName(type);
- FixTypeName(module, name^, fullname);
- out.String(fullname);
- ELSIF (type.pointer # NIL) THEN
- out.String("POINTER TO "); Type(type.pointer.type);
- ELSIF (type.object # NIL) THEN
- FixTypeName(module, type.parent(ModuleParser.TypeDecl).identDef.ident.name^, fullname);
- out.String(fullname);
- ELSIF (type.procedure # NIL) THEN
- out.String("PROCEDURE ");
- IF (type.procedure.delegate) THEN out.String("[DELEGATE] "); END;
- FormalPars(type.procedure.formalPars);
- END;
- END Type;
- PROCEDURE Variable(identList : ModuleParser.IdentList; type : ModuleParser.Type);
- BEGIN
- ASSERT((identList # NIL) & (type # NIL));
- WHILE (identList # NIL) DO
- Visibility(identList.identDef); out.Char(" ");
- IF IsPublic(identList.identDef) OR (variables = All) THEN
- out.String(identList.identDef.ident.name^);
- out.String(" : ");
- Type(type);
- out.String("\l");
- END;
- IF (identList.next # NIL) THEN
- identList := identList.next (ModuleParser.IdentList);
- ELSE
- identList := NIL;
- END;
- END;
- END Variable;
- PROCEDURE VarDecl(varDecl : ModuleParser.VarDecl);
- BEGIN
- WHILE (varDecl # NIL) DO
- Variable(varDecl.identList, varDecl.type);
- IF (varDecl.next # NIL) THEN
- varDecl := varDecl.next (ModuleParser.VarDecl);
- ELSE
- varDecl := NIL;
- END;
- END;
- END VarDecl;
- PROCEDURE ProcHead(procHead : ModuleParser.ProcHead);
- BEGIN
- ASSERT(procHead # NIL);
- IF IsPublic(procHead.identDef) THEN out.String("+ "); END;
- IF (procHead.constructor) THEN out.String("& "); END;
- IF (procHead.inline) THEN out.String("[inline] "); END;
- out.String(procHead.identDef.ident.name^);
- FormalPars(procHead.formalPars);
- out.String("\l");
- END ProcHead;
- PROCEDURE ProcDecl(procDecl : ModuleParser.ProcDecl);
- BEGIN
- WHILE (procDecl # NIL) DO
- IF IsPublic(procDecl.head.identDef) OR (procedures = All) THEN
- ProcHead(procDecl.head);
- END;
- IF (procDecl.next # NIL) THEN
- procDecl := procDecl.next (ModuleParser.ProcDecl);
- ELSE
- procDecl := NIL;
- END;
- END;
- END ProcDecl;
- PROCEDURE FieldDecl(fieldDecl : ModuleParser.FieldDecl);
- BEGIN
- WHILE (fieldDecl # NIL) DO
- IF (fieldDecl.identList # NIL) & (fieldDecl.type # NIL) THEN
- Variable(fieldDecl.identList, fieldDecl.type);
- END;
- IF (fieldDecl.next # NIL) THEN
- fieldDecl := fieldDecl.next (ModuleParser.FieldDecl);
- ELSE
- fieldDecl := NIL;
- END;
- END;
- END FieldDecl;
- PROCEDURE TypeDecl(typeDecl : ModuleParser.TypeDecl; indent : LONGINT);
- BEGIN
- ASSERT(typeDecl # NIL);
- FixTypeDeclName(typeDecl);
- IF list.Add(typeDecl.identDef.ident.name^) THEN
- IF ((typeDecl.type.object # NIL) OR (typeDecl.type.record # NIL) OR ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.record # NIL))) & (IsPublic(typeDecl.identDef) OR (types = All)) THEN
- Indent(indent + 4); out.Char('"'); out.String(typeDecl.identDef.ident.name^);
- out.Char('"'); out.String(" ["); out.Ln;
- IF (typeDecl.type.object # NIL) & (ModuleParser.Active IN typeDecl.type.object.modifiers) THEN
- Indent(indent + 8); out.String('color = "red"'); out.Ln;
- END;
- Indent(indent + 8); out.String('label = "{'); out.String(typeDecl.identDef.ident.name^); Visibility(typeDecl.identDef);
- IF (procedures # None) OR (variables # None) THEN
- IF (typeDecl.type.object # NIL) THEN
- out.String("|");
- IF (typeDecl.type.object.declSeq # NIL) & (variables # None) THEN
- VarDecl(typeDecl.type.object.declSeq.varDecl);
- END;
- out.String("|");
- IF (typeDecl.type.object.declSeq # NIL) & (procedures # None) THEN
- ProcDecl(typeDecl.type.object.declSeq.procDecl);
- END;
- ELSIF (typeDecl.type.record # NIL) OR ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.record # NIL)) THEN
- out.String("|");
- IF (variables # None) THEN
- IF (typeDecl.type.record # NIL) THEN
- FieldDecl(typeDecl.type.record.fieldList);
- ELSE
- FieldDecl(typeDecl.type.pointer.type.record.fieldList);
- END;
- END;
- END;
- END;
- out.String('}"'); out.Ln;
- Indent(indent + 4); out.String("]"); out.Ln;
- ELSIF showAllTypes & ((types = All) OR IsPublic(typeDecl.identDef)) THEN
- Indent(indent + 4); out.Char('"'); out.String(typeDecl.identDef.ident.name^);
- out.Char('"'); out.String(" ["); out.Ln;
- Indent(indent + 8); out.String('color = blue'); out.Ln;
- Indent(indent + 8); out.String('label = "{'); out.String(typeDecl.identDef.ident.name^); Visibility(typeDecl.identDef);
- IF (typeDecl.type.qualident # NIL) THEN
- out.String("|"); out.String(typeDecl.type.qualident.ident.name^);
- ELSIF (typeDecl.type.array # NIL) THEN
- out.String("|"); Array(typeDecl.type.array);
- ELSIF (typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.array # NIL) THEN
- out.String("| POINTER TO "); Array(typeDecl.type.pointer.type.array);
- ELSIF (typeDecl.type.procedure # NIL) THEN
- out.String("| PROCEDURE ");
- IF (typeDecl.type.procedure.delegate) THEN out.String("[DELEGATE] "); END;
- FormalPars(typeDecl.type.procedure.formalPars);
- END;
- out.String('}"'); out.Ln;
- Indent(indent + 4); out.String("]"); out.Ln;
- END;
- END;
- END TypeDecl;
- PROCEDURE Module(module : ModuleParser.Module; indent : LONGINT);
- BEGIN
- ASSERT(module # NIL);
- Indent(indent); out.String("subgraph cluster"); out.String(module.ident.name^); out.String(" {"); out.Ln;
- Indent(indent + 4); out.String('label = "'); out.String(module.ident.name^); out.String('"'); out.Ln;
- Indent(indent + 4); out.String('bgcolor = "grey96"'); out.Ln;
- Indent(indent + 4); out.String('margin = "2,2"'); out.Ln;
- GenerateNodes(module, indent + 4);
- GenerateModuleNode(module, indent + 4);
- Indent(indent); out.String("}"); out.Ln;
- END Module;
- PROCEDURE GenerateModuleNode(module : ModuleParser.Module; indent : LONGINT);
- BEGIN
- ASSERT(module # NIL);
- IF (module.declSeq # NIL) THEN
- Indent(indent + 4); out.Char('"'); out.String("Module"); out.String(module.ident.name^);
- out.Char('"'); out.String(" ["); out.Ln;
- Indent(indent + 8); out.String('label = "{'); out.String("MODULE "); out.String(module.ident.name^);
- out.String("|");
- IF (module.declSeq.varDecl # NIL) & (variables # None) THEN
- VarDecl(module.declSeq.varDecl);
- END;
- out.String("|");
- IF (module.declSeq.procDecl # NIL) & (procedures # None) THEN
- ProcDecl(module.declSeq.procDecl);
- END;
- out.String('}"'); out.Ln;
- Indent(indent + 4); out.String("]"); out.Ln;
- END;
- END GenerateModuleNode;
- PROCEDURE GenerateNodes(module : ModuleParser.Module; indent : LONGINT);
- VAR typeDecl : ModuleParser.TypeDecl;
- BEGIN
- ASSERT(module # NIL);
- IF (module.declSeq # NIL) & (module.declSeq.typeDecl # NIL) THEN
- typeDecl := module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- TypeDecl(typeDecl, indent);
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- END;
- END GenerateNodes;
- PROCEDURE AddEdge(CONST from, to : ARRAY OF CHAR; indent : LONGINT);
- BEGIN
- Indent(indent);
- out.Char('"'); out.String(from); out.String('" -> "'); out.String(to); out.Char('"'); out.Ln;
- END AddEdge;
- PROCEDURE GenerateHasAEdges(entry : ModuleEntry; indent : LONGINT);
- VAR
- typeDecl : ModuleParser.TypeDecl;
- PROCEDURE AtLeastOneIdentIsPublic(identList : ModuleParser.IdentList) : BOOLEAN;
- BEGIN
- WHILE (identList # NIL) & ~IsPublic(identList.identDef) DO
- IF (identList.next # NIL) THEN
- identList := identList.next (ModuleParser.IdentList);
- ELSE
- identList := NIL;
- END;
- END;
- RETURN identList # NIL;
- END AtLeastOneIdentIsPublic;
- PROCEDURE GetTargetNodeName(CONST name : ARRAY OF CHAR; entry : ModuleEntry) : Strings.String;
- VAR targetNodeName : Strings.String; typeDecl : ModuleParser.TypeDecl;
- BEGIN
- typeDecl := FindTypeDecl(name, entry);
- IF (typeDecl # NIL) & (typeDecl.type # NIL) & ((showAllTypes) OR
- ((typeDecl.type.object # NIL) OR (typeDecl.type.record # NIL) OR ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.record # NIL))))
- THEN
- targetNodeName := GetTypeName(typeDecl.type);
- ELSE
- targetNodeName := NIL;
- END;
- RETURN targetNodeName
- END GetTargetNodeName;
- PROCEDURE GenerateObjectFieldEdges(object : ModuleParser.Object; entry : ModuleEntry);
- VAR varDecl : ModuleParser.VarDecl; name : Strings.String; fullname : ARRAY 128 OF CHAR;
- BEGIN
- ASSERT(object # NIL);
- IF (object.declSeq # NIL) THEN
- varDecl := typeDecl.type.object.declSeq.varDecl;
- WHILE (varDecl # NIL) DO
- IF (varDecl.type.qualident # NIL) & ((hasA = All) OR AtLeastOneIdentIsPublic(varDecl.identList)) THEN
- FixTypeName(entry.module, varDecl.type.qualident.ident.name^, fullname);
- name := GetTargetNodeName(fullname, entry);
- IF (name # NIL) THEN
- hasAEdges.Add(typeDecl.identDef.ident.name^, name^);
- ELSIF ~IsBasicType(varDecl.type.qualident.ident.name^) THEN
- KernelLog.String("Object type not found: "); KernelLog.String(fullname);
- KernelLog.Ln;
- END;
- END;
- IF (varDecl.next # NIL) THEN
- varDecl := varDecl.next (ModuleParser.VarDecl);
- ELSE
- varDecl := NIL;
- END;
- END;
- END;
- END GenerateObjectFieldEdges;
- PROCEDURE GenerateRecordFieldEdges(record : ModuleParser.Record; entry : ModuleEntry);
- VAR fieldDecl : ModuleParser.FieldDecl; name : Strings.String;
- BEGIN
- ASSERT(record # NIL);
- fieldDecl := record.fieldList;
- WHILE (fieldDecl # NIL) DO
- IF (fieldDecl.type # NIL) & (fieldDecl.type.qualident # NIL) & ((hasA = All) OR AtLeastOneIdentIsPublic(fieldDecl.identList)) THEN
- name := GetTargetNodeName(fieldDecl.type.qualident.ident.name^, entry);
- IF (name # NIL) THEN
- hasAEdges.Add(typeDecl.identDef.ident.name^, name^);
- ELSIF ~IsBasicType(fieldDecl.type.qualident.ident.name^) THEN
- KernelLog.String("Record type not found: "); KernelLog.String(fieldDecl.type.qualident.ident.name^);
- KernelLog.Ln;
- END;
- END;
- IF (fieldDecl.next # NIL) THEN
- fieldDecl := fieldDecl.next (ModuleParser.FieldDecl);
- ELSE
- fieldDecl := NIL;
- END;
- END;
- END GenerateRecordFieldEdges;
- PROCEDURE GenerateArrayBaseEdge(array : ModuleParser.Array; entry : ModuleEntry);
- VAR name : Strings.String;
- BEGIN
- IF (array.base.qualident # NIL) THEN
- name := GetTargetNodeName(array.base.qualident.ident.name^, entry);
- IF (name # NIL) THEN
- hasAEdges.Add(typeDecl.identDef.ident.name^, name^);
- ELSIF ~IsBasicType(array.base.qualident.ident.name^) THEN
- KernelLog.String("Array type not found: "); KernelLog.String(array.base.qualident.ident.name^);
- KernelLog.Ln;
- END;
- END;
- END GenerateArrayBaseEdge;
- BEGIN
- IF (entry.module # NIL) & (entry.module.declSeq # NIL) THEN
- typeDecl := entry.module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- IF (typeDecl.type.object # NIL) THEN
- GenerateObjectFieldEdges(typeDecl.type.object, entry);
- ELSIF (typeDecl.type.record # NIL) THEN
- GenerateRecordFieldEdges(typeDecl.type.record, entry);
- ELSIF ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.record # NIL)) THEN
- GenerateRecordFieldEdges(typeDecl.type.pointer.type.record, entry);
- ELSIF showAllTypes THEN
- IF (typeDecl.type.array # NIL) THEN
- GenerateArrayBaseEdge(typeDecl.type.array, entry);
- ELSIF ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.array # NIL)) THEN
- GenerateArrayBaseEdge(typeDecl.type.pointer.type.array, entry);
- END;
- END;
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- END;
- END GenerateHasAEdges;
- PROCEDURE GenerateDependsOnEdges(entry : ModuleEntry; indent : LONGINT);
- VAR typeDecl : ModuleParser.TypeDecl;
- PROCEDURE CheckProcedures(procDecl : ModuleParser.ProcDecl);
- VAR
- typeName : Strings.String; fpSection : ModuleParser.FPSection; td : ModuleParser.TypeDecl;
- fullname, temp : ARRAY 128 OF CHAR;
- BEGIN
- WHILE (procDecl # NIL) DO
- IF (procDecl.head.formalPars # NIL) THEN
- fpSection := procDecl.head.formalPars.fpSectionList;
- WHILE (fpSection # NIL) DO
- IF (fpSection.type.qualident # NIL) THEN
- IF ~IsBasicType(fpSection.type.qualident.ident.name^) THEN
- td := FindTypeDecl(fpSection.type.qualident.ident.name^, entry);
- IF (td # NIL) THEN
- FixTypeName(entry.module, fpSection.type.qualident.ident.name^, fullname);
- IF ~Strings.ContainsChar(fullname, ".", FALSE) THEN
- COPY(fullname, temp);
- COPY(entry.module.ident.name^, fullname);
- Strings.Append(fullname, "."); Strings.Append(fullname, temp);
- END;
- dependsOnEdges.Add(typeDecl.identDef.ident.name^, fullname);
- ELSE
- KernelLog.String("Type "); KernelLog.String(fpSection.type.qualident.ident.name^);
- KernelLog.String(" not found"); KernelLog.Ln;
- END;
- END;
- ELSE
- typeName := GetTypeName(fpSection.type);
- IF (typeName # NIL) THEN
- dependsOnEdges.Add(typeDecl.identDef.ident.name^, typeName^);
- END;
- END;
- IF (fpSection.next # NIL) THEN
- fpSection := fpSection.next (ModuleParser.FPSection);
- ELSE
- fpSection := NIL;
- END;
- END;
- END;
- IF (procDecl.next # NIL) THEN
- procDecl := procDecl.next (ModuleParser.ProcDecl);
- ELSE
- procDecl := NIL;
- END;
- END;
- END CheckProcedures;
- BEGIN
- IF (entry.module # NIL) & (entry.module.declSeq # NIL) THEN
- typeDecl := entry.module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- IF (typeDecl.type.object # NIL) & (typeDecl.type.object.declSeq # NIL) THEN
- CheckProcedures(typeDecl.type.object.declSeq.procDecl);
- END;
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- END;
- END GenerateDependsOnEdges;
- PROCEDURE GenerateEdges(entry : ModuleEntry; indent : LONGINT);
- VAR typeDecl : ModuleParser.TypeDecl; object : ModuleParser.Object; record : ModuleParser.Record; name, name2 : Strings.String;
- PROCEDURE GetRecordName(record : ModuleParser.Record) : Strings.String;
- BEGIN
- ASSERT(record # NIL);
- IF (record.parent.parent IS ModuleParser.TypeDecl) THEN
- RETURN record.parent.parent(ModuleParser.TypeDecl).identDef.ident.name;
- ELSE
- RETURN record.parent.parent.parent.parent(ModuleParser.TypeDecl).identDef.ident.name;
- END;
- END GetRecordName;
- BEGIN
- IF (entry.module # NIL) & (entry.module.declSeq # NIL) & (entry.module.declSeq.typeDecl # NIL) THEN
- typeDecl := entry.module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- IF (typeDecl.type.record # NIL) OR ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.record # NIL)) THEN
- IF (typeDecl.type.record # NIL) THEN
- record := typeDecl.type.record;
- ELSE
- record := typeDecl.type.pointer.type.record;
- END;
- WHILE (record.superPtr # NIL) DO
- name := GetRecordName(record);
- IF ~list.IsSetSuperClass(name^) THEN
- list.SetSuperClass(name^);
- IF (record.superPtr.parent.parent IS ModuleParser.TypeDecl) THEN
- FixTypeDeclName(record.superPtr.parent.parent(ModuleParser.TypeDecl));
- ELSE
- FixTypeDeclName(record.superPtr.parent.parent.parent.parent(ModuleParser.TypeDecl));
- END;
- name2 := GetRecordName(record.superPtr);
- AddEdge(name^, name2^, indent);
- END;
- record := record.superPtr;
- END;
- ELSIF (typeDecl.type.object # NIL) THEN
- object := typeDecl.type.object;
- WHILE (object.superPtr # NIL) DO
- IF ~list.IsSetSuperClass(object.parent.parent(ModuleParser.TypeDecl).identDef.ident.name^) THEN
- list.SetSuperClass(object.parent.parent(ModuleParser.TypeDecl).identDef.ident.name^);
- FixTypeDeclName(object.superPtr.parent.parent(ModuleParser.TypeDecl));
- AddEdge(
- object.parent.parent(ModuleParser.TypeDecl).identDef.ident.name^,
- object.superPtr.parent.parent(ModuleParser.TypeDecl).identDef.ident.name^,
- indent
- );
- END;
- object := object.superPtr;
- END;
- END;
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- END;
- END GenerateEdges;
- PROCEDURE AddSuperTypesSimple(entry : ModuleEntry; indent : LONGINT);
- VAR superClass : ModuleParser.Object; superRecord : ModuleParser.Record; typeDecl : ModuleParser.TypeDecl;
- BEGIN
- IF (AddSuperType IN entry.flags) & (entry.module # NIL) & (entry.module.declSeq # NIL) & (entry.module.declSeq.typeDecl # NIL) THEN
- typeDecl := entry.module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- IF (typeDecl.type.object # NIL) THEN
- superClass := typeDecl.type.object.superPtr;
- WHILE (superClass # NIL) DO
- TypeDecl(superClass.parent.parent(ModuleParser.TypeDecl), indent);
- superClass := superClass.superPtr;
- END;
- ELSIF (typeDecl.type.record # NIL) OR ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.record # NIL)) THEN
- IF (typeDecl.type.record # NIL) THEN
- superRecord := typeDecl.type.record.superPtr;
- ELSE
- superRecord := typeDecl.type.pointer.type.record.superPtr;
- END;
- WHILE (superRecord # NIL) DO
- IF (superRecord.parent.parent IS ModuleParser.TypeDecl) THEN
- TypeDecl(superRecord.parent.parent(ModuleParser.TypeDecl), indent);
- ELSE
- TypeDecl(superRecord.parent.parent.parent.parent(ModuleParser.TypeDecl), indent);
- END;
- superRecord := superRecord.superPtr;
- END;
- END;
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- END;
- END AddSuperTypesSimple;
- PROCEDURE AddSuperTypeModulesToList(entry : ModuleEntry; indent : LONGINT);
- VAR
- superClass : ModuleParser.Object; superRecord : ModuleParser.Record;
- typeDecl : ModuleParser.TypeDecl;
- module : ModuleParser.Module;
- moduleName, typeName : ARRAY 128 OF CHAR;
- ignore : BOOLEAN;
- BEGIN
- IF (AddSuperType IN entry.flags) & ~(ScannedSuperTypes IN entry.flags) & (entry.module # NIL) & (entry.module.declSeq # NIL) & (entry.module.declSeq.typeDecl # NIL) THEN
- typeDecl := entry.module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- IF (typeDecl.type.object # NIL) THEN
- superClass := typeDecl.type.object.superPtr;
- WHILE (superClass # NIL) DO
- module := superClass.GetModule();
- IF (module # NIL) & (module # entry.module) THEN
- IF ~IsExcluded(module.ident.name^) THEN
- ignore := modules.Add(module.ident.name^, NIL);
- END;
- ELSIF (superClass.parent.parent IS ModuleParser.TypeDecl) THEN
- ModuleParser.SplitName(superClass.parent.parent(ModuleParser.TypeDecl).identDef.ident.name^, moduleName, typeName);
- IF ~IsExcluded(moduleName) THEN
- ignore := modules.Add(moduleName, NIL);
- END;
- ELSE
- KernelLog.String("BOOM1: ");
- KernelLog.String(superClass.parent.parent(ModuleParser.TypeDecl).identDef.ident.name^); KernelLog.Ln;
- END;
- superClass := superClass.superPtr;
- END;
- ELSIF (typeDecl.type.record # NIL) OR ((typeDecl.type.pointer # NIL) & (typeDecl.type.pointer.type.record # NIL)) THEN
- IF (typeDecl.type.record # NIL) THEN
- superRecord := typeDecl.type.record.superPtr;
- ELSE
- superRecord := typeDecl.type.pointer.type.record.superPtr;
- END;
- WHILE (superRecord # NIL) DO
- module := superRecord.GetModule();
- IF (module # NIL) & (module # entry.module) THEN
- IF ~IsExcluded(module.ident.name^) THEN
- ignore := modules.Add(module.ident.name^, NIL);
- END;
- ELSIF (superRecord.parent.parent IS ModuleParser.TypeDecl) THEN
- ModuleParser.SplitName(superRecord.parent.parent(ModuleParser.TypeDecl).identDef.ident.name^, moduleName, typeName);
- IF ~IsExcluded(moduleName) THEN
- ignore := modules.Add(moduleName, NIL);
- END;
- ELSE
- KernelLog.String("BOOM2"); KernelLog.Ln;
- END;
- superRecord := superRecord.superPtr;
- END;
- END;
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- modules.InclFlag(entry.module.ident.name^, ScannedSuperTypes);
- END;
- END AddSuperTypeModulesToList;
- PROCEDURE AddUsedTypeModulesToList(entry : ModuleEntry; ident : LONGINT);
- VAR
- typeDecl : ModuleParser.TypeDecl; varDecl : ModuleParser.VarDecl;
- moduleName, typeName : ARRAY 128 OF CHAR;
- fullname : ARRAY 256 OF CHAR;
- ignore : BOOLEAN;
- BEGIN
- IF (entry.module # NIL) & (entry.module.declSeq # NIL) THEN
- typeDecl := entry.module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- IF (typeDecl.type.object # NIL) & (typeDecl.type.object.declSeq # NIL) THEN
- varDecl := typeDecl.type.object.declSeq.varDecl;
- WHILE (varDecl # NIL) DO
- IF (varDecl.type.qualident # NIL) THEN
- FixTypeName(entry.module, varDecl.type.qualident.ident.name^, fullname);
- ModuleParser.SplitName(fullname, moduleName, typeName);
- IF (moduleName # "") & (moduleName # entry.name) THEN
- IF ~IsExcluded(moduleName) THEN
- ignore := modules.Add(moduleName, NIL);
- END
- END;
- END;
- IF (varDecl.next # NIL) THEN
- varDecl := varDecl.next (ModuleParser.VarDecl);
- ELSE
- varDecl := NIL;
- END;
- END;
- END;
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- END;
- END AddUsedTypeModulesToList;
- PROCEDURE AddDependeciesModulesToList(entry : ModuleEntry; ident : LONGINT);
- VAR
- typeDecl : ModuleParser.TypeDecl; procDecl : ModuleParser.ProcDecl;
- moduleName, typeName : ARRAY 128 OF CHAR;
- PROCEDURE CheckFPSection(fpSection : ModuleParser.FPSection);
- VAR type : ModuleParser.Type; ignore : BOOLEAN;
- BEGIN
- ASSERT((fpSection # NIL) & (fpSection.type # NIL));
- type := fpSection.type;
- IF (type.object # NIL) THEN
- ELSIF (type.record # NIL) THEN
- ELSIF (type.pointer # NIL) & (type.pointer.type.record # NIL) THEN
- ELSIF (type.qualident # NIL) & ~IsBasicType(type.qualident.ident.name^) THEN
- ModuleParser.SplitName(type.qualident.ident.name^, moduleName, typeName);
- IF (moduleName # "") & (moduleName # entry.module.ident.name^) THEN
- IF ~IsExcluded(moduleName) THEN
- ignore := modules.Add(moduleName, NIL);
- END;
- END;
- END;
- END CheckFPSection;
- PROCEDURE CheckProcDecl(entry : ModuleEntry; procDecl : ModuleParser.ProcDecl);
- VAR fpSection : ModuleParser.FPSection;
- BEGIN
- ASSERT((procDecl # NIL) & (procDecl.head # NIL));
- IF (procDecl.head.formalPars # NIL) & (procDecl.head.formalPars.fpSectionList # NIL) THEN
- fpSection := procDecl.head.formalPars.fpSectionList;
- WHILE (fpSection # NIL) DO
- CheckFPSection(fpSection);
- IF (fpSection.next # NIL) THEN
- fpSection := fpSection.next (ModuleParser.FPSection);
- ELSE
- fpSection := NIL;
- END;
- END;
- END;
- END CheckProcDecl;
- BEGIN
- ASSERT(entry # NIL);
- IF (entry.module # NIL) & (entry.module.declSeq # NIL) THEN
- typeDecl := entry.module.declSeq.typeDecl;
- WHILE (typeDecl # NIL) DO
- IF (typeDecl.type.object # NIL) & (typeDecl.type.object.declSeq # NIL) THEN
- procDecl := typeDecl.type.object.declSeq.procDecl;
- WHILE (procDecl # NIL) DO
- CheckProcDecl(entry, procDecl);
- IF (procDecl.next # NIL) THEN
- procDecl := procDecl.next (ModuleParser.ProcDecl);
- ELSE
- procDecl := NIL;
- END;
- END;
- END;
- IF (typeDecl.next # NIL) THEN
- typeDecl := typeDecl.next (ModuleParser.TypeDecl);
- ELSE
- typeDecl := NIL;
- END;
- END;
- END;
- END AddDependeciesModulesToList;
- PROCEDURE FindTypeDecl(CONST name : ARRAY OF CHAR; entry : ModuleEntry) : ModuleParser.TypeDecl;
- VAR
- moduleName, typeName, fullname : ARRAY 128 OF CHAR;
- e : ModuleEntry;
- typeDecl : ModuleParser.TypeDecl;
- BEGIN
- typeDecl := NIL;
- ModuleParser.SplitName(name, moduleName, typeName);
- IF ~IsBasicType(typeName) & (moduleName # "SYSTEM") THEN
- IF (moduleName = entry.name) OR (moduleName = "") THEN
- COPY(entry.module.ident.name^, fullname); Strings.Append(fullname, "."); Strings.Append(fullname, typeName);
- typeDecl := entry.module.FindTypeDecl(fullname);
- ELSE
- e := modules.FindByName(moduleName);
- IF (e # NIL) & (e.module # NIL) THEN
- FixTypeName(e.module, name, fullname);
- typeDecl := e.module.FindTypeDecl(fullname);
- END;
- END;
- END;
- RETURN typeDecl;
- END FindTypeDecl;
- PROCEDURE ParseModule(entry : ModuleEntry; ident : LONGINT);
- VAR filename : Files.FileName; file : Files.File;
- BEGIN
- IF (entry.name # "SYSTEM") & (entry.module = NIL) & ~(Parsed IN entry.flags) THEN
- COPY(entry.name, filename); Strings.Append(filename, ".Mod");
- file := Files.Old(filename);
- IF (file = NIL) THEN
- KernelLog.String("Visualizer: Cannot open file "); KernelLog.String(filename); KernelLog.String(", try I386.");
- KernelLog.String(filename); KernelLog.String(" ... ");
- filename := "I386."; Strings.Append(filename, entry.name); Strings.Append(filename, ".Mod");
- file := Files.Old(filename);
- IF (file # NIL) THEN
- KernelLog.String("found!");
- ELSE
- KernelLog.String("not found!, Trying Oberon."); KernelLog.String(entry.name); KernelLog.String(" ... ");
- filename := "Oberon-"; Strings.Append(filename, entry.name); Strings.Append(filename, ".Mod");
- file := Files.Old(filename);
- IF (file # NIL) THEN
- KernelLog.String("found!");
- ELSE
- KernelLog.String("not found! Giving up...");
- END;
- END;
- KernelLog.Ln;
- END;
- IF (file # NIL) THEN
- ParseFile(filename, entry.module);
- modules.InclFlag(entry.name, Parsed);
- IF (entry.module # NIL) THEN
- Module(entry.module, 4);
- END;
- ELSE
- KernelLog.String("Visualizer: File "); KernelLog.String(filename); KernelLog.String(" not found - ignore!");
- KernelLog.Ln;
- END;
- END;
- END ParseModule;
- PROCEDURE AddTypes;
- VAR done : BOOLEAN; nofEntries : LONGINT;
- BEGIN
- IF (mode = Simple) THEN
- IF (hasA # None) THEN modules.Enumerate(AddUsedTypeModulesToList, 4); END;
- IF (dependencies # None) THEN modules.Enumerate(AddDependeciesModulesToList, 4); END;
- modules.Enumerate(AddSuperTypesSimple, 4);
- ELSIF (mode = Better) THEN
- modules.Enumerate(AddSuperTypeModulesToList, 4);
- IF (hasA # None) THEN modules.Enumerate(AddUsedTypeModulesToList, 4); END;
- IF (dependencies # None) THEN modules.Enumerate(AddDependeciesModulesToList, 4); END;
- modules.Enumerate(ParseModule, 0);
- modules.Enumerate(AddSuperTypesSimple, 4);
- ELSIF (mode = Extreme) THEN
- done := FALSE;
- WHILE ~done DO
- nofEntries := modules.nofEntries;
- modules.Enumerate(AddSuperTypeModulesToList, 4);
- IF (hasA # None) THEN modules.Enumerate(AddUsedTypeModulesToList, 4); END;
- IF (dependencies # None) THEN modules.Enumerate(AddDependeciesModulesToList, 4); END;
- modules.Enumerate(ParseModule, 0);
- done := nofEntries = modules.nofEntries;
- END;
- modules.Enumerate(AddSuperTypesSimple, 4);
- END;
- END AddTypes;
- PROCEDURE ProcessOptions(options : Options.Options);
- VAR string : ARRAY 512 OF CHAR; integer : LONGINT; sizeString : SizeString; i : LONGINT;
- BEGIN
- sizeString := "";
- IF options.GetString("size", string) THEN
- GetSizeString(string, sizeString);
- END;
- IF options.GetFlag("landscape")THEN
- Rotate(sizeString);
- END;
- IF (sizeString # "") THEN
- Indent(4); out.String('size = "'); out.String(sizeString); out.String('"'); out.Ln;
- END;
- IF options.GetInteger("mode", integer) THEN
- IF (0 <= integer) & (integer <= Extreme) THEN
- SELF.mode := integer;
- END;
- END;
- IF options.GetString("options", string) THEN
- Indent(4); out.String(string); out.Ln;
- END;
- IF options.GetFlag("all") THEN showAllTypes := TRUE; ELSE showAllTypes := FALSE; END;
- IF options.GetString("types", string) THEN
- types := GetMode(string);
- ELSE
- types := DefaultTypes;
- END;
- IF options.GetString("variables", string) THEN
- variables := GetMode(string);
- ELSE
- variables := DefaultVariables;
- END;
- IF options.GetString("procedures", string) THEN
- procedures := GetMode(string);
- ELSE
- procedures := DefaultProcedures;
- END;
- IF options.GetString("hasA", string) THEN
- hasA := GetMode(string);
- ELSE
- hasA := DefaultHasA;
- END;
- IF options.GetString("dependencies", string) THEN
- dependencies := GetMode(string);
- ELSE
- dependencies := DefaultDependencies;
- END;
- IF options.GetString("exclude", string) THEN
- excludedModules := Strings.Split(string, " ");
- FOR i := 0 TO LEN(excludedModules)-1 DO
- Strings.TrimWS(excludedModules[i]^);
- END;
- ELSE
- excludedModules := NIL;
- END;
- END ProcessOptions;
- PROCEDURE IsExcluded(CONST moduleName : ARRAY OF CHAR) : BOOLEAN;
- VAR i : LONGINT;
- BEGIN
- IF (excludedModules # NIL) THEN
- FOR i := 0 TO LEN(excludedModules)-1 DO
- IF (moduleName = excludedModules[i]^) THEN RETURN TRUE; END;
- END;
- END;
- RETURN FALSE;
- END IsExcluded;
- PROCEDURE Open(options : Options.Options);
- BEGIN
- ASSERT(options # NIL);
- ASSERT(state = Initialized);
- state := Running;
- out.String("digraph TEST"); out.String(" {"); out.Ln;
- ProcessOptions(options);
- Indent(4); out.String('rankdir = "BT"'); out.Ln;
- Indent(4); out.String('ranksep = "0.5"'); out.Ln;
- Indent(4); out.String('ratio = "compress"'); out.Ln;
- Indent(4); out.String('remincross = "true"'); out.Ln;
- IF options.GetFlag("landscape") THEN
- Indent(4); out.String('orientation = "landscape"'); out.Ln;
- END;
- Indent(4); out.String("node ["); out.Ln;
- Indent(8); out.String('fontname = "'); out.String(NodeFontName); out.String('"'); out.Ln;
- Indent(8); out.String('fontsize = "'); out.Int(NodeFontSize, 0); out.String('"'); out.Ln;
- Indent(8); out.String('shape = "record"'); out.Ln;
- Indent(4); out.String("]"); out.Ln;
- END Open;
- PROCEDURE AddModule(module : ModuleParser.Module; indent : LONGINT);
- BEGIN
- ASSERT(module # NIL);
- ASSERT(state = Running);
- IF modules.Add(module.ident.name^, module) THEN
- modules.InclFlag(module.ident.name^, Parsed);
- Module(module, indent);
- END;
- END AddModule;
- PROCEDURE WriteHasAEdge(edge : Edge);
- BEGIN
- Indent(4);
- out.Char('"'); out.String(edge.from); out.String('" -> "'); out.String(edge.to); out.Char('"');
- out.String(" [weight = "); out.FloatFix(HasAFactor * edge.count, 4, 1, 0); out.String("]"); out.Ln;
- END WriteHasAEdge;
- PROCEDURE WriteDependsOnEdge(edge : Edge);
- BEGIN
- Indent(4);
- out.Char('"'); out.String(edge.from); out.String('" -> "'); out.String(edge.to); out.Char('"');
- out.String(" [weight = "); out.FloatFix(DependsOnFactor * edge.count, 4, 1, 0); out.String("]"); out.Ln;
- END WriteDependsOnEdge;
- PROCEDURE Close;
- VAR array : ModuleArray; i : LONGINT;
- BEGIN
- ASSERT(state = Running);
- AddTypes;
- KernelLog.String("Included modules: ");
- array := modules.GetAll();
- FOR i := 0 TO LEN(array)-1 DO
- KernelLog.String(array[i].name); KernelLog.String(" ");
- END;
- KernelLog.Ln;
- Indent(4); out.String("edge ["); out.Ln;
- Indent(8); out.String('arrowhead = "normal"'); out.Ln;
- Indent(8); out.String('arrowtail = "none"'); out.Ln;
- Indent(8); out.String('arrowsize = "4.0"'); out.Ln;
- Indent(8); out.String('penwidth = "5"'); out.Ln;
- Indent(8); out.String('color = "black"'); out.Ln;
- Indent(8); out.String('weight = 100'); out.Ln;
- Indent(4); out.String("]"); out.Ln;
- modules.Enumerate(GenerateEdges, 4);
- IF (hasA # None) THEN
- Indent(4); out.String("edge ["); out.Ln;
- Indent(8); out.String('arrowhead = "none"'); out.Ln;
- Indent(8); out.String('arrowtail = "diamond"'); out.Ln;
- Indent(8); out.String('arrowsize = "2.0"'); out.Ln;
- Indent(8); out.String('penwidth = "1"'); out.Ln;
- Indent(8); out.String('color = "blue"'); out.Ln;
- Indent(4); out.String("]"); out.Ln;
- modules.Enumerate(GenerateHasAEdges, 4);
- hasAEdges.Enumerate(WriteHasAEdge);
- END;
- IF (dependencies # None) THEN
- Indent(4); out.String("edge ["); out.Ln;
- Indent(8); out.String('arrowhead = "normal"'); out.Ln;
- Indent(8); out.String('arrowtail = "none"'); out.Ln;
- Indent(8); out.String('arrowsize = "2.0"'); out.Ln;
- Indent(8); out.String('penwidth = "1"'); out.Ln;
- Indent(8); out.String('color = "green"'); out.Ln;
- Indent(8); out.String('style = "dashed"'); out.Ln;
- Indent(4); out.String("]"); out.Ln;
- modules.Enumerate(GenerateDependsOnEdges, 4);
- dependsOnEdges.Enumerate(WriteDependsOnEdge);
- END;
- state := Stopped;
- out.String("}");
- out.Update;
- END Close;
- PROCEDURE Indent(indent : LONGINT); (* private *)
- BEGIN
- WHILE (indent > 0) DO out.Char(" "); DEC(indent); END;
- END Indent;
- END Generator;
- PROCEDURE FixTypeName(module : ModuleParser.Module; CONST name : ARRAY OF CHAR; VAR fullname : ARRAY OF CHAR);
- VAR modulename, importname, typename : ARRAY 256 OF CHAR;
- BEGIN
- ModuleParser.SplitName(name, modulename, typename);
- IF (modulename # "") THEN (* replace import alias by module name *)
- IF (module # NIL) THEN
- FindImport(modulename, module, importname);
- ELSE
- importname := "";
- END;
- IF (modulename # importname) & (importname # "") THEN
- COPY(importname, fullname);
- Strings.Append(fullname, "."); Strings.Append(fullname, typename);
- ELSE
- COPY(name, fullname);
- END;
- ELSE
- COPY(name, fullname);
- END;
- END FixTypeName;
- PROCEDURE FixTypeDeclName(typeDecl : ModuleParser.TypeDecl);
- VAR module : ModuleParser.Module; name, typeName : ARRAY 256 OF CHAR;
- BEGIN
- ASSERT(typeDecl # NIL);
- IF ~Strings.ContainsChar(typeDecl.identDef.ident.name^, ".", FALSE) THEN
- module := typeDecl.GetModule();
- IF (module # NIL) THEN
- COPY(typeDecl.identDef.ident.name^, typeName);
- COPY(module.ident.name^, name);
- Strings.Append(name, ".");
- Strings.Append(name, typeName);
- typeDecl.identDef.ident.name := Strings.NewString(name);
- END;
- END;
- END FixTypeDeclName;
- PROCEDURE GetTypeName(node : ModuleParser.Node) : Strings.String;
- VAR name : Strings.String;
- BEGIN
- WHILE (node # NIL) & (node.parent # node) & ~(node IS ModuleParser.TypeDecl) DO node := node.parent; END;
- IF (node # NIL) & (node IS ModuleParser.TypeDecl) THEN
- name := node(ModuleParser.TypeDecl).identDef.ident.name;
- ELSE
- name := Strings.NewString("UnknownType");
- END;
- RETURN name;
- END GetTypeName;
- PROCEDURE IsBasicType(CONST string : ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- RETURN (string = "CHAR") OR (string = "ANY") OR (string = "BOOLEAN") OR (string = "SET")
- OR (string = "SHORTINT") OR (string = "INTEGER") OR (string = "LONGINT") OR (string = "HUGEINT")
- OR (string = "REAL") OR (string = "LONGREAL")
- OR (string = "ADDRESS") OR (string = "SIZE") OR (string = "SYSTEM.BYTE");
- END IsBasicType;
- PROCEDURE FindImport(CONST name : ARRAY OF CHAR; module : ModuleParser.Module; VAR importName : ARRAY OF CHAR);
- VAR import : ModuleParser.Import;
- BEGIN
- ASSERT(module # NIL);
- importName:= "";
- IF (name # "") THEN
- import := module.FindImport(name);
- IF (import # NIL) THEN
- IF (import.alias # NIL) THEN
- COPY(import.alias.name^, importName);
- ELSE
- COPY(import.ident.name^, importName);
- END;
- END;
- END;
- END FindImport;
- PROCEDURE Rotate(VAR size : SizeString);
- VAR stringArray : Strings.StringArray;
- BEGIN
- stringArray := Strings.Split(size, ",");
- IF (LEN(stringArray) = 2) THEN
- COPY(stringArray[1]^, size);
- Strings.Append(size, ",");
- Strings.Append(size, stringArray[0]^);
- END;
- END Rotate;
- PROCEDURE GetSizeString(CONST size : ARRAY OF CHAR; VAR sizeString : SizeString);
- BEGIN
- IF (size = "A0") THEN sizeString := "33.1,46.8";
- ELSIF (size = "A1") THEN sizeString := "22.4,33.1";
- ELSIF (size = "A2") THEN sizeString := "16.5,23.4";
- ELSIF (size = "A3") THEN sizeString := "11.7,16.5";
- ELSIF (size = "A4") THEN sizeString := "8.3,11.7";
- ELSIF (size = "A5") THEN sizeString := "5.8,8.3";
- ELSIF (size = "A6") THEN sizeString := "4.1,5.8";
- ELSIF (size = "A7") THEN sizeString := "2.9,4.1";
- ELSIF (size = "A8") THEN sizeString := "2.05,2.9";
- ELSIF (size = "A9") THEN sizeString := "1.46,2.05";
- ELSIF (size = "A10") THEN sizeString := "1.02,1.46";
- ELSE
- COPY(size, sizeString);
- END;
- END GetSizeString;
- PROCEDURE ParseFile(CONST filename : ARRAY OF CHAR; VAR module : ModuleParser.Module);
- VAR
- scanner : FoxScanner.Scanner;
- text : Texts.Text;
- reader : TextUtilities.TextReader;
- diagnostics : Diagnostics.StreamDiagnostics;
- writer : Streams.Writer;
- format, res : LONGINT;
- BEGIN
- module := NIL;
- NEW(text);
- TextUtilities.LoadAuto(text, filename, format, res);
- IF (res = 0) THEN
- NEW(writer, KernelLog.Send, 256);
- NEW(diagnostics, writer);
- NEW(reader, text);
- scanner := FoxScanner.NewScanner(filename, reader, 0, diagnostics);
- ModuleParser.Parse(scanner, module);
- IF (module # NIL) THEN
- ModuleParser.SetSuperTypes(module);
- END;
- END;
- END ParseFile;
- PROCEDURE GetMode(CONST string : ARRAY OF CHAR) : LONGINT;
- VAR mode : LONGINT;
- BEGIN
- ASSERT((string = "none") OR (string = "public") OR (string = "all"));
- IF (string = "none") THEN mode := None;
- ELSIF (string = "public") THEN mode := Public;
- ELSIF (string = "all") THEN mode := All;
- END;
- ASSERT((mode = None) OR (mode = Public) OR (mode = All));
- RETURN mode;
- END GetMode;
- PROCEDURE Generate*(context : Commands.Context); (** [options] moduleName {" " modulename} ~ *)
- VAR
- moduleName, outputFilename : Files.FileName;
- module : ModuleParser.Module;
- file : Files.File;
- writer : Files.Writer;
- generator : Generator;
- options : Options.Options;
- PROCEDURE IsValid(CONST string : ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- RETURN (string = "none") OR (string = "public") OR (string = "all");
- END IsValid;
- PROCEDURE CheckOptions(options : Options.Options; out : Streams.Writer) : BOOLEAN;
- VAR string : ARRAY 32 OF CHAR; integer : LONGINT; error : BOOLEAN;
- BEGIN
- ASSERT((options # NIL) & (out # NIL));
- error := FALSE;
- IF options.GetString("types", string) & ~IsValid(string) THEN
- out.String("Option argument wrong: -t / --types = 'none' | 'public' | 'all'"); out.Ln;
- error := TRUE;
- END;
- IF options.GetString("variables", string) & ~IsValid(string) THEN
- out.String("Option argument wrong: -v / --variables = 'none' | 'public' | 'all'"); out.Ln;
- error := TRUE;
- END;
- IF options.GetString("procedures", string) & ~IsValid(string) THEN
- out.String("Option argument wrong: -p / --procedures = 'none' | 'public' | 'all'"); out.Ln;
- error := TRUE;
- END;
- IF options.GetString("hasA", string) & ~IsValid(string) THEN
- out.String("Option argument wrong: -h / --hasA = 'none' | 'public' | 'all'"); out.Ln;
- error := TRUE;
- END;
- IF options.GetString("dependencies", string) & ~IsValid(string) THEN
- out.String("Option argument wrong: -d / --dependencies = 'none' | 'public' | 'all'"); out.Ln;
- error := TRUE;
- END;
- IF options.GetInteger("mode", integer) & (integer # Simple) & (integer # Better) & (integer # Extreme) THEN
- out.String("Option argument wrong: -m / --mode = 0 | 1 | 2"); out.Ln;
- error := TRUE;
- END;
- RETURN ~error;
- END CheckOptions;
- BEGIN
- NEW(options);
- options.Add("a", "all", Options.Flag);
- options.Add("d", "dependencies", Options.String);
- options.Add("s", "size", Options.String);
- options.Add("f", "file", Options.String);
- options.Add("h", "hasA", Options.String);
- options.Add("l", "landscape", Options.Flag);
- options.Add("o", "options", Options.String);
- options.Add("m", "mode", Options.Integer);
- options.Add("t", "types", Options.String);
- options.Add("v", "variables", Options.String);
- options.Add("p", "procedures", Options.String);
- options.Add("e", "exclude", Options.String);
- IF options.Parse(context.arg, context.out) THEN
- IF CheckOptions(options, context.out) THEN
- IF ~options.GetString("file", outputFilename) THEN
- COPY(DefaultOutputFilename, outputFilename);
- END;
- file := Files.New(outputFilename);
- IF (file # NIL) THEN
- NEW(writer, file, 0);
- NEW(generator, writer);
- generator.Open(options);
- WHILE context.arg.GetString(moduleName) DO
- ParseFile(moduleName, module);
- IF (module # NIL) THEN
- generator.AddModule(module, 4);
- context.out.String("Added "); context.out.String(moduleName); context.out.Ln;
- ELSE
- context.out.String("Error: Could not parse module "); context.out.String(moduleName); context.out.Ln;
- END;
- END;
- generator.Close;
- Files.Register(file);
- context.out.String("Graph description written to "); context.out.String(outputFilename); context.out.Ln;
- ELSE
- context.out.String("Could not create file "); context.out.String(moduleName); context.out.Ln;
- END;
- END;
- END;
- END Generate;
- END Visualizer.
- Visualizer.Generate PET.Mod ~
- Visualizer.Generate -s="A3" -m=1 --landscape WMWindowManager.Mod WindowManager.Mod WMComponents.Mod WMStandardComponents.Mod ~
- Visualizer.Generate -s="A3" -l -o='ratio = "compress" '-m=1 Usbdi.Mod Usb.Mod UsbHcdi.Mod UsbEhci.Mod UsbHubDriver.Mod ~
- Visualizer.Generate -s="A3" -l -o='ratio = "compress" '-m=1 -v=all -p=all -h=all -a -d=all Usbdi.Mod Usb.Mod UsbHcdi.Mod UsbEhci.Mod UsbHubDriver.Mod ~
- Visualizer.Generate -s="A3" -m=2 --landscape WMWindowManager.Mod WindowManager.Mod ~
- Visualizer.Generate -s="A3" -o='page = "--landscape PCT.Mod ~
- Visualizer.Generate -s="A0" -l -o='ratio = "fill" '-m=2 -v=public -p=public -h=all -a
- -e="WMFontManager Modules Kernel Raster CLUTs Machine Heaps Objects"
- XMLObjects.Mod XML.Mod WMMessages.Mod WMGraphics.Mod WMFontManager.Mod WindowManager.Mod WMWindowManager.Mod
- WMEvents.Mod WMProperties.Mod WMComponents.Mod ~
- Visualizer.Generate -s="A0" -l -o='ratio = "fill"' -m=2 -v=public -p=public -h=all -a
- -e="Modules"
- Oberon.Objects.Mod Oberon.Links.Mod Oberon.Attributes.Mod Oberon.Gadgets.Mod
- ~
- Visualizer.Generate -a -s="A0" -v=all --procedures=all --hasA=all -d=all --mode=0 Visualizer.Mod ~
- Visualizer.Generate -a -s="A3" ratio="fill"' -v=none -p=none -h=all -m=2 -e="Modules Machine Heaps Objects Kernel Raster XMLObjects XML" WMEvents.Mod WMProperties.Mod WMComponents.Mod WindowManager.Mod ~
- Visualizer.Generate -a -s="A3" -v=all -p=all -h=all -m=2 Trace.Mod I386.Machine.Mod Heaps.Mod Objects.Mod Modules.Mod Kernel.Mod ~
- Visualizer.Generate -a -s="A3" -v=all -p=all -m=1 WMWindowManager.Mod ~
- SystemTools.Free Visualizer ~ Test.svg
|