MODULE-------------------------------------------------- external entry points --; IMPORT IntArraySort, IntRefTbl, M3ID, Pathname, Text, TextList, Thread, Wr; IMPORT Quake, QValue, QCode, QMachine, QVal, QVSeq, QVTbl, M3Timers; IMPORT Arg, Builder, M3Loc, M3Options, M3Path, M3Unit, Msg, Utils; FROM QMachine IMPORT PushText, PopText, PopID, PopBool; IMPORT MxConfig AS M3Config; TYPE UK = M3Unit.Kind; MM = M3Options.Mode; REVEAL T = Quake.Machine BRANDED "M3Build.T" OBJECT (* READONLY state the is fixed for the build *) build_pkg : M3ID.T; (* the name of the package we're building *) build_pkg_dir : M3ID.T; (* full path to the package we're building *) build_dir : M3ID.T; (* name of the derived directory *) (* READONLY state that is fixed by the configuration file *) pkg_use : TEXT; (* Root directory for public packages *) pkg_install : TEXT; (* Root directory for public packages *) bin_install : TEXT; (* Directory to install binaries *) lib_install : TEXT; (* Directory to install libraries *) emacs_install : TEXT; (* Directory to install emacs e-lisp code *) doc_install : TEXT; (* Directory to install documents *) man_install : TEXT; (* Directory to install man pages *) html_install : TEXT; (* Directory to install HTML files *) have_pkgtools : BOOLEAN; (* Using the SRC package tools ? *) at_SRC : BOOLEAN; (* include SRC-only packages ? *) system_libs : QVTbl.T; (* Available system libraries *) system_liborder : QVSeq.T; (* link order for the system libraries *) (* major mode, fixed at the beginning of the run *) mode : MM; (* per processed package state *) cur_pkg : M3ID.T; (* the name of the package we're processing *) cur_pkg_dir : M3ID.T; (* full path of the package we're processing *) (* cache of package name -> directory *) pkg_cache : IntRefTbl.T; (* pkg name -> current path to package *) pkg_overrides : IntRefTbl.T; (* pkg name -> override path *) already_warned : BOOLEAN; (* warned about overriding build pkg? *) (* cache for PathOf() and PkgSubdir() *) path_of_path : TEXT; (* records result of last path() call in PathOf *) path_of_base : TEXT; (* records result of normalize in PathOf *) pkg_subdir_path : TEXT; (* result of last path() call in PkgSubdir *) pkg_subdir_base : TEXT; (* result of last normalize in PkgSubdir *) (* maps of imported packages *) imports : IntRefTbl.T; (* imported package names -> versions *) (* various sources *) units : M3Unit.Set; (* source units *) tfile_args : TxtList; derived : IntRefTbl.T; (* derived files *) sys_libs : IntRefTbl.T; (* imported system libraries *) ship_units : M3Unit.Set; (* explicitly shipped units *) (* ship & install cache *) listing_width : INTEGER; last_src_dir : TEXT; last_install_dir : TEXT; last_ship_dir : TEXT; all_ship_dirs : IntRefTbl.T; (* current compiler options *) current_options : CompilerOptions; build_shared : BOOLEAN; END; TYPE CompilerOptions = REF RECORD debug, optimize : BOOLEAN; next : CompilerOptions; END; CONST M3Exports = ".M3EXPORTS"; (* file of exported quake commands *) M3Ship = ".M3SHIP"; (* ship commands *) M3Overrides = ".M3OVERRIDES"; (* marker to indicate override use *) M3Web = ".M3WEB"; (* compiler support for browser *) M3TFile = ".M3IMPTAB"; (* import table for external compilers *) VAR QRPCR := "\")" & Wr.EOL; (* quote, right paren, carriage return *) QCQ := "\", \""; (* quote, comma, quote *) TYPE TxtList = RECORD head, tail: TextList.T; END; CONST IntfExtensions = ARRAY OF TEXT { ".ic", ".is", ".io", "_i.o" }; ImplExtensions = ARRAY OF TEXT { ".mc", ".ms", ".mo", "_m.o" }; CExtensions = ARRAY OF TEXT { ".s", ".o", ".obj" }; SExtensions = ARRAY OF TEXT { ".o", ".obj" }; NoExtension = ARRAY OF TEXT { "" }; M3Build
PROCEDURE--------------------------------------------NewMachine (): T = VAR map := Quake.NewIDMap (Str2ID, Txt2ID, ID2Txt); t := NEW (T).init (map); BEGIN InitBuiltins (t); RETURN t; END NewMachine; PROCEDURESetUp (t: T; pkg, to_pkg, build_dir: TEXT) RAISES {Quake.Error} = BEGIN (* some more config dependent backward compatibility hacks... *) Quake.Define (t, "M3SEARCH_TABLES", "-T" & M3TFile); Quake.Define (t, "DEFAULT_BUILD_DIR", GetConfig (t, "BUILD_DIR")); Quake.Define (t, "M3", M3Path.New (GetConfig (t, "BIN_USE"), M3Path.ProgramName ("cm3", host := TRUE))); Quake.Define (t, "PACKAGE_DIR", pkg); t.build_pkg := M3ID.Add (Pathname.Last (pkg)); t.build_pkg_dir := M3ID.Add (pkg); t.build_dir := M3ID.Add (build_dir); t.pkg_use := GetConfig (t, "PKG_USE"); t.pkg_install := GetConfig (t, "PKG_INSTALL"); t.bin_install := GetConfig (t, "BIN_INSTALL"); t.lib_install := GetConfig (t, "LIB_INSTALL"); t.emacs_install := GetConfig (t, "EMACS_INSTALL"); t.doc_install := GetConfig (t, "DOC_INSTALL"); t.man_install := GetConfig (t, "MAN_INSTALL"); t.html_install := GetConfig (t, "HTML_INSTALL"); t.have_pkgtools := GetConfigBool (t, "HAVE_PKGTOOLS"); t.at_SRC := GetConfigBool (t, "AT_SRC"); t.system_liborder := QVal.ToArray (t, ConfigDefn (t, "SYSTEM_LIBORDER").value); t.system_libs := QVal.ToTable (t, ConfigDefn (t, "SYSTEM_LIBS").value); t.cur_pkg := t.build_pkg; t.cur_pkg_dir := t.build_pkg_dir; t.pkg_cache := NewMap (); t.pkg_overrides := NewMap (); t.already_warned := FALSE; EVAL t.pkg_cache.put (t.build_pkg, to_pkg); t.path_of_path := ""; t.path_of_base := ""; t.pkg_subdir_path := ""; t.pkg_subdir_base := ""; t.listing_width := 0; t.last_src_dir := ""; t.last_install_dir:= ""; t.last_ship_dir := ""; t.all_ship_dirs := NewMap (); t.current_options := NEW (CompilerOptions); InitGlobals (t); END SetUp; PROCEDURERun (t: T; makefile: TEXT) RAISES {Quake.Error, Thread.Alerted} = BEGIN t.mode := M3Options.major_mode; IF (t.mode = MM.Build) THEN (* let m3ship know that we've built at least once... *) Utils.Remove (M3Ship); Utils.Remove (M3Overrides); TouchFile (M3Ship); END; DeleteDeriveds (t, M3Ship, NoExtension); DeleteDeriveds (t, M3Overrides, NoExtension); Quake.Run (t, makefile); MakeRoom (t, 999999); (* finish any partial listings *) END Run; PROCEDURENewMap (): IntRefTbl.T = BEGIN RETURN NEW (IntRefTbl.Default).init (); END NewMap;
global
var initialization --
PROCEDURE------------------------------------------------------------------ units --InitGlobals (t: T) = (* initializes the global state for a new build. That is, forget everything we know about source files and imports... *) BEGIN t.imports := NewMap (); M3Unit.InitSet (t.units); InitTxtList (t.tfile_args); t.derived := NewMap (); t.sys_libs := NewMap (); M3Unit.InitSet (t.ship_units); EVAL t.sys_libs.put (M3ID.Add ("LIBC"), NIL); t.current_options.debug := FALSE; t.current_options.optimize := FALSE; t.build_shared := TRUE; END InitGlobals;
PROCEDURE------------------------------------------------------------- text lists --AddSource (t: T; nm: M3ID.T; kind: UK; hidden: BOOLEAN) RAISES {Quake.Error} = VAR name := M3ID.ToText (nm); dir := M3Path.New (PkgSubdir (t), Pathname.Prefix (name)); base := M3ID.Add (Pathname.Last (name)); loc := Location (t, t.cur_pkg, M3ID.Add (dir)); unit := M3Unit.New (base, kind, loc, hidden := hidden, imported := FALSE); BEGIN unit.debug := t.current_options.debug; unit.optimize := t.current_options.optimize; M3Unit.Add (t.units, unit); DeleteObjects (t, base, kind); END AddSource; PROCEDUREAddDerived (t: T; name: M3ID.T; kind: UK; hidden: BOOLEAN) = VAR loc := Location (t, t.build_pkg, t.build_dir); unit := M3Unit.New (name, kind, loc, hidden := hidden, imported := FALSE); file := M3Unit.FileName (unit); BEGIN unit.debug := t.current_options.debug; unit.optimize := t.current_options.optimize; EVAL t.derived.put (M3ID.Add (file), NIL); M3Unit.Add (t.units, unit); DeleteDeriveds (t, file, NoExtension); DeleteObjects (t, name, kind); END AddDerived; PROCEDUREDeleteObjects (t: T; nm: M3ID.T; kind: UK) = VAR name := M3ID.ToText (nm); BEGIN CASE kind OF | UK.I3 => DeleteDeriveds (t, name, IntfExtensions); | UK.M3 => DeleteDeriveds (t, name, ImplExtensions); | UK.C => DeleteDeriveds (t, name, CExtensions); | UK.S => DeleteDeriveds (t, name, SExtensions); ELSE (* skip *) END; END DeleteObjects;
PROCEDURE------------------------------------------------------ builtin functions --InitTxtList (VAR x: TxtList) = BEGIN x.head := NIL; x.tail := NIL; END InitTxtList; PROCEDUREAddText (VAR x: TxtList; txt: TEXT) = VAR z := NEW (TextList.T, head := txt, tail := NIL); BEGIN IF (x.head = NIL) THEN x.head := z; ELSE x.tail.tail := z; END; x.tail := z; END AddText; PROCEDUREAddTexts (VAR x: TxtList; a, b, c: TEXT := NIL) = BEGIN IF (a # NIL) THEN AddText (x, a); END; IF (b # NIL) THEN AddText (x, b); END; IF (c # NIL) THEN AddText (x, c); END; END AddTexts;
TYPE Builtin = RECORD name : TEXT; proc : QCode.BuiltinProc; n_args : INTEGER; isFunc : BOOLEAN; END; CONST Builtins = ARRAY OF Builtin { (* packages & locations *) Builtin {"Pkg", DoPkg, 1, TRUE}, Builtin {"override", DoOverride, 2, FALSE}, Builtin {"path_of", DoPathOf, 1, TRUE}, Builtin {"pkg_subdir", DoPkgSubdir, 0, TRUE}, (* names *) Builtin {"program_name", DoProgramName, 1, TRUE}, Builtin {"library_name", DoLibraryName, 1, TRUE}, (* calls in the generated .M3EXPORT files *) Builtin {"_define_lib", DoDefineLib, 1, FALSE}, Builtin {"_define_pgm", DoDefinePgm, 1, FALSE}, Builtin {"_import_template", DoImportTmpl, 3, FALSE}, Builtin {"_import_m3lib", DoImportM3Lib, 3, FALSE}, Builtin {"_import_otherlib", DoImportOLib, 3, FALSE}, Builtin {"_map_add_interface", DoMapInterface, 4, FALSE}, Builtin {"_map_add_generic_interface", DoMapGenIntf, 4, FALSE}, Builtin {"_map_add_module", DoMapModule, 4, FALSE}, Builtin {"_map_add_generic_module", DoMapGenImpl, 4, FALSE}, Builtin {"_map_add_c", DoMapCSource, 4, FALSE}, Builtin {"_map_add_h", DoMapHSource, 4, FALSE}, Builtin {"_map_add_s", DoMapSSource, 4, FALSE}, (* compiler options *) Builtin {"m3_debug", DoDebug, 1, FALSE}, Builtin {"m3_optimize", DoOptimize, 1, FALSE}, Builtin {"build_shared", DoShared, 0, FALSE}, Builtin {"build_standalone", DoStandalone, 0, FALSE}, (* derived files *) Builtin {"m3_compile_only", DoCompileOnly, 0, FALSE}, Builtin {"m3_finish_up", DoFinishUp, 0, FALSE}, (* predefined system libraries *) Builtin {"import_sys_lib", DoImportSysLib, 1, FALSE}, (* options *) Builtin {"m3_option", DoM3Option, 1, FALSE}, Builtin {"remove_m3_option", DoRemoveM3Option, 1, FALSE}, (* deleting *) Builtin {"deriveds", DoDeriveds, 2, FALSE}, (* imports *) Builtin {"include_dir", DoIncludeDir, 1, FALSE}, Builtin {"include_pkg", DoIncludePkg, 1, FALSE}, Builtin {"import", DoImport, 1, FALSE}, Builtin {"import_version", DoImportVersion, 2, FALSE}, Builtin {"import_obj", DoImportObj, 1, FALSE}, Builtin {"import_lib", DoImportLib, 2, FALSE}, (* objects *) Builtin {"pgm_object", DoPgmObject, 2, FALSE}, (* sources *) Builtin {"source", DoSource, 1, FALSE}, Builtin {"pgm_source", DoPgmSource, 1, FALSE}, Builtin {"interface", DoIntf, 1, FALSE}, Builtin {"Interface", DoIntfX, 1, FALSE}, Builtin {"implementation", DoImpl, 1, FALSE}, Builtin {"module", DoModule, 1, FALSE}, Builtin {"Module", DoModuleX, 1, FALSE}, Builtin {"h_source", DoHSource, 1, FALSE}, Builtin {"c_source", DoCSource, 1, FALSE}, Builtin {"s_source", DoSSource, 1, FALSE}, Builtin {"ship_source", DoShipSource, 1, FALSE}, (* generics *) Builtin {"generic_interface", DoGenIntf, 1, FALSE}, Builtin {"Generic_interface", DoGenIntfX, 1, FALSE}, Builtin {"generic_implementation", DoGenImpl, 1, FALSE}, Builtin {"Generic_implementation", DoGenImplX, 1, FALSE}, Builtin {"generic_module", DoGenModule, 1, FALSE}, Builtin {"Generic_module", DoGenModuleX, 1, FALSE}, Builtin {"build_generic_intf", DoBuildGenIntf, 4, FALSE}, Builtin {"build_generic_impl", DoBuildGenImpl, 3, FALSE}, (* derived sources *) Builtin {"derived_interface", DoDerivedIntf, 2, FALSE}, Builtin {"derived_implementation", DoDerivedImpl, 1, FALSE}, Builtin {"derived_c", DoDerivedC, 1, FALSE}, Builtin {"derived_h", DoDerivedH, 1, FALSE}, (* hiding/exporting *) Builtin {"hide_interface", DoHideIntf, 1, FALSE}, Builtin {"hide_generic_interface", DoHideGenIntf, 1, FALSE}, Builtin {"hide_generic_implementation", DoHideGenImpl, 1, FALSE}, Builtin {"export_interface", DoExportIntf, 1, FALSE}, Builtin {"export_generic_interface", DoExportGenIntf, 1, FALSE}, Builtin {"export_generic_implementation", DoExportGenImpl, 1, FALSE}, (* templates *) Builtin {"template", DoTemplate, 1, FALSE}, (* library building *) Builtin {"library", DoLibrary, 1, FALSE}, Builtin {"Library", DoLibrary, 1, FALSE}, (* program building *) Builtin {"program", DoProgram, 1, FALSE}, Builtin {"Program", DoProgramX, 1, FALSE}, Builtin {"c_program", DoCProgram, 1, FALSE}, Builtin {"C_program", DoCProgramX, 1, FALSE}, (* man pages *) Builtin {"manPage", DoManPage, 2, FALSE}, Builtin {"ManPage", DoManPageX, 2, FALSE}, (* emacs *) Builtin {"Gnuemacs", DoGnuEmacs, 1, FALSE}, Builtin {"CompiledGnuemacs", DoCompiledEmacs, 1, FALSE}, (* "-find" support *) Builtin {"find_unit", DoFindUnit, 2, FALSE}, Builtin {"enum_units", DoEnumUnits, 1, FALSE}, (* export functions *) Builtin {"install_sources", DoInstallSources, 0, FALSE}, Builtin {"install_derived", DoInstallDerived, 1, FALSE}, Builtin {"install_derived_link", DoInsDerivedLnk, 2, FALSE}, Builtin {"install_link_to_derived", DoInsLnkToDerived, 2, FALSE}, Builtin {"install_file", DoInstallFile, 3, FALSE}, (* installation functions *) Builtin {"BindExport", DoBindExport, 1, FALSE}, Builtin {"BinExport", DoBinExport, 1, FALSE}, Builtin {"LibdExport", DoLibdExport, 1, FALSE}, Builtin {"LibExport", DoLibExport, 1, FALSE}, Builtin {"EmacsdExport", DoEmacsdExport, 1, FALSE}, Builtin {"EmacsExport", DoEmacsExport, 1, FALSE}, Builtin {"DocdExport", DoDocdExport, 1, FALSE}, Builtin {"DocExport", DoDocExport, 1, FALSE}, Builtin {"MandExport", DoMandExport, 2, FALSE}, Builtin {"ManExport", DoManExport, 2, FALSE}, Builtin {"HtmlExport", DoHtmlExport, 1, FALSE}, (* misc *) Builtin {"gen_m3exports", DoGenM3Exports, 1, FALSE}, Builtin {"generate_tfile", DoGenTFile, 0, FALSE}, Builtin {"delete_file", DoDeleteFile, 1, FALSE}, Builtin {"link_file", DoLinkFile, 2, FALSE} }; PROCEDURE------------------------------------------------------ package locations --InitBuiltins (t: T) = VAR v: QValue.T; info: QCode.ProcInfo; bind: QValue.Binding; BEGIN TRY FOR i := FIRST (Builtins) TO LAST (Builtins) DO WITH z = Builtins[i] DO info := NEW (QCode.ProcInfo); info.name := M3ID.Add (z.name); info.n_args := z.n_args; info.builtin := TRUE; info.isFunc := z.isFunc; info.handler := z.proc; v.kind := QValue.Kind.Proc; v.ref := NEW (QValue.Proc, info := info, env := NIL); v.int := 0; t.put (info.name, v); (* make the definition "readonly" *) bind := t.lookup (info.name); bind.readonly := TRUE; END; END; (* defined for backward compatibility *) Quake.Define (t, "LOCAL", "local"); Quake.Define (t, "IMPORTED", ""); Quake.Define (t, "HIDDEN", "hidden"); Quake.Define (t, "VISIBLE", ""); Quake.Define (t, "CR", Wr.EOL); Quake.Define (t, "SL", DetermineSlash ()); DefineArray (t, "intf_extensions", IntfExtensions); DefineArray (t, "impl_extensions", ImplExtensions); DefineArray (t, "c_extensions", CExtensions); DefineArray (t, "s_extensions", SExtensions); DefineArray (t, "no_extension", NoExtension); EXCEPT Quake.Error (msg) => Msg.FatalError (NIL, "unable to define M3/quake builtins: ", msg); END; END InitBuiltins; PROCEDUREDefineArray (t: T; nm: TEXT; READONLY arr: ARRAY OF TEXT) RAISES {Quake.Error} = VAR v: QValue.T; seq := NEW (QVSeq.T).init (NUMBER (arr)); BEGIN FOR i := FIRST (arr) TO LAST (arr) DO v.kind := QValue.Kind.String; v.int := M3ID.Add (arr[i]); v.ref := NIL; seq.addhi (v); END; v.kind := QValue.Kind.Array; v.int := 0; v.ref := seq; t.put (M3ID.Add (nm), v); END DefineArray; PROCEDUREDetermineSlash (): TEXT = CONST Slash = ARRAY BOOLEAN OF TEXT { "\\", "/" }; VAR on_unix := Text.Equal ("a/b", Pathname.Join ("a", "b", NIL)); BEGIN RETURN Slash [on_unix]; END DetermineSlash;
PROCEDURE------------------------------------------------------ general locations --DoPkg (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN PushText (t, Pkg (t, PopID (t))); END DoPkg; PROCEDUREPkg (t: T; nm: M3ID.T): TEXT = (* returns the path currently used to reach package 'x' *) VAR ref: REFANY; dir: TEXT; BEGIN IF t.pkg_cache.get (nm, ref) THEN RETURN NARROW (ref, TEXT); ELSIF t.pkg_overrides.get (nm, ref) THEN dir := NARROW (ref, TEXT); ELSE dir := t.pkg_use; END; dir := M3Path.New (dir, M3ID.ToText (nm)); EVAL t.pkg_cache.put (nm, dir); RETURN dir; END Pkg; PROCEDUREDoOverride (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); pkg: M3ID.T; dir: TEXT; BEGIN dir := PopText (t); pkg := PopID (t); Override (t, pkg, dir); END DoOverride; PROCEDUREOverride (t: T; pkg: M3ID.T; dir: TEXT) = (* establish an override for the location of package "pkg" *) VAR ref: REFANY; pkg_txt := M3ID.ToText (pkg); BEGIN IF t.build_pkg = pkg THEN IF t.already_warned THEN RETURN; END; IF M3Options.major_mode = MM.Depend THEN Msg.Verbose ("ignoring override(\"", pkg_txt, QCQ, dir, QRPCR); ELSE Msg.Info ("ignoring override(\"", pkg_txt, QCQ, dir, QRPCR); END; t.already_warned := TRUE; ELSIF t.pkg_overrides.get (pkg, ref) THEN IF NOT Text.Equal (dir, ref) THEN IF M3Options.major_mode = MM.Depend THEN Msg.Verbose ("package \"", pkg_txt, "\" is already overridden to ", ref, ", ignoring new override to " & dir & Wr.EOL); ELSE Msg.Info ("package \"", pkg_txt, "\" is already overridden to ", ref, ", ignoring new override to ", dir & Wr.EOL); END; END; ELSE EVAL t.pkg_overrides.put (pkg, dir); EVAL t.pkg_cache.put (pkg, M3Path.New (dir, pkg_txt)); END; END Override; PROCEDUREInclude (t: T; file: TEXT) RAISES {Quake.Error, Thread.Alerted} = BEGIN (* We cannot be sure that _any_ packages are there when we compute the package dependencies. If an appropriate .M3EXPORTS file cannot be found, we simply create a dummy unit representing the package import. *) IF t.mode # MM.Depend OR Utils.IsFile(file) THEN t.include (file); ELSE Msg.Debug ("simulating inclusion of ", file, Wr.EOL); VAR lib, pkg, subdir, last: TEXT; pkg_id, subdir_id, lib_id: M3ID.T; loc: M3Loc.T; BEGIN IF file # NIL THEN last := Pathname.Last(file); IF last # NIL AND Text.Equal(last, ".M3EXPORTS") THEN file := Pathname.Prefix(file); subdir := Pathname.Last(file); file := Pathname.Prefix(file); pkg := Pathname.Last(file); pkg_id := M3ID.Add(pkg); subdir_id := M3ID.Add(subdir); lib := pkg & "_unknown"; lib_id := M3ID.Add(lib); loc := Location (t, pkg_id, subdir_id); M3Unit.AddNew (t.units, lib_id, UK.M3LIB, loc, hidden := TRUE, imported := TRUE); END; END; END; END; END Include;
PROCEDURE--------------------------------------------------------- relative paths --Location (t: T; pkg, subdir: M3ID.T): M3Loc.T = (* Return the full path that identifies the given subdirectory within the package. *) VAR pkg_dir: TEXT; BEGIN IF (pkg = M3Loc.noPkg) THEN pkg_dir := NIL; ELSE pkg_dir := Pkg (t, pkg); END; RETURN M3Loc.New (pkg, subdir, pkg_dir); END Location;
PROCEDURE------------------------------------------------------------------ names --DoPathOf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN PushText (t, PathOf (t, PopText (t))); END DoPathOf; PROCEDUREPathOf (t: T; x: TEXT): TEXT (* Returns the path needed to reach 'x' from the build directory *) RAISES {Quake.Error} = VAR ref: REFANY; p: TEXT; BEGIN IF t.derived.get (M3ID.Add (x), ref) THEN (* This initial lookup in derived_sources allows packages (such as ** netobj) that were written without derived sources in mind to work ** without modification. *) RETURN x; END; p := t.cur_path (); IF NOT Text.Equal (p, t.path_of_path) THEN t.path_of_path := p; t.path_of_base := M3Path.New (Pkg (t, t.cur_pkg), PkgSubdir (t)); END; RETURN M3Path.New (t.path_of_base, x); END PathOf; PROCEDUREDoPkgSubdir (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN PushText (t, PkgSubdir (t)); END DoPkgSubdir; PROCEDUREPkgSubdir (t: T): TEXT (* returns the path needed to reach the current directory from the current package *) RAISES {Quake.Error} = VAR p := t.cur_path (); BEGIN IF NOT Text.Equal (p, t.pkg_subdir_path) THEN t.pkg_subdir_path := p; t.pkg_subdir_base := t.normalize (M3ID.ToText (t.cur_pkg_dir), t.pkg_subdir_path); END; RETURN t.pkg_subdir_base; END PkgSubdir;
PROCEDURE------------------------------------- calls used in generated files only --DoProgramName (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN PushText (t, M3Path.ProgramName (PopText (t), host := TRUE)); END DoProgramName; PROCEDUREDoLibraryName (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN PushText (t, M3Path.LibraryName (PopText (t), host := TRUE)); END DoLibraryName;
PROCEDURE------------------------------------------------------------------ misc ---DoDefineLib (<*UNUSED*> m: QMachine.T; <*UNUSED*> n_args: INTEGER) = BEGIN END DoDefineLib; PROCEDUREDoDefinePgm (<*UNUSED*> m: QMachine.T; <*UNUSED*> n_args: INTEGER) = BEGIN END DoDefinePgm; PROCEDUREDoImportTmpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error, Thread.Alerted} = VAR t := Self (m); pkg: M3ID.T; file, subdir: TEXT; BEGIN subdir := PopText (t); pkg := PopID (t); file := PopText (t); Include (t, M3Path.New (Pkg (t, pkg), subdir, file)); END DoImportTmpl; PROCEDUREDoImportM3Lib (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); lib, pkg, subdir: M3ID.T; loc: M3Loc.T; BEGIN subdir := PopID (t); pkg := PopID (t); lib := PopID (t); loc := Location (t, pkg, subdir); M3Unit.AddNew (t.units, lib, UK.M3LIB, loc, hidden := TRUE, imported := TRUE); END DoImportM3Lib; PROCEDUREDoImportOLib (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); lib, path: M3ID.T; imported: BOOLEAN; BEGIN imported := PopBool (t); path := PopID (t); lib := PopID (t); ImportOtherLib (t, lib, path, imported); END DoImportOLib; PROCEDUREImportOtherLib (t: T; lib, path: M3ID.T; imported: BOOLEAN) = VAR loc := Location (t, M3Loc.noPkg, path); BEGIN M3Unit.AddNew (t.units, lib, UK.LIB, loc, hidden := FALSE, imported := imported); END ImportOtherLib; PROCEDUREDoMapInterface (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = BEGIN MapSource (Self (m), UK.I3); END DoMapInterface; PROCEDUREDoMapGenIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = BEGIN MapSource (Self (m), UK.IG); END DoMapGenIntf; PROCEDUREDoMapModule (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = BEGIN MapSource (Self (m), UK.M3); END DoMapModule; PROCEDUREDoMapGenImpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = BEGIN MapSource (Self (m), UK.MG); END DoMapGenImpl; PROCEDUREDoMapCSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = BEGIN MapSource (Self (m), UK.C); END DoMapCSource; PROCEDUREDoMapHSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = BEGIN MapSource (Self (m), UK.H); END DoMapHSource; PROCEDUREDoMapSSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = BEGIN MapSource (Self (m), UK.S); END DoMapSSource; PROCEDUREMapSource (t: T; kind: UK) RAISES {Quake.Error} = VAR name, pkg, subdir: M3ID.T; vis: BOOLEAN; loc: M3Loc.T; zz: M3Path.T; BEGIN vis := PopBool (t); subdir := PopID (t); pkg := PopID (t); name := PopID (t); loc := Location (t, pkg, subdir); zz := M3Path.Parse (M3ID.ToText (name), host := TRUE); IF (zz.kind # kind) THEN Msg.FatalError (NIL, "imported file extension doesn't match expected type: ", M3ID.ToText (name)); END; M3Unit.AddNew (t.units, M3ID.Add (zz.base), kind, loc, hidden := vis, imported := TRUE); END MapSource;
PROCEDURE-------------------------------------------- predefined system libraries --DoDebug (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN t.current_options.debug := PopBool (t); END DoDebug; PROCEDUREDoOptimize (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN t.current_options.optimize := PopBool (t); END DoOptimize; PROCEDUREDoShared (m: QMachine.T; <*UNUSED*> n_args: INTEGER) = VAR t := Self (m); BEGIN t.build_shared := TRUE; END DoShared; PROCEDUREDoStandalone (m: QMachine.T; <*UNUSED*> n_args: INTEGER) = VAR t := Self (m); BEGIN t.build_shared := FALSE; END DoStandalone; PROCEDUREDoCompileOnly (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN GenM3Exports (t, "%% compile only"); IF (t.mode = MM.Build) THEN Builder.JustCompile (t.units, SysLibs (t), t); InstallDerived (t, M3Web); InstallSources (t); END; DeleteDeriveds (t, M3Web, NoExtension); InitGlobals (t); (* forget about the accumulated sources... *) END DoCompileOnly; PROCEDUREDoFinishUp (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN IF (t.units.head # NIL) THEN GenM3Exports (t, "%% finish up"); IF (t.mode = MM.Build) THEN Builder.JustCompile (t.units, SysLibs (t), t); InstallDerived (t, M3Web); InstallSources (t); END; DeleteDeriveds (t, M3Web, NoExtension); InitGlobals (t); (* forget about the accumulated sources... *) END; END DoFinishUp;
PROCEDURE---------------------------------------------------------------- options -- These are hacks to provide some backward compatibility with the old m3buildDoImportSysLib (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); val: QValue.T; BEGIN IF NOT t.system_libs.get (nm, val) THEN ConfigErr (t, "SYSTEM_LIBS", "does not define a value for \"" & M3ID.ToText (nm) & "\""); END; IF NOT t.sys_libs.put (nm, NIL) THEN AddTexts (t.tfile_args, "import_sys_lib(\"", M3ID.ToText (nm), QRPCR); END; END DoImportSysLib; PROCEDURESysLibs (t: T): Arg.List RAISES {Quake.Error} = VAR libs := Arg.NewList (); ref : REFANY; val : QValue.T; args : QVSeq.T; nm : M3ID.T; BEGIN FOR i := 0 TO t.system_liborder.size() - 1 DO nm := M3ID.Add (QVal.ToText (t, t.system_liborder.get (i))); IF t.sys_libs.get (nm, ref) AND t.system_libs.get (nm, val) THEN args := QVal.ToArray (t, val); FOR i := 0 TO args.size() - 1 DO Arg.Append (libs, QVal.ToText (t, args.get (i))); END; END; END; RETURN libs; END SysLibs;
PROCEDURE--------------------------------------------------------------- deleting -- We don't supportDoM3Option (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); arg: TEXT; BEGIN arg := PopText (t); IF Text.Equal (arg, "-silent") THEN Msg.SetLevel (Msg.Level.Silent); ELSIF Text.Equal (arg, "-why") THEN Msg.SetLevel (Msg.Level.Explain); ELSIF Text.Equal (arg, "-explain") THEN Msg.SetLevel (Msg.Level.Explain); ELSIF Text.Equal (arg, "-commands") THEN Msg.SetLevel (Msg.Level.Commands); ELSIF Text.Equal (arg, "-verbose") THEN Msg.SetLevel (Msg.Level.Verbose); ELSIF Text.Equal (arg, "-debug") THEN Msg.SetLevel (Msg.Level.Debug); ELSIF Text.Equal (arg, "-times") THEN M3Timers.Start (); ELSIF Text.Equal (arg, "-keep") THEN Quake.Define (t, "M3_KEEP_FILES", "TRUE"); ELSIF Text.Equal (arg, "-gui") THEN Quake.Define (t, "M3_WINDOWS_GUI", "TRUE"); ELSIF Text.Equal (arg, "-windows") THEN Quake.Define (t, "M3_WINDOWS_GUI", "TRUE"); ELSE Msg.Error (NIL, "unsupported m3_option value: \"", arg, "\""); END; END DoM3Option; PROCEDUREDoRemoveM3Option (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); arg: TEXT; BEGIN arg := PopText (t); Msg.Info ("remove_m3_option (\"", arg, "\") is being ignored.", Wr.EOL) END DoRemoveM3Option;
-clean
....
PROCEDURE---------------------------------------------------------------- imports --DoDeriveds (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); base: TEXT; exts: QVSeq.T; BEGIN exts := PopArray (t); base := PopText (t); IF (t.mode = MM.Clean) THEN DeleteDeriveds (t, base, SeqToTexts (t, exts)^); END; END DoDeriveds; PROCEDUREDeleteDeriveds (t: T; base: TEXT; READONLY exts: ARRAY OF TEXT) = BEGIN IF (t.mode = MM.Clean) THEN FOR i := FIRST (exts) TO LAST (exts) DO Utils.Remove (base & exts[i]); END; END; END DeleteDeriveds;
PROCEDURE---------------------------------------------------------------- objects --DoIncludeDir (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error, Thread.Alerted} = VAR t := Self (m); dir: TEXT; BEGIN dir := PopText (t); Include (t, M3Path.New (t.cur_path(), dir, "m3makefile")); END DoIncludeDir; PROCEDUREDoIncludePkg (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error, Thread.Alerted} = VAR t := Self (m); pkg, save_pkg, save_dir: M3ID.T; BEGIN pkg := PopID (t); save_pkg := t.cur_pkg; save_dir := t.cur_pkg_dir; t.cur_pkg := pkg; t.cur_pkg_dir := M3ID.Add (Pkg (t, pkg)); TRY Include (t, M3Path.New (M3ID.ToText (t.cur_pkg_dir), "src", "m3makefile")); FINALLY t.cur_pkg := save_pkg; t.cur_pkg_dir := save_dir; END; END DoIncludePkg; PROCEDUREDoImport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error, Thread.Alerted} = VAR t := Self (m); BEGIN ImportVersion (t, PopID (t), t.build_dir); END DoImport; PROCEDUREDoImportVersion (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error, Thread.Alerted} = VAR t := Self (m); pkg, vers: M3ID.T; BEGIN vers := PopID (t); pkg := PopID (t); ImportVersion (t, pkg, vers); END DoImportVersion; PROCEDUREImportVersion (t: T; pkg, vers: M3ID.T) RAISES {Quake.Error, Thread.Alerted} = VAR ref: REFANY; vers_txt := M3ID.ToText (vers); BEGIN IF (pkg = t.build_pkg) THEN t.error ("cannot import package \"" & M3ID.ToText (pkg) & "\" into itself."); END; IF NOT t.imports.get (pkg, ref) THEN EVAL t.imports.put (pkg, vers_txt); Include (t, M3Path.New (Pkg (t, pkg), vers_txt, M3Exports)); END; END ImportVersion; PROCEDUREDoImportObj (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PathOf (t, PopText (t)); dir := M3Path.New (PkgSubdir (t), Pathname.Prefix (file)); base := M3ID.Add (Pathname.Last (file)); loc := Location (t, t.cur_pkg, M3ID.Add (dir)); unit := M3Unit.New (base, UK.O, loc, hidden := FALSE, imported := FALSE); fn := M3Unit.FileName(unit); pn := Pathname.Join(loc.path, fn, NIL); BEGIN M3Unit.AddNew (t.units, base, UK.O, loc, imported := FALSE, hidden := TRUE); M3Unit.Add (t.units, unit); Utils.LinkFile (pn, fn); END DoImportObj; PROCEDUREDoImportLib (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); lib, path: M3ID.T; BEGIN path := PopID (t); lib := PopID (t); ImportOtherLib (t, lib, path, imported := FALSE); END DoImportLib;
PROCEDURE---------------------------------------------------------------- sources --DoPgmObject (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); v: QValue.T; BEGIN t.pop (v); (* extension *) t.pop (v); (* filename base *) END DoPgmObject;
PROCEDURE--------------------------------------------------------------- generics --DoSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); v: QValue.T; BEGIN t.pop (v); (* source file name, ignored *) END DoSource; PROCEDUREDoPgmSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); name := M3ID.ToText (nm); dir := M3Path.New (PkgSubdir (t), Pathname.Prefix (name)); zz := M3Path.Parse (Pathname.Last (name), host := TRUE); base := M3ID.Add (zz.base); loc := Location (t, t.cur_pkg, M3ID.Add (dir)); unit := M3Unit.New (base, zz.kind, loc, hidden := TRUE, imported := FALSE); BEGIN M3Unit.Add (t.units, unit); END DoPgmSource; PROCEDUREDoIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.I3, hidden := TRUE); END DoIntf; PROCEDUREDoIntfX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.I3, hidden := FALSE); END DoIntfX; PROCEDUREDoImpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.M3, hidden := TRUE); END DoImpl; PROCEDUREDoModule (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.I3, hidden := TRUE); AddSource (t, nm, UK.M3, hidden := TRUE); END DoModule; PROCEDUREDoModuleX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.I3, hidden := FALSE); AddSource (t, nm, UK.M3, hidden := TRUE); END DoModuleX; PROCEDUREDoHSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN AddSource (t, PopID (t), UK.H, hidden := FALSE); END DoHSource; PROCEDUREDoCSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.C, hidden := TRUE); END DoCSource; PROCEDUREDoSSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.S, hidden := TRUE); END DoSSource; PROCEDUREDoShipSource (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); name := M3ID.ToText (nm); dir := M3Path.New (PkgSubdir (t), Pathname.Prefix (name)); base := M3ID.Add (Pathname.Last (name)); loc := Location (t, t.cur_pkg, M3ID.Add (dir)); unit := M3Unit.New (base, UK.Unknown, loc, hidden := TRUE, imported := FALSE); BEGIN M3Unit.Add (t.ship_units, unit); END DoShipSource;
PROCEDURE-------------------------------------------------------- derived sources --DoGenIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN AddSource (t, PopID (t), UK.IG, hidden := TRUE); END DoGenIntf; PROCEDUREDoGenIntfX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN AddSource (t, PopID (t), UK.IG, hidden := FALSE); END DoGenIntfX; PROCEDUREDoGenImpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN AddSource (t, PopID (t), UK.MG, hidden := TRUE); END DoGenImpl; PROCEDUREDoGenImplX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN AddSource (t, PopID (t), UK.MG, hidden := FALSE); END DoGenImplX; PROCEDUREDoGenModule (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.IG, hidden := TRUE); AddSource (t, nm, UK.MG, hidden := TRUE); END DoGenModule; PROCEDUREDoGenModuleX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.IG, hidden := FALSE); AddSource (t, nm, UK.MG, hidden := FALSE); END DoGenModuleX; PROCEDUREDoBuildGenIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm: M3ID.T; name, generic: TEXT; args: QVSeq.T; vis: BOOLEAN; BEGIN vis := PopBool (t); args := PopArray (t); generic := PopText (t); nm := PopID (t); name := M3ID.ToText (nm); BuildGeneric (t, "INTERFACE ", name & ".i3", name, generic, args); AddDerived (t, nm, UK.I3, hidden := vis); END DoBuildGenIntf; PROCEDUREDoBuildGenImpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm: M3ID.T; name, generic: TEXT; args: QVSeq.T; BEGIN args := PopArray (t); generic := PopText (t); nm := PopID (t); name := M3ID.ToText (nm); BuildGeneric (t, "MODULE ", name & ".m3", name, generic, args); AddDerived (t, nm, UK.M3, hidden := TRUE); END DoBuildGenImpl; PROCEDUREBuildGeneric (t: T; kind, file, name, generic: TEXT; args: QVSeq.T) RAISES {Quake.Error} = CONST tmp = ".generic.tmp"; VAR txts: TextVector; PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR comma: TEXT := NIL; BEGIN Out (wr, "(*generated by m3build*)", Wr.EOL, Wr.EOL); Out (wr, kind, " ", name, " = "); Out (wr, generic, " ("); FOR i := 0 TO LAST (txts^) DO Out (wr, comma, txts[i]); comma := ", "; END; Out (wr, ") END ", name, ".", Wr.EOL); END Emit; BEGIN IF (t.mode = MM.Build) THEN txts := SeqToTexts (t, args); Utils.WriteFile (tmp, Emit, append := FALSE); t.cp_if (tmp, file); Utils.Remove (tmp); END; END BuildGeneric;
PROCEDURE------------------------------------------------------- hiding/exporting -- These are forwarded in the exports fileDoDerivedIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file: M3ID.T; vis: BOOLEAN; BEGIN vis := PopBool (t); file := PopID (t); AddDerived (t, file, UK.I3, hidden := vis); DeleteDeriveds (t, M3ID.ToText (file), IntfExtensions); END DoDerivedIntf; PROCEDUREDoDerivedImpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopID (t); BEGIN AddDerived (t, file, UK.M3, hidden := TRUE); DeleteDeriveds (t, M3ID.ToText (file), ImplExtensions); END DoDerivedImpl; PROCEDUREDoDerivedC (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopID (t); BEGIN AddDerived (t, file, UK.C, hidden := TRUE); DeleteDeriveds (t, M3ID.ToText (file), CExtensions); END DoDerivedC; PROCEDUREDoDerivedH (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN AddDerived (t, PopID (t), UK.H, hidden := FALSE); END DoDerivedH;
PROCEDURE-------------------------------------------------------------- templates --SetVis (t: T; nm: M3ID.T; kind: UK; hidden: BOOLEAN) = VAR u := M3Unit.Get (t.units, nm, kind); BEGIN IF (u # NIL) THEN u.hidden := hidden; ELSE Msg.FatalError (NIL, "set_visibility of unknown unit: ", M3Path.Join (NIL, M3ID.ToText (nm), kind, host := TRUE)); END; END SetVis; PROCEDUREDoHideIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN SetVis (t, nm, UK.I3, hidden := TRUE); AddTexts (t.tfile_args, "hide_interface(\"", M3ID.ToText (nm), QRPCR); END DoHideIntf; PROCEDUREDoHideGenIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN SetVis (t, nm, UK.IG, hidden := TRUE); AddTexts (t.tfile_args, "hide_generic_interface(\"", M3ID.ToText (nm), QRPCR); END DoHideGenIntf; PROCEDUREDoHideGenImpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN SetVis (t, nm, UK.MG, hidden := TRUE); AddTexts (t.tfile_args, "hide_generic_implementation(\"", M3ID.ToText (nm), QRPCR); END DoHideGenImpl; PROCEDUREDoExportIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN SetVis (t, nm, UK.I3, hidden := FALSE); AddTexts (t.tfile_args, "export_interface(\"", M3ID.ToText (nm), QRPCR); END DoExportIntf; PROCEDUREDoExportGenIntf (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN SetVis (t, nm, UK.IG, hidden := FALSE); AddTexts (t.tfile_args, "export_generic_interface(\"", M3ID.ToText (nm), QRPCR); END DoExportGenIntf; PROCEDUREDoExportGenImpl (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); BEGIN SetVis (t, nm, UK.MG, hidden := FALSE); AddTexts (t.tfile_args, "export_generic_implementation(\"", M3ID.ToText (nm), QRPCR); END DoExportGenImpl;
PROCEDURE------------------------------------------------------- library building --DoTemplate (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error, Thread.Alerted} = VAR t := Self (m); nm := PopID (t); BEGIN AddSource (t, nm, UK.TMPL, hidden := FALSE); Include (t, M3Path.Join (NIL, M3ID.ToText (nm), UK.TMPL, host := TRUE)); END DoTemplate;
PROCEDURE------------------------------------------------------- program building --DoLibrary (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm: M3ID.T; name, lib_a, lib_m3x: TEXT; BEGIN nm := PopID (t); name := M3ID.ToText (nm); AddDerived (t, nm, UK.M3LIB, hidden := TRUE); GenM3Exports (t, "_define_lib(\"" & name & QRPCR); lib_a := M3Path.Join (NIL, name, UK.M3LIB, host := TRUE); lib_m3x := M3Path.Join (NIL, name, UK.LIBX, host := TRUE); IF (t.mode = MM.Build) THEN Builder.BuildLib (name, t.units, SysLibs (t), t.build_shared, t); InstallDerived (t, lib_a); InstallDerived (t, lib_m3x); InstallDerived (t, M3Web); InstallSources (t); END; IF (t.mode = MM.Find) THEN FindUnits (t); END; IF (t.mode = MM.Depend) THEN Msg.Out (M3ID.ToText(t.build_pkg), ":"); Builder.EmitPkgImports (t.units); done := TRUE; END; DeleteDeriveds (t, lib_a, NoExtension); DeleteDeriveds (t, lib_m3x, NoExtension); DeleteDeriveds (t, M3Web, NoExtension); DeleteDeriveds (t, name & ".lst", NoExtension); InitGlobals (t); (* forget about the accumulated sources... *) END DoLibrary;
PROCEDURE-------------------------------------------------------------- man pages --DoProgram (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); prog := M3Path.ProgramName (M3ID.ToText (nm), host := TRUE); BEGIN BuildProgram (t, nm); IF (t.mode = MM.Build) THEN InstallDerived (t, prog); END; END DoProgram; PROCEDUREDoProgramX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopID (t); prog := M3Path.ProgramName (M3ID.ToText (nm), host := TRUE); BEGIN BuildProgram (t, nm); BindExport (t, prog); END DoProgramX; PROCEDUREBuildProgram (t: T; nm: M3ID.T) RAISES {Quake.Error} = CONST Extras = ARRAY OF TEXT { "_m3main.c","_m3main.o","_m3main.obj", M3Web }; CONST Junk = ARRAY OF TEXT { ".map", ".lst" }; VAR name := M3ID.ToText (nm); BEGIN (*** AddDerived (t, nm, UK.EXE, hidden := TRUE); -- not needed ***) GenM3Exports (t, "_define_pgm(\"" & name & QRPCR); IF (t.mode = MM.Build) THEN Builder.BuildPgm (name, t.units, SysLibs (t), t.build_shared, t); InstallDerived (t, M3Web); InstallSources (t); END; IF (t.mode = MM.Find) THEN FindUnits (t); END; IF (t.mode = MM.Depend) THEN Msg.Out (M3ID.ToText(t.build_pkg), ":"); Builder.EmitPkgImports (t.units); done := TRUE; END; DeleteDeriveds (t, M3Path.ProgramName (name, host := TRUE), NoExtension); DeleteDeriveds (t, M3Path.Join (NIL, name, UK.PGMX, host := TRUE), NoExtension); DeleteDeriveds (t, M3Web, NoExtension); DeleteDeriveds (t, name, Junk); DeleteDeriveds (t, "", Extras); InitGlobals (t); (* forget about the accumulated sources... *) END BuildProgram; PROCEDUREDoCProgram (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); name := PopText (t); BEGIN IF (t.mode = MM.Build) THEN Builder.BuildCPgm (name, t.units, SysLibs (t), t.build_shared, t); END; IF (t.mode = MM.Find) THEN FindUnits (t); END; IF (t.mode = MM.Depend) THEN Msg.Out (M3ID.ToText(t.build_pkg), ":"); Builder.EmitPkgImports (t.units); done := TRUE; END; DeleteDeriveds (t, M3Path.ProgramName (name, host := TRUE), NoExtension); InitGlobals (t); (* forget about the accumulated sources... *) END DoCProgram; PROCEDUREDoCProgramX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); name := PopText (t); prog: TEXT; BEGIN IF (t.mode = MM.Build) THEN Builder.BuildCPgm (name, t.units, SysLibs (t), t.build_shared, t); END; IF (t.mode = MM.Find) THEN FindUnits (t); END; IF (t.mode = MM.Depend) THEN Msg.Out (M3ID.ToText(t.build_pkg), ":"); Builder.EmitPkgImports (t.units); done := TRUE; END; prog := M3Path.ProgramName (name, host := TRUE); BindExport (t, prog); DeleteDeriveds (t, prog, NoExtension); InitGlobals (t); (* forget about the accumulated sources... *) END DoCProgramX;
PROCEDURE------------------------------------------------------------------ emacs --DoManPage (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm, sec: TEXT; BEGIN sec := PopText (t); nm := PopText (t); BuildManPage (t, nm, sec); END DoManPage; PROCEDUREDoManPageX (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm, sec: TEXT; BEGIN sec := PopText (t); nm := PopText (t); BuildManPage (t, nm, sec); InstallMan (t, nm, sec, derived := TRUE); END DoManPageX; PROCEDUREBuildManPage (t: T; nm, sec: TEXT) RAISES {Quake.Error} = VAR dest := nm & "." & sec; src := PathOf (t, dest); BEGIN IF (t.mode = MM.Build) THEN IF IsStale (dest, src) THEN Utils.CopyText (src, dest); END; END; DeleteDeriveds (t, dest, NoExtension); END BuildManPage;
PROCEDURE-------------------------------------------------------- m3where support --DoGnuEmacs (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); nm := PopText (t); BEGIN EmacsExport (t, PathOf (t, nm & ".el")); END DoGnuEmacs; PROCEDUREDoCompiledEmacs (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error, Thread.Alerted} = VAR t := Self (m); nm := PopText (t); src, el, elc: TEXT; BEGIN IF t.lookup (M3ID.Add ("emacs_compile")) # NIL THEN el := nm & ".el"; elc := nm & ".elc"; src := PathOf (t, el); IF (t.mode = MM.Build) THEN t.cp_if (src, el); IF IsStale (elc, el) THEN VAR b := t.lookup (M3ID.Add ("emacs_compile")); BEGIN IF (b # NIL) THEN t.start_call (b.value); PushText (t, el); t.call_proc (1, FALSE); END; END; END; END; EmacsdExport (t, el); EmacsdExport (t, elc); DeleteDeriveds (t, el, NoExtension); DeleteDeriveds (t, elc, NoExtension); ELSE EmacsExport (t, PathOf (t, nm & ".el")); END; END DoCompiledEmacs;
PROCEDURE------------------------------------------------------- export functions --DoFindUnit (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); unit: TEXT; any_unit: BOOLEAN; BEGIN any_unit := PopBool (t); unit := PopText (t); FindUnit (t, unit, any_unit); END DoFindUnit; PROCEDUREFindUnits (t: T) RAISES {Quake.Error} = VAR bind := t.lookup (M3ID.Add ("M3_FIND_UNITS")); txts: TextVector; BEGIN IF (bind = NIL) THEN RETURN END; txts := SeqToTexts (t, QVal.ToArray (t, bind.value)); FOR i := FIRST (txts^) TO LAST (txts^) DO FindUnit (t, txts[i], any_unit := TRUE); END; END FindUnits; PROCEDUREFindUnit (t: T; unit: TEXT; any_unit: BOOLEAN) = VAR u: M3Unit.T; found := FALSE; unm := M3ID.Add (unit); name : M3Path.T; base : M3ID.T; BEGIN name := M3Path.Parse (unit, host := TRUE); base := M3ID.Add (name.base); u := t.units.head; WHILE (u # NIL) DO IF ((u.name = unm) OR (u.name = base AND u.kind = name.kind)) AND (any_unit OR NOT u.hidden) THEN Msg.Out (M3Unit.FullPath (u), Wr.EOL); found := TRUE; END; u := u.next; END; IF NOT found THEN Msg.Out ("\"", unit, "\" not found.", Wr.EOL); END; END FindUnit; PROCEDUREDoEnumUnits (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); any_unit := PopBool (t); u: M3Unit.T; BEGIN u := t.units.head; WHILE (u # NIL) DO IF any_unit OR NOT u.hidden THEN Msg.Out (M3Unit.FullPath (u), Wr.EOL); END; u := u.next; END; END DoEnumUnits;
PROCEDURE---------------------------------------------- internal export utilities --DoInstallSources (m: QMachine.T; <*UNUSED*> n_args: INTEGER) = BEGIN InstallSources (Self (m)); END DoInstallSources; PROCEDUREInstallSources (t: T) = CONST IsSource = ARRAY UK OF BOOLEAN { FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE }; VAR n_local := 0; u : M3Unit.T; srcs: REF ARRAY OF M3Unit.T; map : REF ARRAY OF INTEGER; PROCEDURE CmpUnit (ax, bx: INTEGER): [-1 .. +1] = VAR a := srcs[ax]; b := srcs[bx]; BEGIN IF a.loc.pkg < b.loc.pkg THEN RETURN -1; END; IF a.loc.pkg > b.loc.pkg THEN RETURN +1; END; IF a.loc.subdir < b.loc.subdir THEN RETURN -1; END; IF a.loc.subdir > b.loc.subdir THEN RETURN + 1; END; IF a.name < b.name THEN RETURN -1; END; IF a.name > b.name THEN RETURN +1; END; RETURN 0; END CmpUnit; PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR uu: M3Unit.T; last_loc : M3Loc.T := NIL; src, dest: TEXT; BEGIN FOR i := 0 TO LAST (map^) DO uu := srcs [map[i]]; IF (uu.loc # last_loc) THEN dest := M3Path.New (t.pkg_install, M3ID.ToText (uu.loc.pkg), M3ID.ToText (uu.loc.subdir)); InstallDir (t, dest, wr); last_loc := uu.loc; END; src := M3Unit.FullPath (uu); Out (wr, "install_file(\"", M3Path.Escape (src), QCQ); Out (wr, M3Path.Escape (dest), QCQ, "0644", QRPCR); END; END Emit; BEGIN IF t.have_pkgtools THEN RETURN; END; (* count the local sources *) u := t.units.head; WHILE (u # NIL) DO IF NOT u.imported AND IsSource [u.kind] THEN INC (n_local); END; u := u.next; END; u := t.ship_units.head; WHILE (u # NIL) DO INC (n_local); u := u.next; END; (* collect up the sources in an array *) srcs := NEW (REF ARRAY OF M3Unit.T, n_local); map := NEW (REF ARRAY OF INTEGER, n_local); n_local := 0; u := t.units.head; WHILE (u # NIL) DO IF NOT u.imported AND IsSource [u.kind] THEN srcs [n_local] := u; map [n_local] := n_local; INC (n_local); END; u := u.next; END; u := t.ship_units.head; WHILE (u # NIL) DO srcs [n_local] := u; map [n_local] := n_local; INC (n_local); u := u.next; END; (* sort the local sources by directory *) IntArraySort.Sort (map^, CmpUnit); (* finally, dump the file *) Utils.WriteFile (M3Ship, Emit, append := TRUE); END InstallSources; PROCEDUREDoInstallDerived (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN InstallDerived (t, PopText (t)); END DoInstallDerived; PROCEDUREDoInsDerivedLnk (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); from, to: TEXT; BEGIN to := PopText (t); from := PopText (t); InstallDerivedLink (t, from, to); END DoInsDerivedLnk; PROCEDUREDoInsLnkToDerived (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); src, dest: TEXT; BEGIN dest := PopText (t); src := PopText (t); InstallLinkToDerived (t, src, dest); END DoInsLnkToDerived; PROCEDUREDoInstallFile (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = CONST Pad = ARRAY [0..16] OF TEXT { " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", "" }; VAR t := Self (m); src, dest, mode, src_dir, src_file: TEXT; BEGIN mode := PopText (t); (* ignored *) dest := PopText (t); src := PopText (t); IF (Msg.level >= Msg.Level.Explain) THEN src_dir := Pathname.Prefix (src); src_file := Pathname.Last (src); IF (src_dir = NIL) OR Text.Equal (src_dir, "") THEN src_dir := "."; END; IF NOT Text.Equal (dest, t.last_install_dir) OR NOT Text.Equal (src_dir, t.last_src_dir) THEN MakeRoom (t, 99999); Msg.Explain (src_dir, " => ", dest); t.last_install_dir := dest; t.last_src_dir := src_dir; t.listing_width := 0; END; MakeRoom (t, 2 + MAX (Text.Length (src_file), LAST (Pad))); Msg.Out (" ", src_file, Pad [MIN (Text.Length (src_file), LAST (Pad))]); END; t.cp_if (src, dest); END DoInstallFile; PROCEDUREMakeRoom (t: T; space: INTEGER) = BEGIN INC (t.listing_width, space); IF (t.listing_width > 75) THEN (* this line will be too long... *) IF (t.listing_width > space) THEN (* the existing line is non-empty *) Msg.Explain (); (* force a new-line *) END; t.listing_width := space; END; END MakeRoom;
PROCEDURE------------------------------------------ user callable export routines --InstallDerived (t: T; name: TEXT) = PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR dest := InstallDerivedDir (t); BEGIN InstallDir (t, dest, wr); Out (wr, "install_file(\"", M3Path.Escape (name), QCQ); Out (wr, M3Path.Escape (dest), QCQ, "0644", QRPCR); END Emit; BEGIN IF t.have_pkgtools THEN RETURN; END; Utils.WriteFile (M3Ship, Emit, append := TRUE); END InstallDerived; PROCEDUREInstallDerivedLink (t: T; from, to: TEXT) = PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR dest_dir := InstallDerivedDir (t); to_file := M3Path.New (dest_dir, to); from_file := M3Path.New (UseDerivedDir (t), from); BEGIN InstallDir (t, dest_dir, wr); Out (wr, "link_file(\"", M3Path.Escape (from_file), QCQ); Out (wr, M3Path.Escape (to_file), QRPCR); END Emit; BEGIN IF t.have_pkgtools THEN RETURN; END; Utils.WriteFile (M3Ship, Emit, append := TRUE); END InstallDerivedLink; PROCEDUREInstallDerivedDir (t: T): TEXT = VAR pkg := M3ID.ToText (t.build_pkg); dir := M3ID.ToText (t.build_dir); BEGIN RETURN M3Path.New (t.pkg_install, pkg, dir); END InstallDerivedDir; PROCEDUREUseDerivedDir (t: T): TEXT = VAR pkg := M3ID.ToText (t.build_pkg); dir := M3ID.ToText (t.build_dir); BEGIN RETURN M3Path.New (t.pkg_use, pkg, dir); END UseDerivedDir; PROCEDUREInstallLinkToDerived (t: T; src, dest: TEXT) RAISES {Quake.Error} = PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR target := M3Path.New (UseDerivedDir (t), src); link := M3Path.New (dest, src); BEGIN InstallDir (t, dest, wr); Out (wr, "link_file(\"", M3Path.Escape (target), QCQ); Out (wr, M3Path.Escape (link), QRPCR) END Emit; BEGIN IF t.have_pkgtools THEN InstallFile (t, src, dest, "0755", derived := TRUE); ELSE Utils.WriteFile (M3Ship, Emit, append := TRUE); END; END InstallLinkToDerived; PROCEDUREInstallDir (t: T; dir: TEXT; wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = BEGIN IF NOT Text.Equal (dir, t.last_ship_dir) THEN IF t.have_pkgtools THEN Out (wr, "-l ", dir, "\n"); ELSIF NOT t.all_ship_dirs.put (M3ID.Add (dir), NIL) THEN Out (wr, "make_dir(\"", M3Path.Escape (dir), QRPCR); END; t.last_ship_dir := dir; END; END InstallDir; PROCEDUREInstallFile (t: T; src, dest, mode: TEXT; derived: BOOLEAN) RAISES {Quake.Error} = VAR src_path: TEXT; PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = BEGIN (* make sure the install directory is built *) InstallDir (t, dest, wr); (* generate the code to install the file *) IF t.have_pkgtools THEN Out (wr, M3ID.ToText (t.build_dir), "/", src, "\n"); ELSE Out (wr, "install_file(\"", M3Path.Escape (src), QCQ); Out (wr, M3Path.Escape (dest), QCQ, mode, QRPCR); END; END Emit; BEGIN IF NOT derived THEN src_path := PathOf (t, src); IF t.have_pkgtools THEN (* Since the package tools refuse to export things that are outside the current package and in general we don't know where a source file resides, we make links to any exported source files. *) IF (t.cur_pkg # t.build_pkg) THEN IF (t.mode = MM.Build) THEN IF IsStale (src, src_path) THEN Utils.LinkFile (src_path, src); src_path := src; END; END; DeleteDeriveds (t, src, NoExtension); END; END; src := src_path; END; IF NOT (t.mode = MM.Build) THEN RETURN; END; IF t.pkg_overrides.size () > 0 THEN (* There were overides => don't create any shipping information *) NoteOverrides (t); RETURN; END; Utils.WriteFile (M3Ship, Emit, append := TRUE); END InstallFile; PROCEDUREInstallMan (t: T; page, sec: TEXT; derived: BOOLEAN) RAISES {Quake.Error} = VAR src := page & "." & sec; dest := M3Path.New (t.man_install, "man" & sec); BEGIN InstallFile (t, src, dest, "0644", derived); END InstallMan; PROCEDUREInstallSource (t: T; src, dest, mode: TEXT) = PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = BEGIN (* make sure the install directory is built *) InstallDir (t, dest, wr); IF t.have_pkgtools THEN Out (wr, src, "\n"); ELSE Out (wr, "install_file(\"", M3Path.Escape (src), QCQ); Out (wr, M3Path.Escape (dest), QCQ, mode, QRPCR); END; END Emit; BEGIN IF NOT (t.mode = MM.Build) THEN RETURN; END; IF t.pkg_overrides.size () > 0 THEN (* There were overides => don't create any shipping information *) NoteOverrides (t); RETURN; END; Utils.WriteFile (M3Ship, Emit, append := TRUE); END InstallSource; PROCEDUREIsStale (obj, src: TEXT): BOOLEAN = BEGIN RETURN Utils.ModificationTime (obj) < Utils.ModificationTime (src); END IsStale; PROCEDURENoteOverrides (<*UNUSED*> t: T) = BEGIN Utils.Remove (M3Ship); TouchFile (M3Overrides); END NoteOverrides;
PROCEDURE------------------------------------------------------------- .M3EXPORTS --DoBindExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN BindExport (t, PopText (t)); END DoBindExport; PROCEDUREBindExport (t: T; file: TEXT) RAISES {Quake.Error} = BEGIN InstallFile (t, file, t.bin_install, "0755", derived := TRUE); END BindExport; PROCEDUREDoBinExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopText (t); BEGIN InstallFile (t, file, t.bin_install, "0755", derived := FALSE); END DoBinExport; PROCEDUREDoLibdExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopText (t); BEGIN InstallFile (t, file, t.lib_install, "0755", derived := TRUE); END DoLibdExport; PROCEDUREDoLibExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopText (t); BEGIN InstallFile (t, file, t.lib_install, "0755", derived := FALSE); END DoLibExport; PROCEDUREDoEmacsdExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN EmacsdExport (t, PopText (t)); END DoEmacsdExport; PROCEDUREEmacsdExport (t: T; file: TEXT) RAISES {Quake.Error} = BEGIN InstallFile (t, file, t.emacs_install, "0644", derived := TRUE); END EmacsdExport; PROCEDUREDoEmacsExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN EmacsExport (t, PopText (t)); END DoEmacsExport; PROCEDUREEmacsExport (t: T; file: TEXT) RAISES {Quake.Error} = BEGIN InstallFile (t, file, t.emacs_install, "0644", derived := FALSE); END EmacsExport; PROCEDUREDoDocdExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopText (t); BEGIN InstallFile (t, file, t.doc_install, "0644", derived := TRUE); END DoDocdExport; PROCEDUREDoDocExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopText (t); BEGIN InstallFile (t, file, t.doc_install, "0644", derived := FALSE); END DoDocExport; PROCEDUREDoMandExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); page, sec: TEXT; BEGIN sec := PopText (t); page := PopText (t); InstallMan (t, page, sec, derived := TRUE); END DoMandExport; PROCEDUREDoManExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); page, sec: TEXT; BEGIN sec := PopText (t); page := PopText (t); InstallMan (t, page, sec, derived := FALSE); END DoManExport; PROCEDUREDoHtmlExport (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopText (t); BEGIN InstallSource (t, file, t.html_install, "0644"); END DoHtmlExport;
PROCEDURE-------------------------------------------------------------DoGenM3Exports (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); BEGIN EVAL PopID (t); (* backward compatibility *) GenM3Exports (t, NIL); END DoGenM3Exports; PROCEDUREGenM3Exports (t: T; header: TEXT) RAISES {Quake.Error} = CONST HTag = ARRAY BOOLEAN OF TEXT { "", "hidden" }; CONST KindTag = ARRAY UK OF TEXT { NIL, "_map_add_interface", NIL, NIL, NIL, "_map_add_module", NIL, NIL, NIL, "_map_add_generic_interface", "_map_add_generic_module", "_map_add_c", "_map_add_h", "_map_add_s", NIL, "_import_m3lib", "_import_otherlib", NIL, NIL, NIL, "template" } ; VAR fail_msg: TEXT := NIL; PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR nm: INTEGER; ref: REFANY; BEGIN Out (wr, "% exports of ", M3ID.ToText (t.build_pkg), Wr.EOL); Out (wr, header); (* copy forward overrides *) VAR it := t.pkg_overrides.iterate (); BEGIN WHILE it.next (nm, ref) DO Out (wr, "override(\"", M3Path.Escape (M3ID.ToText (nm)), QCQ); Out (wr, M3Path.Escape (ref), QRPCR); END; END; (* copy forward package imports *) VAR x := t.imports.iterate (); BEGIN WHILE x.next (nm, ref) DO Out (wr, "import_version(\"", M3Path.Escape (M3ID.ToText (nm)), QCQ); Out (wr, M3Path.Escape (ref), QRPCR); END; END; (* output the units *) VAR u := t.units.head; BEGIN WHILE (u # NIL) DO IF (NOT u.imported) THEN CASE u.kind OF | UK.Unknown, UK.IC, UK.IS, UK.MC, UK.MS, UK.PGM, UK.LIBX, UK.PGMX, UK.IO, UK.MO, UK.O => <*ASSERT KindTag[u.kind] = NIL *> | UK.I3, UK.M3, UK.IG, UK.MG, UK.C, UK.H, UK.S => <*ASSERT KindTag[u.kind] # NIL *> Out (wr, KindTag[u.kind], "(\""); Out (wr, M3Path.Escape (M3Unit.FileName (u)), QCQ); Out (wr, M3Path.Escape (M3ID.ToText (u.loc.pkg)), QCQ); Out (wr, M3Path.Escape (M3ID.ToText (u.loc.subdir)), QCQ); Out (wr, HTag [u.hidden], QRPCR); | UK.M3LIB => Out (wr, "_import_m3lib(\"", M3ID.ToText (u.name), QCQ); Out (wr, M3Path.Escape (M3ID.ToText (u.loc.pkg)), QCQ); Out (wr, M3Path.Escape (M3ID.ToText (u.loc.subdir)), QRPCR); | UK.LIB => Out (wr, "_import_otherlib(\"", M3ID.ToText (u.name), QCQ); Out (wr, M3Path.Escape (u.loc.path), "\", IMPORTED)", Wr.EOL); | UK.TMPL => Out (wr, "_import_template(\"", M3Unit.FileName (u), QCQ); Out (wr, M3Path.Escape (M3ID.ToText (u.loc.pkg)), QCQ); Out (wr, M3Path.Escape (M3ID.ToText (u.loc.subdir)), QRPCR); END; END; u := u.next; END; END; (* dump the rest, including the explicit hide/export calls *) VAR x := t.tfile_args.head; BEGIN WHILE (x # NIL) DO Out (wr, x.head); x := x.tail; END; END; (* dump any 'custom' calls; these must come after any _import_template() calls, which may introduce the definitions of the custom calls *) VAR b := t.lookup (M3ID.Add ("gen_map_hooks")); BEGIN IF (b # NIL) THEN TRY VAR sav := t.cur_wr (); BEGIN t.set_wr (wr); t.start_call (b.value); t.call_proc (0, FALSE); t.set_wr (sav); END; EXCEPT Quake.Error (msg) => fail_msg := msg; END; END; END; END Emit; BEGIN Utils.WriteFile (M3Exports, Emit, append := FALSE); IF (fail_msg # NIL) THEN RAISE Quake.Error (fail_msg); END; IF (t.mode = MM.Build) THEN InstallDerived (t, M3Exports); END; DeleteDeriveds (t, M3Exports, NoExtension); END GenM3Exports;
-T
files --
We don't need -T files any more. This function is just here
for backward compatibility with m3tk tools like stablegen...
PROCEDURE----------------------------------------------------------- file writing --DoGenTFile (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {} = CONST IsImportable = ARRAY UK OF BOOLEAN { FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE }; VAR t := Self (m); n_visible := 0; u : M3Unit.T; srcs: REF ARRAY OF M3Unit.T; map : REF ARRAY OF INTEGER; PROCEDURE CmpUnit (ax, bx: INTEGER): [-1 .. +1] = VAR a := srcs[ax]; b := srcs[bx]; BEGIN IF a.loc.pkg < b.loc.pkg THEN RETURN -1; END; IF a.loc.pkg > b.loc.pkg THEN RETURN +1; END; IF a.loc.subdir < b.loc.subdir THEN RETURN -1; END; IF a.loc.subdir > b.loc.subdir THEN RETURN + 1; END; IF a.name < b.name THEN RETURN -1; END; IF a.name > b.name THEN RETURN +1; END; RETURN 0; END CmpUnit; PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR uu: M3Unit.T; last_loc : M3Loc.T := NIL; BEGIN FOR i := 0 TO LAST (map^) DO uu := srcs [map[i]]; IF (uu.loc # last_loc) THEN Out (wr, "@", uu.loc.path, "\n"); last_loc := uu.loc; END; Out (wr, M3Unit.FileName (uu), "\n"); END; END Emit; BEGIN (* count the local sources *) u := t.units.head; WHILE (u # NIL) DO IF IsImportable [u.kind] AND NOT (u.hidden AND u.imported) THEN INC (n_visible); END; u := u.next; END; (* collect up the sources in an array *) srcs := NEW (REF ARRAY OF M3Unit.T, n_visible); map := NEW (REF ARRAY OF INTEGER, n_visible); n_visible := 0; u := t.units.head; WHILE (u # NIL) DO IF IsImportable [u.kind] AND NOT (u.hidden AND u.imported) THEN srcs [n_visible] := u; map [n_visible] := n_visible; INC (n_visible); END; u := u.next; END; (* sort the local sources by directory *) IntArraySort.Sort (map^, CmpUnit); (* finally, dump the file *) Utils.WriteFile (M3TFile, Emit, append := FALSE); IF (t.mode = MM.Build) THEN InstallDerived (t, M3TFile); END; DeleteDeriveds (t, M3TFile, NoExtension); END DoGenTFile; PROCEDUREDoDeleteFile (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); file := PopText (t); BEGIN Utils.Remove (file); END DoDeleteFile; PROCEDUREDoLinkFile (m: QMachine.T; <*UNUSED*> n_args: INTEGER) RAISES {Quake.Error} = VAR t := Self (m); src, dest: TEXT; BEGIN dest := PopText (t); src := PopText (t); Utils.LinkFile (src, dest); END DoLinkFile;
PROCEDURE------------------------------------------------------------------- misc --Out (wr: Wr.T; a, b, c, d, e: TEXT := NIL) RAISES {Wr.Failure, Thread.Alerted} = BEGIN IF (a # NIL) THEN Wr.PutText (wr, a); END; IF (b # NIL) THEN Wr.PutText (wr, b); END; IF (c # NIL) THEN Wr.PutText (wr, c); END; IF (d # NIL) THEN Wr.PutText (wr, d); END; IF (e # NIL) THEN Wr.PutText (wr, e); END; END Out; PROCEDURETouchFile (file: TEXT) = (* Create a new empty file *) BEGIN Utils.CloseWriter (Utils.OpenWriter (file, fatal := TRUE), file); END TouchFile;
PROCEDURE*******************************Self (m: QMachine.T): T = BEGIN RETURN NARROW (m, T); END Self; PROCEDUREConfigDefn (t: T; sym: TEXT): QValue.Binding RAISES {Quake.Error} = VAR bind := t.lookup (M3ID.Add (sym)); BEGIN IF (bind = NIL) THEN ConfigErr (t, sym, "not defined"); END; RETURN bind; END ConfigDefn; PROCEDUREGetConfig (t: T; symbol: TEXT): TEXT RAISES {Quake.Error} = VAR bind := ConfigDefn (t, symbol); BEGIN TRY RETURN QVal.ToText (t, bind.value); EXCEPT Quake.Error (msg) => ConfigErr (t, symbol, msg); RETURN ""; END; END GetConfig; PROCEDUREGetConfigBool (t: T; symbol: TEXT): BOOLEAN RAISES {Quake.Error} = VAR bind := t.lookup (M3ID.Add (symbol)); BEGIN IF (bind = NIL) THEN RETURN FALSE; END; TRY RETURN QVal.ToBool (t, bind.value); EXCEPT Quake.Error (msg) => ConfigErr (t, symbol, msg); RETURN FALSE; END; END GetConfigBool; PROCEDUREConfigErr (t: T; symbol, msg: TEXT) RAISES {Quake.Error} = BEGIN t.error ("Unable to use definition of \"" & symbol & "\" from configuration file \"" & M3Config.FindFile () & "\": " & msg); END ConfigErr; TYPE TextVector = REF ARRAY OF TEXT; PROCEDURESeqToTexts (t: T; seq: QVSeq.T): TextVector RAISES {Quake.Error} = VAR n := seq.size (); txts := NEW (TextVector, n); BEGIN FOR i := 0 TO n - 1 DO txts[i] := QVal.ToText (t, seq.get (i)); END; RETURN txts; END SeqToTexts; PROCEDUREPopArray (t: T): QVSeq.T RAISES {Quake.Error} = VAR v: QValue.T; BEGIN t.pop (v); RETURN QVal.ToArray (t, v); END PopArray; PROCEDUREStr2ID (READONLY x: ARRAY OF CHAR): Quake.ID = BEGIN RETURN M3ID.FromStr (x); END Str2ID; PROCEDURETxt2ID (t: TEXT): Quake.ID = BEGIN RETURN M3ID.Add (t); END Txt2ID; PROCEDUREID2Txt (i: Quake.ID): TEXT = BEGIN RETURN M3ID.ToText (i); END ID2Txt; BEGIN END M3Build.
%----------------------------------------------------------------------- M3 ---
readonly proc DO_M3(args) is before_do_m3_hooks() generate_tfile()
if defined (CAPTURE_M3
)
local all_args = arglist (, [M3_CONFIG,
-make
, M3OPTIONS, args,
M3SEARCH_TABLES, COMPILE_SOURCES,
IMPORT_LIBS, OTHER_LIBS_L])
cp_if (all_args, .M3ARGS
)
end
local sources = arglist(-F
, [M3SEARCH_TABLES, COMPILE_SOURCES,
IMPORT_LIBS, OTHER_LIBS_L])
if not defined (_quiet
)
write([m3
, M3OPTIONS, args, sources, CR])
% write([M3, M3_CONFIG, -make
, M3OPTIONS, args, sources, CR])
end
exec(@-
& M3, M3_CONFIG, -make
, M3OPTIONS, args, sources)
install_derived (M3WEB)
if not empty(PKG_OVERRIDES) % there were overrides => don't create any shipping information NoteOverrides() end end
readonly proc NoteOverrides() is delete_file(M3SHIP_FILE) > M3OVERRIDES in write (CR) end end
%-------------------------------------------------------------------- noweb ---
readonly proc noweb(src_file,root,dest_file) is
src_file = path_of(src_file & .nw
)
local tmp_dest = .
& dest_file
if defined(_all
)
if stale(tmp_dest, src_file)
exec(notangle -L'<*LINE %L \
%F\ *>%N' -R'
& root & '
, src_file,
>
, tmp_dest)
end
cp_if (tmp_dest, dest_file)
end
deriveds(tmp_dest, no_extension)
deriveds(dest_file, no_extension)
end
readonly proc noweb_interface(f,r,d) is
noweb(f,r,d & .i3
)
derived_interface(d, HIDDEN)
end
readonly proc Noweb_interface(f,r,d) is
noweb(f,r,d & .i3
)
derived_interface(d, VISIBLE)
end
readonly proc noweb_implementation(f,r,d) is
noweb(f,r,d & .m3
)
derived_implementation(d)
end
%--------------------------------------------------------------------- Zume ---
proc zume(x) is
write(zume is not implemented
, CR)
end
*******************************