-- DesignModelImpl.mesa -- last edit by Schmidt, January 6, 1983 2:27 pm -- last edit by Satterthwaite, February 1, 1983 10:12 am -- construct Models from Bcds -- Usage: -- DesignModel [/d] [/h host] [/p path] [/m modelfile] [/w] file1.bcd ... filen.bcd -- -- that is, list the bcd's that are part one after the other. -- The Bcd's are Implementor modules -- -- /d turn on debugging switch -- /h host set host name for files, e.g. "Ivy" -- /m modelfile set filename for output model (default = "NewModel.Model") -- /p path set path name for files, e.g. "Schmidt>Model" -- /w use defaults in generated model -- DIRECTORY CWF: TYPE USING [SetWriteProcedure, SWF1, SWF3, SWF4, WF0, WF1, WF2, WF3], DesModSup: TYPE USING [EnterType, EnterInstAndLoc, FixupExterior, MoveTypesToFront, NeedModuleName, ProcessForStandardOpen, ReorganizeInOrder, SortListOfSymbols], DFSubr: TYPE USING [AllocateDFSeq, DF, DFSeq, FreeDFSeq, LookupDF, NextDF, StripLongName], Dir: TYPE USING [FileInfo], Directory: TYPE USING [Error, GetProps, Handle, ignore, Lookup], File: TYPE USING [Capability], IO: TYPE USING[Handle, PutChar], LongString: TYPE USING [EquivalentString], MDModel: TYPE USING [AddToEndOfList, AllocateSymbolSeq, APPLSymbol, CkType, FreeStringsOf, FreeSymbolSeq, GenerateUniqueName, GetFileInfo, LETSymbol, LISTSymbol, ListType, LOCSymbol, MergeIntoList, MODELSymbol, NarrowToAPPL, NarrowToLET, NarrowToLIST, NarrowToLOC, NarrowToPROC, NarrowToTYPE, NewSymAPPL, NewSymLET, NewSymLOC, NewSymMODEL, NewSymSTRING, NewSymTYPE, PROCSymbol, RemoveFromList, StartMDSupport, StopMDSupport, STRINGSymbol, Sym, Symbol, SymbolSeq, TraverseList, TraverseTree, traversetreecalled, TYPESymbol], MDUtil: TYPE USING [AnyR, MakeConfig, PrintNewModelStream, SupportInit], ProcBcds: TYPE USING [GetModuleName, Innards, InnardsObject, InstallAddressesBcd, PrintDepends, ProcDep, ProcMod, ReadInSegmentsBcd, UnstallBcd], Rope: TYPE USING[Cat, Fetch, Text], RopeInline: TYPE USING[InlineFlatten], Space: TYPE USING [Handle, nullHandle], Stream: TYPE USING [Delete, Handle], String: TYPE USING [AppendString], Subr: TYPE USING [AbortMyself, Any, CopyString, debugflg, EndsIn, errorflg, GetCreateDate, GetRemoteFilenameProp, NewStream, numberofleaders, PackedTime, PrintGreeting, strcpy, SubrInit, SubrStop, Write], Time: TYPE USING [Current], TimeStamp: TYPE USING[Stamp], UECP: TYPE USING[Argv, Parse], UserExec: TYPE USING[CommandProc, ExecHandle, GetStreams, RegisterCommand, UserAbort]; DesignModelImpl: PROGRAM IMPORTS CWF, DesModSup, DFSubr, Directory, IO, LongString, MDModel, MDUtil, ProcBcds, RopeInline, Space, Stream, String, Subr, Time, UECP, UserExec = { maxfiles: CARDINAL = 500; -- the maximum number of files maxsym: CARDINAL = 5000; -- the number of symbols -- MDS USAGE !!! output: IO.Handle; -- end of MDS PutProc: PROC[ch: CHAR] = { output.PutChar[ch]; }; Main: UserExec.CommandProc = TRUSTED { commandline: Rope.Text; out: IO.Handle; symbolseq: MDModel.SymbolSeq ← NIL; sh: Stream.Handle; dfseq: DFSubr.DFSeq ← NIL; changes: BOOL; dontdefault: BOOL ← TRUE; host: STRING ← [30]; path: STRING ← [100]; time: Subr.PackedTime; spm: MDModel.PROCSymbol; modelfile: STRING ← [100]; configfile: STRING ← [100]; procname: STRING ← [100]; n: CARDINAL; nimpls, parm: CARDINAL; token: Rope.Text; argv: UECP.Argv ← UECP.Parse[event.commandLine]; Cleanup: PROC = { MDModel.StopMDSupport[]; MDModel.FreeSymbolSeq[@symbolseq]; DFSubr.FreeDFSeq[@dfseq]; Subr.SubrStop[]; }; { ENABLE { Subr.AbortMyself => { CWF.WF0["\nDesignModel Aborted.\n"L]; GOTO leave; }; UNWIND => Cleanup[]; }; output ← exec.GetStreams[].out; Subr.SubrInit[256]; Subr.errorflg ← Subr.debugflg ← FALSE; time ← Time.Current[]; Subr.PrintGreeting["DesignModel"L]; symbolseq ← MDModel.AllocateSymbolSeq[maxsym]; symbolseq.controlv ← MDModel.NewSymTYPE[symbolseq]; symbolseq.controlv.typesym ← Subr.CopyString["CONTROL"L]; symbolseq.controlv.typeName ← Subr.CopyString["CONTROL"L]; symbolseq.toploc ← MDModel.NewSymLOC[symbolseq]; symbolseq.toploc.nestedmodel ← MDModel.NewSymMODEL[symbolseq]; MDUtil.SupportInit[symbolseq, NARROW[exec.viewer], exec.GetStreams[].out]; MDModel.StartMDSupport[]; MDModel.traversetreecalled ← 0; Subr.numberofleaders ← 0; dfseq ← DFSubr.AllocateDFSeq[maxEntries: maxfiles, zoneType: shared]; Subr.strcpy[modelfile, "NewModel.Model"L]; parm ← 1; WHILE parm < argv.argc DO token ← RopeInline.InlineFlatten[argv[parm]]; IF token.Fetch[0] = '/ OR token.Fetch[0] = '- THEN { SELECT token.Fetch[1] FROM 'd => Subr.debugflg ← TRUE; 'h => { token ← RopeInline.InlineFlatten[argv[parm]]; parm ← parm + 1; Subr.strcpy[host, LOOPHOLE[token]]; }; 'm => { token ← RopeInline.InlineFlatten[argv[parm]]; parm ← parm + 1; Subr.strcpy[modelfile, LOOPHOLE[token]]; }; 'p => { token ← RopeInline.InlineFlatten[argv[parm]]; parm ← parm + 1; Subr.strcpy[path, LOOPHOLE[token]]; }; 'w => dontdefault ← FALSE; ENDCASE => CWF.WF1["Unknown option '%s'\n"L, LOOPHOLE[token]]; } ELSE { df: DFSubr.DF; IF NOT MDUtil.AnyR[token, '.] THEN token ← RopeInline.InlineFlatten[Rope.Cat[token, ".Bcd"]]; df ← DFSubr.NextDF[dfseq]; IF df = NIL THEN ERROR; df.shortname ← Subr.CopyString[LOOPHOLE[token], dfseq.dfzone]; }; parm ← parm + 1; ENDLOOP; IF dfseq.size = 0 THEN { CWF.WF0["Error - no arguments given to DesignModel.\n"L]; SIGNAL Subr.AbortMyself; }; IF NOT Subr.Any[modelfile, '.] THEN String.AppendString[modelfile, ".Model"L]; symbolseq.toploc.nestedmodel.modelfilename ← Subr.CopyString[modelfile]; nimpls ← dfseq.size; changes ← TRUE; WHILE changes DO changes ← FALSE; FOR i: CARDINAL IN [0.. dfseq.size) DO IF NOT dfseq[i].eval THEN { AddBcd[@dfseq[i], symbolseq, dfseq, host, path, (i < nimpls), exec]; changes ← TRUE; dfseq[i].eval ← TRUE; }; ENDLOOP; ENDLOOP; -- at this point symbolseq.toploc.nestedmodel.model -- is a list of all the Types and APPLs and LEts -- this takes the TYPEs and LETs, puts a Model: in front of -- them, and puts TYPEs and APPLs in parameter list Subr.strcpy[configfile, modelfile]; configfile.length ← configfile.length - 6; CWF.SWF1[procname, "MODEL%s"L, configfile]; CWF.WF0["Fix up exterior.\n"L]; DesModSup.FixupExterior[symbolseq, procname]; -- symbolseq.toploc.nestedmodel.model is a list of one element, which is a PROC -- now reorganize the PROC body in sorted order CWF.WF0["Reorganize procval in order. "L]; spm ← MDModel.NarrowToPROC[symbolseq.toploc.nestedmodel.model.first]; spm.procval ← DesModSup.ReorganizeInOrder[symbolseq, MDModel.NarrowToLIST[spm.procval], exec]; -- now move all the PLUS's and THEN's to the bottom (for the Binder) spm.procval ← MoveAllPlus[MDModel.NarrowToLIST[spm.procval], symbolseq]; -- now reorganize the PROC parameter list in topological order CWF.WF0["Sort parameters in order. "L]; [spm.procparm, n] ← DesModSup.SortListOfSymbols[symbolseq, spm.procparm]; CWF.WF1["(%u symbols sorted.)\n"L, @n]; CWF.WF0["Figure out exports. "L]; spm.procret ← FigureOutExports[symbolseq]; [spm.procret, n] ← DesModSup.SortListOfSymbols[symbolseq, spm.procret]; CWF.WF1["(%u symbols sorted.)\n"L, @n]; -- now move the types in the parameter list to before the Model: PROC CWF.WF0["Moving types to front.\n"L]; DesModSup.MoveTypesToFront[symbolseq]; -- at this point symbolseq.toploc.nestedmodel.model is a LIST of many types, ended by -- a single PROC; now reorganize those TYPES CWF.WF0["Reorganizing those types in order. "L]; symbolseq.toploc.nestedmodel.model ← DesModSup.ReorganizeInOrder[symbolseq, symbolseq.toploc.nestedmodel.model, exec]; CWF.WF0["Process for standard open.\n"L]; -- now run through the list and strip off standard Mesa TYPES, -- supplying an @OPEN instead DesModSup.ProcessForStandardOpen[symbolseq]; -- MDModel.ValidateModel[symbolseq]; -- print out the model commandline ← RopeInline.InlineFlatten[Rope.Cat["DesignModel ", event.commandLine]]; out ← exec.GetStreams[].out; CWF.WF1["The new model is in the file '%s'\n\n"L, modelfile]; MDUtil.PrintNewModelStream[symbolseq, symbolseq.toploc.nestedmodel, NIL, commandline, dontdefault, NARROW[exec.viewer], out]; sh ← Subr.NewStream[modelfile, Subr.Write]; MDUtil.PrintNewModelStream[symbolseq, symbolseq.toploc.nestedmodel, sh, commandline, dontdefault, NARROW[exec.viewer], out]; Stream.Delete[sh]; modelfile.length ← modelfile.length - 5; CWF.SWF1[configfile, "MODEL%sConfig"L, modelfile]; CWF.WF1["\n\n\nThe New Config File Is '%s'\n\n"L, configfile]; -- prints on the terminal MDUtil.MakeConfig[symbolseq.toploc.nestedmodel, symbolseq, NIL, 0, out, NIL]; sh ← Subr.NewStream[configfile, Subr.Write]; MDUtil.MakeConfig[symbolseq.toploc.nestedmodel, symbolseq, sh, 0, out, NIL]; Stream.Delete[sh]; EXITS leave => NULL; }; CWF.WF3["\nSymbolseq.size %u, leaders: %u, traversetrees: %u.\n"L, @symbolseq.size, @Subr.numberofleaders, @MDModel.traversetreecalled]; time ← Time.Current[] - time; CWF.WF1["Total elapsed time for DesignModel %lr.\n"L,@time]; Cleanup[]; }; -- take dftop.shortname, add it to the model in symbolseq -- if usersaysimpl, then the user put this one on the command line AddBcd: PROC[dftop: DFSubr.DF, symbolseq: MDModel.SymbolSeq, dfseq: DFSubr.DFSeq, defhost, defpath: STRING, usersaysimpl: BOOL, exec: UserExec.ExecHandle] = { spimpl: MDModel.Symbol; -- is either TYPE or LET spimplloc: MDModel.LOCSymbol; mainprog: STRING ← [100]; innardsobject: ProcBcds.InnardsObject ← [bcdheaderspace: Space.nullHandle]; tail: STRING ← [100]; sext: STRING ← [20]; procMod: ProcBcds.ProcMod = { fi: Dir.FileInfo; sptype: MDModel.TYPESymbol; isc: BOOL ← TRUE; uns ← NIL; Subr.strcpy[mainprog, smodulename]; IF sourcefile.length > 0 THEN { IF Subr.EndsIn[sourcefile, ".mesa"L] THEN { sourcefile.length ← sourcefile.length - 5; isc ← FALSE; } ELSE IF Subr.EndsIn[sourcefile, ".config"L] THEN { sourcefile.length ← sourcefile.length - 7; isc ← TRUE; } ELSE ERROR; -- in general prefer the capitalization of the modulename -- so we can default to a shorter form (:@) Subr.strcpy[tail, IF LongString.EquivalentString[sourcefile, smodulename] THEN smodulename ELSE sourcefile]; Subr.strcpy[sext, IF isc THEN "config"L ELSE "mesa"L]; } ELSE { -- for modules which have no source recorded -- in them, e.g. TableCompiled Subr.strcpy[tail, smodulename]; Subr.strcpy[sext, "bcd"L]; }; IF isdefns THEN { bcdfn: STRING ← [100]; CWF.SWF1[bcdfn, "%s.Bcd"L, tail]; sptype ← DesModSup.EnterType[bcdfn, smodulename, bcdvers, symbolseq, symbolseq.toploc.nestedmodel]; spimplloc ← MDModel.NarrowToLOC[sptype.typeval]; -- this resets everything MDModel.FreeStringsOf[spimplloc]; spimplloc.host ← spimplloc.path ← spimplloc.tail ← spimplloc.sext ← NIL; } ELSE IF NOT usersaysimpl THEN { -- must be a pointer to frame bcdfn: STRING ← [100]; CWF.WF1["%s is used as a pointer to frame.\n"L, smodulename]; CWF.SWF1[bcdfn, "%s.Bcd"L, tail]; sptype ← DesModSup.EnterType[bcdfn, smodulename, bcdvers, symbolseq, symbolseq.toploc.nestedmodel]; sptype.frameptr ← TRUE; -- this way the instance will become a parameter spimpl ← sptype; RETURN; } ELSE spimplloc ← MDModel.NewSymLOC[symbolseq]; -- look at remote name property spimplloc.createtime ← sourcevers.time; FigureOutRemoteName[spimplloc, sourcefile]; IF spimplloc.host = NIL AND defhost.length > 0 THEN spimplloc.host ← Subr.CopyString[defhost]; IF spimplloc.path = NIL AND defpath.length > 0 THEN spimplloc.path ← Subr.CopyString[defpath]; spimplloc.tail ← Subr.CopyString[tail]; spimplloc.sext ← Subr.CopyString[sext]; -- designmodel can only generate parameters that are defaultable spimplloc.parmsdefaultable ← TRUE; fi ← MDModel.GetFileInfo[spimplloc]; fi.bcdVers ← bcdvers; fi.moduleName ← Subr.CopyString[smodulename]; IF isdefns THEN { spimpl ← sptype; } ELSE { -- switches don't matter for defs files or config files spswitch: MDModel.Symbol; splet: MDModel.LETSymbol; IF NOT isc THEN { spswitch ← SwitchesToSymbol[altoCode, boundsChecks, cedarSwitch, crossJump, linksInCode, nilChecks, sortByUsage, symbolseq]; spimplloc.parmlist ← MDModel.AddToEndOfList[ spimplloc.parmlist, spswitch, normal, symbolseq]; }; splet ← MDModel.NewSymLET[symbolseq]; splet.letgrp ← NIL; splet.letval ← spimplloc; spimpl ← splet; IF dftop.isdefns THEN { -- oops this is a module that -- is being used for a FRAMEPTR CWF.WF1["%s is used as a pointer to frame.\n"L, sourcefile]; }; }; }; -- spimpl, spimplloc are external -- spimpl is either type TYPE or LET procDep: ProcBcds.ProcDep = { moduleName: STRING ← [100]; df: DFSubr.DF; IF relcode = otherdepends OR relcode = canignore OR relcode = symbolsfile OR relcode = sourcefile THEN RETURN; -- if filename is length 0 then ignore -- may be result of table-compiled stuff IF filename.length = 0 THEN RETURN; -- add to DF table, for next iteration df ← DFSubr.LookupDF[dfseq, filename]; IF df = NIL THEN { df ← DFSubr.NextDF[dfseq]; df.shortname ← Subr.CopyString[filename, dfseq.dfzone]; }; IF spimpl.stype ~= typeTYPE THEN MDModel.CkType[spimpl, typeLET]; MDModel.CkType[spimplloc, typeLOC]; IF relcode = defstype THEN { spaddtype: MDModel.TYPESymbol ← NIL; IF smodulename ~= NIL THEN Subr.strcpy[moduleName, smodulename]; -- added to the end of the model spaddtype ← DesModSup.EnterType[filename, moduleName, bcdvers, symbolseq, symbolseq.toploc.nestedmodel ! DesModSup.NeedModuleName => IF SetModuleName[filename, moduleName] THEN RETRY]; IF spaddtype ~= NIL THEN spimplloc.parmlist ← MDModel.AddToEndOfList[spimplloc.parmlist, spaddtype, normal, symbolseq]; df.isdefns ← TRUE; } ELSE { -- added to the end of the model at this point spi: MDModel.APPLSymbol; IF spimpl.stype ~= typeLET THEN { -- CWF.WF2["Warning: %s is a pointer to frame but has an export '%s'.\n"L, -- MDModel.Sym[spimpl], spi.applsym]; -- ignore this import or export from a FRAMEPTRTYPE RETURN; }; IF smodulename ~= NIL THEN Subr.strcpy[moduleName, smodulename]; spi ← DesModSup.EnterInstAndLoc[filename, moduleName, bcdvers, symbolseq, symbolseq.toploc.nestedmodel, NIL ! DesModSup.NeedModuleName => IF SetModuleName[filename, moduleName] THEN RETRY]; IF relcode = imports THEN spimplloc.parmlist ← MDModel.AddToEndOfList[spimplloc.parmlist, spi, normal, symbolseq] ELSE IF relcode = exports THEN { splet: MDModel.LETSymbol ← MDModel.NarrowToLET[spimpl]; IF spi.applval ~= NIL THEN { CWF.WF1["Warning: %s is defined by itself and also in a LET stmt.\n"L, spi.applsym]; FixupAPPLtoLET[spi, splet, symbolseq]; } ELSE IF spi.letparent ~= NIL AND spi.letparent.letval ~= NIL THEN { CWF.WF1["Warning: %s is defined in two LET stmts.\n"L, spi.applsym]; FixupLETtoLET[spi, splet, symbolseq]; } ELSE { spi.letparent ← splet; splet.letgrp ← MDModel.AddToEndOfList[splet.letgrp, spi, normal, symbolseq]; }; } ELSE ERROR; }; }; { splet: MDModel.LETSymbol; sploc: MDModel.LOCSymbol; success: BOOL; IF UserExec.UserAbort[exec] THEN SIGNAL Subr.AbortMyself[]; innardsobject.cap ← Directory.Lookup[fileName: dftop.shortname, permissions: Directory.ignore ! Directory.Error => GOTO err]; [] ← Directory.GetProps[innardsobject.cap, mainprog ! Directory.Error => { Subr.strcpy[mainprog, dftop.shortname]; CONTINUE; } ]; CWF.WF1["Analyzing %s.\n"L, mainprog]; ProcBcds.ReadInSegmentsBcd[@innardsobject]; ProcBcds.InstallAddressesBcd[@innardsobject]; IF usersaysimpl AND SpecialCase[mainprog, symbolseq, @innardsobject] THEN RETURN; [success] ← ProcBcds.PrintDepends[@innardsobject, procMod, procDep, FALSE, FALSE, TRUE, mainprog]; -- less is true ProcBcds.UnstallBcd[@innardsobject]; IF NOT success THEN { CWF.WF1["Error - couldn't analyze %s correctly.\n"L, mainprog]; Subr.errorflg ← TRUE; }; -- at this point spimpl is either a TYPE or a LET -- the type has already been added to the model IF spimpl.stype = typeTYPE THEN { sptype: MDModel.TYPESymbol; sptype ← MDModel.NarrowToTYPE[spimpl]; sploc ← MDModel.NarrowToLOC[sptype.typeval]; -- doesnt work -- [sploc.parmlist] ← SortListOfSymbols[symbolseq, sploc.parmlist]; RETURN; }; splet ← MDModel.NarrowToLET[spimpl]; MDModel.CkType[splet, typeLET]; IF splet.letgrp = NIL THEN { -- must be a CONTROL module since it exports nothing spappl: MDModel.APPLSymbol; spappl ← MDModel.NewSymAPPL[symbolseq]; spappl.applsym ← Subr.CopyString[mainprog]; spappl.appltype ← symbolseq.controlv; spappl.applval ← NIL; splet.letgrp ← MDModel.AddToEndOfList[splet.letgrp, spappl, normal, symbolseq]; spappl.letparent ← splet; }; -- reorganize the parameter list into topological order sploc ← MDModel.NarrowToLOC[splet.letval]; -- doesnt work -- [sploc.parmlist] ← SortListOfSymbols[symbolseq, sploc.parmlist]; -- reorganize exports -- doesnt work -- [splet.letgrp] ← SortListOfSymbols[symbolseq, splet.letgrp]; spimpl ← SmashLETToAPPL[splet, symbolseq]; -- spimpl may now be an APPL -- now add spimpl to symbolseq.toploc.nestedmodel.model if not already there IF NOT usersaysimpl THEN -- remove definition of an impl so it becomes a parameter [newlist: symbolseq.toploc.nestedmodel.model] ← MDModel.RemoveFromList[spimpl, symbolseq.toploc.nestedmodel.model] ELSE LookForMod[symbolseq, spimpl]; EXITS err => CWF.WF2["Analyzing %s. File %s is not on local disk.\n"L, dftop.shortname, dftop.shortname]; }; }; SetModuleName: PROC[fileName, moduleName: STRING] RETURNS[success: BOOL] = { innardsobject: ProcBcds.InnardsObject ← [bcdheaderspace: Space.nullHandle]; -- must go and read in bcd to get modulename success ← FALSE; innardsobject.cap ← Directory.Lookup[fileName: fileName, permissions: Directory.ignore ! Directory.Error => GOTO out]; ProcBcds.ReadInSegmentsBcd[@innardsobject]; ProcBcds.InstallAddressesBcd[@innardsobject]; IF NOT ProcBcds.GetModuleName[@innardsobject, moduleName] THEN { ProcBcds.UnstallBcd[@innardsobject]; GOTO out; }; ProcBcds.UnstallBcd[@innardsobject]; success ← TRUE; EXITS out => CWF.WF1["Error - can't get modulename for %s.\n"L, fileName]; }; -- will fixup spappl so that splet may also export it -- note the PLUS node must follow the splet FixupAPPLtoLET: PROC[spappl: MDModel.APPLSymbol, splet: MDModel.LETSymbol, symbolseq: MDModel.SymbolSeq] = { spelem: MDModel.APPLSymbol; IF spappl.applval.stype ~= typeLIST THEN { -- if spappl is not already a PLUS list newsp: MDModel.APPLSymbol; newsp ← MDModel.NewSymAPPL[symbolseq]; newsp↑ ← spappl↑; newsp.applsym ← MDModel.GenerateUniqueName[spappl]; newsp.letparent ← NIL; spappl.applval ← MDModel.AddToEndOfList[NIL, newsp, plus, symbolseq]; symbolseq.toploc.nestedmodel.model ← MDModel.AddToEndOfList[symbolseq.toploc.nestedmodel.model, newsp, normal, symbolseq]; }; spappl.letparent ← NIL; spelem ← MDModel.NewSymAPPL[symbolseq]; spelem.applsym ← MDModel.GenerateUniqueName[spappl]; spelem.appltype ← spappl.appltype; spelem.applval ← NIL; spelem.letparent ← splet; splet.letgrp ← MDModel.AddToEndOfList[splet.letgrp, spelem, normal, symbolseq]; spappl.applval ← MDModel.AddToEndOfList[ MDModel.NarrowToLIST[spappl.applval], spelem, plus, symbolseq]; }; -- will fixup spappl so that splet may also export it FixupLETtoLET: PROC[spappl: MDModel.APPLSymbol, spletnew: MDModel.LETSymbol, symbolseq: MDModel.SymbolSeq] = { spletold: MDModel.LETSymbol; newsp: MDModel.APPLSymbol; spletold ← spappl.letparent; [newlist: spletold.letgrp] ← MDModel.RemoveFromList[spappl, spletold.letgrp]; newsp ← MDModel.NewSymAPPL[symbolseq]; newsp.letparent ← spletold; newsp.applsym ← MDModel.GenerateUniqueName[spappl]; newsp.applval ← NIL; newsp.appltype ← spappl.appltype; spletold.letgrp ← MDModel.AddToEndOfList[spletold.letgrp, newsp, normal, symbolseq]; spappl.applval ← MDModel.AddToEndOfList[NIL, newsp, plus, symbolseq]; spappl.letparent ← NIL; newsp ← MDModel.NewSymAPPL[symbolseq]; newsp.letparent ← spletnew; newsp.applsym ← MDModel.GenerateUniqueName[spappl]; newsp.applval ← NIL; newsp.appltype ← spappl.appltype; spletnew.letgrp ← MDModel.AddToEndOfList[spletnew.letgrp, newsp, normal, symbolseq]; spappl.applval ← MDModel.AddToEndOfList[ MDModel.NarrowToLIST[spappl.applval], newsp, plus, symbolseq]; symbolseq.toploc.nestedmodel.model ← MDModel.AddToEndOfList[symbolseq.toploc.nestedmodel.model, spappl, normal, symbolseq]; }; -- manually set spimpl's LET to APPL if necessary -- on return spimpl may be type APPL!!! SmashLETToAPPL: PROC[splet: MDModel.LETSymbol, symbolseq: MDModel.SymbolSeq] RETURNS[spimpl: MDModel.Symbol] = { spl: MDModel.LISTSymbol; spimpl ← splet; spl ← splet.letgrp; MDModel.CkType[spl, typeLIST]; IF spl.rest = NIL THEN { spa: MDModel.APPLSymbol; spa ← MDModel.NarrowToAPPL[spl.first]; IF spa.letparent ~= splet THEN ERROR; spa.letparent ← NIL; spa.applval ← splet.letval; spa.letparent ← NIL; spimpl ← spa; } ELSE RemoveTheElements[symbolseq, spl]; -- remove extra appls from the master list }; LookForMod: PROC[symbolseq: MDModel.SymbolSeq, spimpl1: MDModel.Symbol] = { spimpltype: MDModel.TYPESymbol; spimpl: MDModel.APPLSymbol; done: BOOL ← FALSE; -- this is only called if spimpl has been filled in Anal: PROC[sp1: MDModel.Symbol] = { IF done THEN RETURN; WITH sp: sp1 SELECT FROM typeAPPL => { spt: MDModel.TYPESymbol; sploc: MDModel.LOCSymbol; listtype: MDModel.ListType; IF NOT LongString.EquivalentString[sp.applsym, spimpl.applsym] THEN RETURN; spt ← MDModel.NarrowToTYPE[sp.appltype]; IF spt.typeval = NIL THEN RETURN; sploc ← MDModel.NarrowToLOC[spt.typeval]; IF NOT LongString.EquivalentString[spimpltype.typesym,spt.typesym] THEN RETURN; IF spimpltype.typeval ~= NIL THEN { IF MDModel.NarrowToLOC[spimpltype.typeval].createtime ~= sploc.createtime THEN RETURN; }; IF sp.applval ~= NIL AND sp.applval ~= spimpl.applval THEN { listtype ← IF sp.applval.stype = typeLIST THEN MDModel.NarrowToLIST[sp.applval].listtype ELSE plus; -- modify it sp.applval ← MDModel.MergeIntoList[sp.applval, spimpl.applval, symbolseq, listtype]; } ELSE sp.applval ← spimpl.applval; done ← TRUE; }; typeLET => { splist: MDModel.LISTSymbol; splist ← sp.letgrp; WHILE splist ~= NIL DO IF LongString.EquivalentString[MDModel.Sym[splist.first], spimpl.applsym] THEN CWF.WF1["Warning - %s conflicts with a LET.\n"L, spimpl.applsym]; splist ← splist.rest; ENDLOOP; }; ENDCASE => NULL; }; IF spimpl1.stype = typeAPPL THEN { spimpl ← MDModel.NarrowToAPPL[spimpl1]; spimpltype ← MDModel.NarrowToTYPE[spimpl.appltype]; MDModel.TraverseList[symbolseq.toploc.nestedmodel.model, Anal]; }; IF NOT done THEN symbolseq.toploc.nestedmodel.model ← MDModel.AddToEndOfList[symbolseq.toploc.nestedmodel.model, spimpl1, normal, symbolseq]; }; MAXAPPL: CARDINAL = 200; FigureOutExports: PROC[symbolseq: MDModel.SymbolSeq] RETURNS[procret: MDModel.LISTSymbol] = { appls: ARRAY[0 .. MAXAPPL) OF MDModel.APPLSymbol; nappls: CARDINAL ← 0; GetAllAppls: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol] RETURNS[proceed: BOOL ← TRUE] = { spappl: MDModel.APPLSymbol; IF sp.stype ~= typeAPPL THEN RETURN; spappl ← MDModel.NarrowToAPPL[sp]; IF spappl.appltype = symbolseq.controlv THEN RETURN; FOR i: CARDINAL IN [0 .. nappls) DO IF spappl = appls[i] THEN RETURN; ENDLOOP; IF nappls < LENGTH[appls] THEN { appls[nappls] ← spappl; nappls ← nappls + 1; } ELSE CWF.WF0["Too many appls in the model.\n"L]; }; RunDownList: PROC[sp: MDModel.Symbol] = { IF sp.stype ~= typeAPPL THEN RETURN; FOR i: CARDINAL IN [0 .. nappls) DO IF sp = appls[i] THEN { appls[i] ← NIL; RETURN; }; ENDLOOP; }; LookForLOC: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol] RETURNS[proceed: BOOL ← TRUE] = { WITH spt: sp SELECT FROM typeLOC => MDModel.TraverseList[spt.parmlist, RunDownList]; typePROC => MDModel.TraverseList[spt.procparm, RunDownList]; ENDCASE => NULL; }; -- first, collect all the APPLS MDModel.TraverseTree[symbolseq.toploc, symbolseq, GetAllAppls]; -- now we look through and eliminate those in the list -- that are on parameter lists procret ← NIL; MDModel.TraverseTree[symbolseq.toploc, symbolseq, LookForLOC]; -- the remains in the list are exports(?) FOR i: CARDINAL IN [0 .. nappls) DO IF appls[i] ~= NIL THEN procret ← MDModel.AddToEndOfList[procret, appls[i], normal, symbolseq]; ENDLOOP; }; -- the altoCode switch is permanently FALSE SwitchesToSymbol: PROC[altoCode, boundsChecks, cedarSwitch, crossJump, linksInCode, nilChecks, sortByUsage: BOOL, symbolseq: MDModel.SymbolSeq] RETURNS[sp: MDModel.STRINGSymbol] = { stemp1: STRING ← [20]; stemp2: STRING ← [20]; CWF.SWF3[stemp1, "%sb%sc%sj"L, IF boundsChecks THEN ""L ELSE "-"L, IF cedarSwitch THEN ""L ELSE "-"L, IF crossJump THEN ""L ELSE "-"L]; CWF.SWF4[stemp2, "%s%sl%sn%ss"L, stemp1, IF linksInCode THEN ""L ELSE "-"L, IF nilChecks THEN ""L ELSE "-"L, IF sortByUsage THEN ""L ELSE "-"L]; sp ← MDModel.NewSymSTRING[symbolseq]; sp.strval ← Subr.CopyString[stemp2]; }; -- this puts all the PLUS's at the end of the model MoveAllPlus: PROC[oldlist: MDModel.LISTSymbol, symbolseq: MDModel.SymbolSeq] RETURNS[newlist: MDModel.LISTSymbol]= { first, second, splist: MDModel.LISTSymbol ← NIL; splist ← oldlist; WHILE splist ~= NIL DO { IF splist.first.stype = typeAPPL THEN { spappl: MDModel.APPLSymbol; spappl ← MDModel.NarrowToAPPL[splist.first]; IF spappl.applval ~= NIL AND spappl.applval.stype = typeLIST THEN { second ← MDModel.AddToEndOfList[second, splist.first, normal, symbolseq]; GOTO loop; }; }; first ← MDModel.AddToEndOfList[first, splist.first, normal, symbolseq]; GOTO loop; EXITS loop => splist ← splist.rest; }; ENDLOOP; newlist ← first; IF second ~= NIL THEN newlist ← MDModel.NarrowToLIST[MDModel.MergeIntoList[first, second, symbolseq, normal]]; }; RemoveTheElements: PROC[symbolseq: MDModel.SymbolSeq, splist: MDModel.LISTSymbol] = { WHILE splist ~= NIL DO MDModel.CkType[splist, typeLIST]; [newlist: symbolseq.toploc.nestedmodel.model] ← MDModel.RemoveFromList[splist.first, symbolseq.toploc.nestedmodel.model]; splist ← splist.rest; ENDLOOP; }; SpecialCase: PROC[sfn: LONG STRING, symbolseq: MDModel.SymbolSeq, innards: ProcBcds.Innards] RETURNS[isaspecialcase: BOOL] = { sptype: MDModel.TYPESymbol; spappl: MDModel.APPLSymbol; sploclet: MDModel.LOCSymbol; splet: MDModel.LETSymbol; procMod: ProcBcds.ProcMod = { fi: Dir.FileInfo ← MDModel.GetFileInfo[sploclet]; fi.bcdVers ← bcdvers; fi.moduleName ← Subr.CopyString[smodulename]; uns ← NIL; }; procDep: ProcBcds.ProcDep = { }; IF NOT LongString.EquivalentString[sfn, "ModelParseData.Bcd"L] THEN RETURN[FALSE]; sploclet ← MDModel.NewSymLOC[symbolseq]; sploclet.tail ← Subr.CopyString["ModelParseData"L]; sploclet.sext ← Subr.CopyString["Bcd"L]; [] ← ProcBcds.PrintDepends[innards, procMod, procDep, FALSE, FALSE, TRUE, sfn]; -- less is TRUE ProcBcds.UnstallBcd[innards]; sptype ← MDModel.NewSymTYPE[symbolseq]; sptype.typesym ← Subr.CopyString["ModelParseData"L]; sptype.typeName ← Subr.CopyString["ModelParseData"L]; sptype.typeval ← NIL; sptype.frameptr ← TRUE; spappl ← MDModel.NewSymAPPL[symbolseq]; spappl.applsym ← Subr.CopyString["ModelParseDataImpl"L]; spappl.appltype ← sptype; spappl.applval ← NIL; splet ← MDModel.NewSymLET[symbolseq]; splet.letgrp ← MDModel.AddToEndOfList[NIL, sptype, normal, symbolseq]; splet.letgrp ← MDModel.AddToEndOfList[splet.letgrp, spappl, normal, symbolseq]; splet.letval ← sploclet; spappl.letparent ← splet; sptype.letparent ← splet; symbolseq.toploc.nestedmodel.model ← MDModel.AddToEndOfList[symbolseq.toploc.nestedmodel.model, splet, normal, symbolseq]; RETURN[TRUE]; }; -- this will involve a directoy lookup and sourcefile check! FigureOutRemoteName: PROC[sploc: MDModel.LOCSymbol, sourcefile: STRING] = { cap: File.Capability; create: LONG CARDINAL; fullname: STRING ← [125]; host: STRING ← [100]; directory: STRING ← [100]; cap ← Directory.Lookup[fileName: sourcefile, permissions: Directory.ignore ! Directory.Error => GOTO out]; [create: create] ← Subr.GetCreateDate[cap]; IF create ~= sploc.createtime THEN GOTO out; -- they are equal, now get remote property Subr.GetRemoteFilenameProp[cap, fullname]; IF fullname.length = 0 THEN GOTO out; [] ← DFSubr.StripLongName[fullname, host, directory, NIL]; IF host.length > 0 THEN sploc.host ← Subr.CopyString[host]; IF directory.length > 0 THEN sploc.path ← Subr.CopyString[directory]; EXITS out => NULL; }; -- main program Init: PROC = { -- set up WF stuff [] ← CWF.SetWriteProcedure[PutProc]; UserExec.RegisterCommand["DesignModel.~", Main]; -- the main program exits at this point -- SimpleExec will call Main when the user invokes it }; Init[]; }. -- NO LONGER NEEDED -- move sptype from the procval field to the procparm field -- assumes symbolseq.toploc.nestedmodel.model is a list of one element, which is a PROC SpliceType: PROC[symbolseq: MDModel.SymbolSeq, sptype: MDModel.TYPESymbol] = { spm: MDModel.PROCSymbol; spl: MDModel.LISTSymbol; splast: MDModel.Symbol; spm ← MDModel.NarrowToPROC[symbolseq.toploc.nestedmodel.model.first]; spl ← MDModel.NarrowToLIST[spm.procval]; splast ← symbolseq.toploc.nestedmodel.model.first; WHILE spl ~= NIL DO MDModel.CkType[spl, typeLIST]; IF spl.first = sptype THEN { MDModel.AddToEndOfList[@spm.procparm, sptype, normal, symbolseq]; WITH splast1: splast SELECT FROM typePROC => splast1.procval ← spl.rest; typeLIST => splast1.rest ← spl.rest; ENDCASE => ERROR; } ELSE splast ← spl; spl ← spl.rest; ENDLOOP; }; -- take the module described by spimpl and look for it in symbolseq -- if not already there, add it, if there, stick in spimpl's value OldLookForMod: PROC[symbolseq: MDModel.SymbolSeq, spimpl1: MDModel.Symbol] = { spimpltype: MDModel.TYPESymbol; spimpl: MDModel.APPLSymbol; done: BOOL ← FALSE; -- this is only called if spimpl has been filled in RunDownList: PROC[sp1: MDModel.Symbol, spmodel: MDModel.MODELSymbol] RETURNS[proceed: BOOL ← TRUE] = { IF done THEN RETURN[FALSE]; WITH sp: sp1 SELECT FROM typeAPPL => { spt: MDModel.TYPESymbol; sploc: MDModel.LOCSymbol; listtype: MDModel.ListType; IF NOT LongString.EquivalentString[sp.applsym, spimpl.applsym] THEN RETURN; spt ← MDModel.NarrowToTYPE[sp.appltype]; IF spt.typeval = NIL THEN RETURN; sploc ← MDModel.NarrowToLOC[spt.typeval]; IF NOT LongString.EquivalentString[spimpltype.typesym,spt.typesym] THEN RETURN; IF spimpltype.typeval ~= NIL THEN { IF MDModel.NarrowToLOC[spimpltype.typeval].createtime ~= sploc.createtime THEN RETURN; }; IF sp.applval ~= NIL AND sp.applval ~= spimpl.applval THEN { listtype ← IF sp.applval.stype = typeLIST THEN MDModel.NarrowToLIST[sp.applval].listtype ELSE plus; -- modify it sp.applval ← MDModel.MergeIntoList[sp.applval, spimpl.applval, symbolseq, listtype]; } ELSE sp.applval ← spimpl.applval; -- this records the new place for the value spimpl ← MDModel.NarrowToAPPL[sp1]; done ← TRUE; }; typeLET => { splist: MDModel.LISTSymbol; splist ← sp.letgrp; WHILE splist ~= NIL DO IF LongString.EquivalentString[MDModel.Sym[splist.first], spimpl.applsym] THEN CWF.WF1["Warning - %s conflicts with a LET.\n"L, spimpl.applsym]; splist ← splist.rest; ENDLOOP; }; ENDCASE => NULL; }; IF spimpl1.stype = typeAPPL THEN { spimpl ← MDModel.NarrowToAPPL[spimpl1]; spimpltype ← MDModel.NarrowToTYPE[spimpl.appltype]; MDModel.TraverseTree[symbolseq.toploc.nestedmodel.model, symbolseq, RunDownList]; IF done AND spimpl.letparent = NIL AND NOT MDModel.IsOnList[spimpl, symbolseq.toploc.nestedmodel.model] THEN done ← FALSE; }; IF NOT done THEN symbolseq.toploc.nestedmodel.model ← MDModel.AddToEndOfList[symbolseq.toploc.nestedmodel.model, spimpl1, normal, symbolseq]; }; -- symbolseq is passed in ConvertLetToAppl: PROC[sp1: MDModel.Symbol] = { splist: MDModel.LISTSymbol; splet: MDModel.LETSymbol; nlist: CARDINAL ← 0; IF sp1.stype ~= typeLET THEN RETURN; splet ← MDModel.NarrowToLET[sp1]; splist ← splet.letgrp; WHILE splist ~= NIL DO MDModel.CkType[splist, typeLIST]; nlist ← nlist + 1; IF nlist > 100 THEN ERROR; -- cycling splist ← splist.rest ENDLOOP; IF nlist = 1 THEN { -- only one thing in LET spt: MDModel.Symbol; spl: MDModel.LISTSymbol; spsave: MDModel.APPLSymbol; spt ← splet.letval; spl ← splet.letgrp; MDModel.CkType[spl, typeLIST]; spsave ← MDModel.NarrowToAPPL[spl.first]; IF spsave.letparent = splet THEN spsave.letparent ← NIL; -- smash on top, this changes the type of splet SmashOnTopOf[spsave, splet]; -- should not free strings of spsave -- they are also in splet↑ spsave.applsym ← NIL; -- splet is now of type APPL MDModel.NarrowToAPPL[splet].applval ← spt; MDModel.ReplaceBy[spsave, splet, symbolseq]; -- this will detect erroneous references to this MDModel.ZeroOut[spsave]; MDModel.ZeroOut[spl]; } ELSE -- remove from the master list, -- as they are defined in the LET[] RemoveTheElements[symbolseq, splet.letgrp]; }; SmashOnTopOf: PROC[sp, ontopof: MDModel.Symbol] = { ontopof↑ ← sp↑; }; -- not called! SeeIfUndefined: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol] RETURNS[proceed: BOOL ← TRUE] = { IF sp.stype ~= typeAPPL THEN RETURN; spa ← MDModel.NarrowToAPPL[sp]; -- looking for an impl that has no value and is -- not exported by a LET IF spa.applval = NIL AND spa.letparent = NIL THEN { sptype: MDModel.TYPESymbol; sploc: MDModel.LOCSymbol; sptemp: MDModel.LISTSymbol; stemp: STRING ← [100]; -- SpliceType[symbolseq, spa.appltype]; spm.procparm ← MDModel.AddToEndOfList[spm.procparm, spa.appltype, normal, symbolseq]; sptemp ← MDModel.NarrowToLIST[spm.procval]; [newlist: spm.procval] ← MDModel.RemoveFromList[spa.appltype, sptemp]; -- now add the IMPL spm.procparm ← MDModel.AddToEndOfList[spm.procparm, spa, normal, symbolseq]; sptype ← MDModel.NarrowToTYPE[spa.appltype]; sploc ← MDModel.NarrowToLOC[sptype.typeval]; CWF.SWF2[stemp, "%s.%s"L, sploc.tail, sploc.sext]; IF NOT Subr.IsASystemFile[stemp] THEN CWF.WF1["Warning - %s is a parameter but is not a Mesa System file.\n"L, stemp]; }; };