;"***************************************************************************** ABSTR.MUD: EDIT HISTORY Machine Independent COMPILATION: NOT CAREFUL, GLUEABLE 1JUN84 [Shane] - Created package for abstracting compiled packages. 18JUL84 [Shane] - Support definition modules. 19JUL84 [Shane] - Divided abstract forms into 4 collection categories. Support USE-WHEN, INCLUDE-WHEN, USE-DEFER. 25JUL84 [Shane] - Cannot abstract RPACKAGE. 30JUL84 [Shane] - Group loading is optional in DESCRIBE-PACKAGE. 4AUG84 [Shane] - Sort vectors in PKGINFO. Add stupid optional arguments for ABSTR END-DEFINITIONS, PACKAGE, ENDPACKAGE. 7AUG84 [Shane] - Flush group loading feature in DESCRIBE-PACKAGE. Look for MBIN files. Use filenames package. 14AUG84 [Shane] - Flushed ABSTRACT-PACKAGES, add validation of USED-DU-LIST so that DU's are built only once if possible. USED-DU-LIST retains state between invocations of abstraction process. 16AUG84 [Shane] - Mung MSUBR IMSUBR names and code offsets to set up for magic loading of packages in compiler when an abstracted MSUBR is called. The magic msubr loader must be named ABSTRACT-MSUBR-LOADER and the corresponding IMSUBR must be named abstract-msubr-loader-IMSUBR on the ROOT oblist for this scheme to work. 26AUG84 [Shane] - Flushed FILENAMES package since no one used it except me. FILENAMES survives as new function SEARCH and macro EXTRACT-NM1. Moved macros, internal type definitions to definitions ABSTR-DEFS. Flushed usage of NEWSTRUC - define PKGINFO type with MDL primitives. 28AUG84 [Shane] - Support abstraction of NEW-CHANNEL-TYPE. Remove use of associations. SEARCH is an ENTRY. Rewrite DU-DEFINES? and others because of compiler woes. Channel types collected in global NEW-CHANNEL-TYPES list. 31AUG84 [Shane] - Flush module oblist when we build a DU if it's around. See ABSTR-PACKAGE, ABSTR-DEFINITIONS. Mung copy of msubr - see ABSTR-GROVEL. Updated PRELOADED package vector. USE ABSTR-LOADER to get name of magic IMSUBR. 5SEP84 [Shane] - Support abstraction of ADD-CHANNEL-OPS: similar to NEW-CHANNEL-TYPE except for the name. These are no longer collected in global list. DU's now contain a list of special forms to be added to the abstract. Added ABSTR-GROVEL-SPECIAL which checks these forms and takes action based on the first element of the form. Future special forms should use this mechanism - see ABSTR-ADD-CHANNEL-OPS, ABSTR-NEW-CHANNEL-TYPE, REDEFINE-ENVIRONMENT, RESTORE-ENVIRONMENT for example of how to add special forms. See ABSTR-GROVEL-SPECIAL for example of how to process them. 20FEB85 [Shane] - Added switch ABSTRACT-IGNORE? - controls whether or not file not found events cause errors. *****************************************************************************"  ;"> if package can be abstracted if abstract is unbound or not false returns the name of the abstract file (default: package.abstr) else returns vector of two elements: [1] list of forms representing package abstract [2] the associated oblist path else returns false describing why package cannot be abstracted." ;"> Returns a PKGINFO for package contained in fn. If abstract? is T, the PKGINFO will contain an abstract for package (if it can be abstracted), otherwise false. Default: T. Note: fn can be either a package name or a file name. See description of PKGINFO below." ;"ABSTRACT-CAREFUL?: - If false, analysis of macros is inhibited. False is appropriate if no macro in the package to be abstracted references internal types, calls a non-primitive procedure, or references another package. Default: T." ;"ABSTRACT-NOISY?: - If false, loading messages are suppressed. Default: T." ;"ABSTRACT-IGNORE?: - If true, use of packages not found is ignored (an error message is written), else an error occurs." ;" Search path (default L-SEARCH-PATH) for file named name using second-names. If not found, result is false. Otherwise, result depends on oper (NAME -> STRING file name, VECTOR -> VECTOR of STRING file name components, CHANNEL -> CHANNEL open to file." "ABSTR-DEFS">  ;"*** Object Definitions. ***" ;"A PKGINFO contains everything you ever wanted to know about a package or definition module. This structure is returned by DESCRIBE-PACKAGE. The meaning of the fields is as follows: PKG-TYPE: Either PACKAGE or DEFINITIONS. PKG-NAME: Name of described package. PKG-CODE: Name of package msubr file, if any. PKG-SOURCE: Name of package mud file, if any. PKG-ENTRYS: Entrys of package: sorted. PKG-RENTRYS: Rentrys of package: sorted. PKG-USES: Names of packages used by package: sorted. PKG-EXPORTS: Names of packages exported by package: sorted. PKG-INCLUDES: Names of definitions included by package: sorted. PKG-ABSTRACT: False if package was not abstracted, else a vector whose first element is the forms of the abstract and whose second element is the associated oblist path." > ;"Who needs NEWSTRUC?" ATOM STRING > > >>)) >> >> >> >> >> >> >> >> >> >> >)>  ;"Internal types defined in ABSTR-DEFS." > )> > )> ;"Names of preloaded packages - 1SEP84." > ;"Preserve pointers to redefined package/definitions operations." > > ,PACKAGE>> ,ENDPACKAGE>> ,RENTRY>> ,ENTRY>> ,USE>> ,EXPORT>> ,USE-WHEN>> ,USE-TOTAL>> ,USE-DEFER>> ,INCLUDE>> ,INCLUDE-WHEN>> ,DEFINITIONS>> ,END-DEFINITIONS>> ,RPACKAGE>> ,NEW-CHANNEL-TYPE>> ,ADD-CHANNEL-OPS>>)>  ;"*** Global State. ***" ;"ABSTRACT-CAREFUL? - If false, macros are not checked. If it is known that macros in a package call only primitive operations and that all types in the macro are primitive or defined by entrys or rentrys then false is appropriate. Default is careful." >> ;"ABSTRACT-NOISY? - Controls whether or not loading messages are printed. Default is noisy." >> ;"ABSTRACT-IGNORE? - Controls behavior in the event that a package cannot be loaded. Default is careful." '>> ;"DU-LIST-VALID? - T iff last abstraction returned normally." '> ;"TOPLEVEL-DU - Represents the package to be abstracted: initially false." > ;"CURRENT-DU - Points to the DU under construction for package or definition module that is currently being evaluated." ;"USED-DU-LIST - Contains every DU ever created during abstraction process so that DUs can be reused. Initially empty." ;"DU-STACK - Partially completed DUs that have been pushed because the corresponding source files used other packages for which DUs must be constructed. Initially empty." > ;"ABSTRACT - Contains the body of the abstraction and its associated oblist path. Initially empty, forms are enqueued as needed during abstraction." ;"NAME-STACK - Top is the atom currently being analyzed. Maintained by ABSTR-GROVEL for informational purposes in the event of an error." ;"ABSTRACTED - Contains every atom that has been ABSTRACTED during abstraction process to break recursion and prevent duplications." >  ;"*** Operations ***" ;"ABSTRACT-PACKAGE - Given the name of a package or definition module to abstract, analyzes the package to determine the minimum amount of information necessary to describe the interface. Writes the information to specified file. All functions to be abstracted must be compiled. Returns the abstract (file name or forms) if successful, else false." ) (OBLIS .OBLIST)) #DECL ((NAME) STRING (AP) (OFN) (OCH) FALSE> (OBLIS) ) > ) ;"Make sure we built a DU." )> > ;"Then use default name." )) #DECL ((NM2) (CH) ) > >)> > )>)> ;"Create the abstraction and associated oblist path." > > > > <1 .ABSTR>> > ;"Return the name of the abstraction file." .OFN) (T ;"Return abstraction forms and oblist path." .ABSTR)>> ;"If there was an error - try to clean up ..." )>>>>  ;"DESCRIBE-PACKAGE - Constructs and returns a PKGINFO for NAME. If ABSTRACT? is false, no abstract will be created, otherwise an abstract is attempted (the abstract will be false if the package cannot be abstracted)." (OBLIS) ) > ) (OUTCHAN .OUTCHAN)) #DECL ((OUTCHAN) CHANNEL (ABSTR) >) )> ) >>) (,ABSTRACT-NOISY? > > .ABSTR>)>)> ]>) > PACKAGE) (T DEFINITIONS)> ]> ]> >> >> >> .ABSTR] PKGINFO>>> ;"If there was an error, try to clean up." >>  ;"*** Description Units (DUs) are built by following routines: First Pass. ***" ;"BUILD-DU - If USED-DU-LIST is valid, and a DU for NAME is found, then it becomes TOPLEVEL-DU. Otherwise, the package corresponding to NAME is loaded, creating TOPLEVEL-DU in the process." )) #DECL ((NAME) STRING (ICH) ) ,DU-LIST-VALID? >> )> >> > > ) > > >> ) (T BUILD-DU> )>)> T> ;"REDEFINE-ENVIRONMENT - Replace definitions of package routines with routines that manipulate global state (build DUs) as well as loading and evaluating packages (or definition modules)." ;"Disallow deferral." T>  ;"RESTORE-ENVIRONMENT - Restore normal definitions of package routines." T> ;"ABSTR-PACKAGE - Replaces definition of PACKAGE during abstraction process. Performs the actions that PACKAGE performs, creates a DU for the package, adds the new DU to USED-DU-LIST, pushes CURRENT-DU onto DU-STACK and sets CURRENT-DU to be the new DU." )) #DECL ((NAME INAME TNAME) STRING (OBL IOBL) (NEW-DU) DU) > > ;"Flush previous." )> <*PACKAGE .NAME .INAME> ;"Use translated name for lookup, untranslated name for DU name!" OBLIST>> OBLIST>> ] DU>> ) (T ;"First package is the file to be abstracted." )> T>  ;"ABSTR-DEFINITIONS - Replaces definition of DEFINITIONS during abstraction process. Performs the actions that DEFINITIONS performs, creates a DU for the definition module, adds the new DU to USED-DU-LIST, pushes CURRENT-DU onto DU-STACK and sets CURRENT-DU to be the new DU." )) #DECL ((TNAME NAME) STRING (OBL) (NEW-DU) DU) > ;"Flush previous." )> <*DEFINITIONS .NAME> ;"Use translated name for lookup, untranslated name for DU name!" > OBLIST>> '() '() '() '() '() '() %<>] DU>> ) (T ;"First definitions is the file to be abstracted." )> T> ;"ABSTR-USE - Replaces definition of USE during abstraction process. Performs the actions that USE performs. If a DU does not exist, the package is loaded (which creates a DU) otherwise the existing DU is used. The DU for each name is prepended to the uses list of CURRENT-DU." [REST STRING]>) (CDU) DU) >)> >> >)> )> ) ( ,ABSTRACT-IGNORE?> ) (T )>> .NAMES>> <*USE !.NAMES>>>  ;"ABSTR-INCLUDE - Replaces definition of INCLUDE during abstraction process. Performs the actions that INCLUDE performs. If a DU does not exist, the definitions is loaded (which creates a DU) otherwise the existing DU is used. The DU for each name is prepended to the includes list of CURRENT-DU." [REST STRING]>) (CDU) DU) >)> >> >)> )> ) ( ,ABSTRACT-IGNORE?> ) (T )>> .NAMES>> <*INCLUDE !.NAMES>> T> ;"ABSTR-EXPORT - Replaces definition of EXPORT during abstraction process. Performs the actions that EXPORT performs. If a DU does not exist, the package is loaded (which creates a DU) otherwise the existing DU is used. The DU for each name is prepended to the exports list of CURRENT-DU." [REST STRING]>) (CDU) DU) >)> >> >)> )> ) ( ,ABSTRACT-IGNORE?> ) (T )>> .NAMES>> <*EXPORT !.NAMES>> T> ;"ABSTR-RENTRY - Replaces definition of RENTRY during abstraction process. Performs the actions that entry performs and prepends NAMES to rentry list of CURRENT-DU." [REST ATOM]> (CDU) DU) <*RENTRY !.NAMES> )> T>  ;"ABSTR-ENTRY - Replaces definition of ENTRY during abstraction process. Performs the actions that entry performs and prepends NAMES to entry list of CURRENT-DU." [REST ATOM]> (CDU) DU) <*ENTRY !.NAMES> )> T> ;"ABSTR-ENDPACKAGE - Replaces definition of ENDPACKAGE during abstraction process. Performs the actions that ENDPACKAGE performs, then sets CURRENT-DU to be the top of DU-STACK and pops DU-STACK." ) <*ENDPACKAGE .NAME>) (T <*ENDPACKAGE>)> > ;"Empty => CURRENT-DU == TOPLEVEL-DU." > >)> T> ;"ABSTR-END-DEFINITIONS - Replaces definition of END-DEFINITIONS during abstraction process. Performs the actions that END-DEFINITIONS performs, puts the entry list into CURRENT-DU, then sets CURRENT-DU to be the top of DU-STACK and pops DU-STACK." )) #DECL ((STK) (CDU) DU (L) LIST (OBL) OBLIST) <*END-DEFINITIONS .NAME>) (T <*END-DEFINITIONS>)> ;"Get the entry oblist - every atom in definition module is an entry." ) > .OBL> )>> .BKT>> ,ATOM-TABLE> > ;"Empty => CURRENT-DU == TOPLEVEL-DU." > >)> T> ;"ABSTR-USE-WHEN - Force usage to occur during abstraction." [REST STRING]>) > ;"ABSTR-INCLUDE-WHEN - Force inclusion to occur during abstraction." [REST STRING]>) >  ;"ABSTR-USE-TOTAL - Barf becuase USE-TOTAL should not appear in package." %<>> ;"ABSTR-RPACKAGE - Barf becuase RPACKAGE is obsolete." %<>> ;"ABSTR-NEW-CHANNEL-TYPE - Replaces definition of NEW-CHANNEL-TYPE during abstraction process. Performs the actions that NEW-CHANNEL-TYPE performs then adds the new channel type to the list of special forms of CURRENT-DU." > (SHIT) < [REST ATOM ]> (CDU) DU (DUS) ) <*NEW-CHANNEL-TYPE .NAME .INHERIT !.SHIT> [REST ATOM ]>) ) ( MSUBR> <2 .RSHIT >>)> >> ) (>>> )>) (T 1>> ()>)> T> ;"ABSTR-ADD-CHANNEL-OPS - Replaces definition of ADD-CHANNEL-OPS during abstraction process. Performs the actions that ADD-CHANNEL-OPS performs then adds the new channel type to the list of special forms of CURRENT-DU." (SHIT) < [REST ATOM ]>) <*ADD-CHANNEL-OPS .NAME !.SHIT> [REST ATOM ]>) ) ( MSUBR> <2 .RSHIT >>)> >> ) (>>> )>) (T 1>> ()>)> T>  ;"LOAD-PACKAGE - Find and load package named NAME, choking if not found. Employs the package system to open a channel to appropriate file." )) #DECL ((NAME) STRING (ICH) ) > > ) ( ,ABSTRACT-IGNORE?> %<>) (T LOAD-PACKAGE> %<>)> T> ;"TRANSLATED - If NAME is translated by the library system, return the translated name, otherwise return NAME." ) ) (<=? .NAME <1 .TRANSLATIONS>> >) (T >)>>> ;"FIND-DU - Search USED-DU-LIST for DU named NAME, returning the DU if found. Else, if NAME is the name of preloaded package, create a dummy DU for preloaded package and return it. Otherwise, return false." ) )) #DECL ((P) >) >>) (T >)>>) (<=? .NAME >> >) (T >)>>> ;"CREATE-PRELOADED-DU - Creates and returns a dummy DU for NAME where NAME is the name of a preloaded package. The oblist, internal oblist, and name slots are set appropriately, but the entries, rentries, uses, and exports are empty. Adds created DU to USED-DU-LIST." (PDU) DU) >> >> .OBL>> >)> ] DU>> .PDU) (T %<>)>>  ;"*** Following routines implement analysis of DUs: Second Pass. ***" ;"ABSTR-CREATE - Analyze the package corresponding to TOPLEVEL-DU. If no error arises during analysis, returns a vector of two elements: the first is the forms of the abstract and the second is the associated oblist path. Assumes global state is appropriately initialized." >) (PRELOADED ,PRELOADED) BODY TAIL PATH STRINGS) #DECL ((ABSTRACT) ABSTRACTION (PRELOADED) (BODY TAIL) (TDU) DU (PATH) (STRINGS) ) > ;"Grovel over every entry and rentry atom in package, adding information to ABSTRACT when necessary. Create the body of the abstraction. Grovel over special forms." > (! !)> >> > ,USED-DU-LIST>>> ;"Cons up the body of the abstraction, simultaneously setting up oblist path as if we were inside the abstraction." ) FORM>)>> >) (T ) FORM>)>> >)> >> > ) FORM>)>>)> >> ) FORM>)>>)> >> >> > )>> )>  .PRELOADED>> >) (T )>> >> > )>> )> .PRELOADED>> >) (T )>> >> > )>> )> 1>> ;"Ignore leading atom." >> >)> 1>> ;"Ignore leading atom." >> >)> >> ) FORM>)>>)> >> ) FORM>)>>)> >> >>> 1>>>)> > ;"Hang onto copy of oblist path." )> ) (T )> )> ;"Return body of abstract and associated oblist path." [.BODY .PATH]>  ;"ABSTR-GROVEL - Determines what information about NAME must be included in abstract. NAME should be an entry or rentry of TOPLEVEL-DU or on its internal oblist. NAME is marked ABSTRACTED to prevent cycles and duplications. This routine preserves the gvals of msubrs, macros, manifested GVALs that are not structured (except offsets are allowed). Type decls and gdecls (GDECL, PUT-DECL, NEWTYPE) are preserved." >> )> ;"Push name onto stack." ;"Mark as abstracted." > >> ;"NAME is a new type or an abbreviation for a type (PUT-DECL)." > .VAL) FORM>>) (T >)>)> >> >>> ;"NAME has been gdecled." )>)> > > ) ( ) ( .NAME> ;"Analyze msubr argument decls." > )>> :> ;"Copy MSUBR with new magic IMSUBR name." MSUBR>> ;"Mung copy." > ;"In case it was glued." ) (T ;"Preserve alias msubr names." > >>)>) ( > ) ( ;"Analyze offset argument decl." >)> ;"Analyze offset element decl." >)>) ( > >)>)> ;"Setg (if needed) and manifest." )> )> > ;"Pop name stack." T>  ;"ABSTR-GROVEL-SPECIAL - Handle special forms in TOPLEVEL-DU on form by form basis. Currently, NEW-CHANNEL-TYPE and ADD-CHANNEL-OPS. The first element of the form determines the action taken." ]>) )> >>> > ;"Grovel over channel types we inherit from." > ATOM> ) (T ,IF-NEEDED .TEMP:< [REST ATOM]>>)>) (<==? .KIND ADD-CHANNEL-OPS> ;"Check out the channel type we are augmenting." >)>> T> ;"GROVEL-DECL - Analyzes a DECL pattern fringe, abstracting ATOMs where necessary by invoking IF-NEEDED for ATOMs which represent types." ) ;"If it is a newtype or an abbreviation, then analyze if necessary." > )>) ( ;"Either quoted or composite." QUOTE> > ) (> ;"Exact non-structured type - analyze its decl." >>) ( ATOM> ;"Maybe an atom from another module." >)>) (T ;"Composite type - analyze the parts of the decl." ,GROVEL-DECL .DCL>)>) (T ;"Element specification (e.g. [REST ...]), analyze element decls." ,GROVEL-DECL >)> T>  ;"GROVEL-MACRO - Analyze the body of a macro (compiled or not). If the macro is compiled, include a setg for the imsubr of the compiled macro in the abstract. Analysis is inhibited if ABSTRACT-CAREFUL? is false." >) ,ABSTRACTED>> ;"If package is glued, we dont want to setg the imsubr twice." > !,ABSTRACTED)> )>> :> >)>) (T )>) (,ABSTRACT-CAREFUL? ,GROVEL-MACRO-PART-EVAL .BODY:>)> T> ;"GROVEL-MACRO-FORM - Analyzes a form in a macro. Inspects the first element of the form, barfing if it is not a primitive atom or fix. Analyzes rest of the form in an quoted context or a evaluated context depending on whether or not the first element is QUOTE or some other primitive atom, respectively." > > ATOM FIX> >) ( > >) (T )>) (T )>)> T> ;"GROVEL-MACRO-PART-EVAL - Analyzes part of a macro in evaluated context. The first element of every form is required to be a primitive atom. Dives into interesting structures, abstracting newtypes and atoms." >)> ) (<==? LIST> ,GROVEL-MACRO-PART-EVAL .EP:>) (<==? VECTOR> ,GROVEL-MACRO-PART-EVAL .EP:>)>) ( )> T>  ;"GROVEL-MACRO-PART-QUOTE - Analyzes part of a macro in quoted context. Dives into interesting structures, abstracting newtypes and atoms. Allows anything as first element of a form because it will not be evaluated." >)> LIST> ,GROVEL-MACRO-PART-QUOTE .QP:>) (<==? VECTOR> ,GROVEL-MACRO-PART-QUOTE .QP:>)>) ( )> T> ;"GROVEL-MACRO-COMP - Beginning with the mvector of a compiled macro (see GROVEL-MACRO) descend to the fringe, analyzing types in the process." >) >)> LIST> ,GROVEL-MACRO-COMP-PART .THING:>) (<==? VECTOR> ,GROVEL-MACRO-COMP-PART .THING:>)> T> ;"GROVEL-MACRO-PART-COMP - Check out the parts of the structures given to GROVEL-MACRO-COMP. If an atom is found which is gassigned but not manifest and it is not primitive, then an error occurs." '[LIST VECTOR]> ) ( ) ( >> ) ( > )>) ( >)> T> ;"PRIMITIVE? - Returns false if NAME is not on known oblist or if NAME is a rentry defined by something which is not preloaded." ) > ;"Note - Preloaded packages not found here because DUs for preloaded packages contain no rentries. Assume preloaded packages as primitive." > )>> ,USED-DU-LIST>>>>) (T %<>)>>  ;"DU-DEFINES? - If DU has not been SEEN, then if NAME is defined by DU or by any DUs exported by DU, then non-false is returned. Includes DUs explored in SEEN to break cyles in usage of packages." ) %<>) (T > T) ( >> T) (T )) #DECL ((DUX) ) >) (> .SEEN> ) (T >)>>)>)>> ;"IF-NEEDED - If NAME is defined by TDU, recursively invokes ABSTR-GROVEL on NAME. Else, if NAME is defined by a DU used by TDU, then that DU is marked so that it will be used in abstract. Else, if NAME is on root oblist it is assumed primitive (or preloaded), otherwise an error occurs." ) (TDU ,TOPLEVEL-DU)) #DECL ((NAME) ATOM (NOBL) (TDU) DU) > <==? .NOBL > >> ) (T )>> (! ! !)> <==? .NOBL #OBLIST ROOT> <==? .NOBL #OBLIST ERRORS> >)>) (T )> T>  ;"BARF - Returns false from the frame named AP if AP is a legal frame, otherwise error. The error handler for the abstraction package." ANY>) >> >>) (PUKE (ABSTRACTION-ERROR!-ERRORS .WHO !.BARFAGE))) #DECL ((WHO) STRING (PUKE) LIST) > .AP>) (T )>>) ( > .AP>) (T )> %<>> ;"MESSAGE - Prints BARFAGE to OUTCHAN." [REST ANY]>) > .BARFAGE>>> ;"ALESS? - Return T if pname of A1 is greater than pname of A2." > 1>>  ;"SEARCH - Find a filename in the library search path. Only files are considered - libraries are not consulted. If OPER = VECTOR, a vector of 5 elements is returned = [FN NM1 NM2 DEV SNM]. If OPER = NAME, the file name is returned. If OPER = CHANNEL a channel open to the file is returned." (ODEV OSNM) STRING) ) ( ) (T )> ) ( ) (T )> )) #DECL ((SPEC) (DEV SNM) (RESULT) FALSE>) > )> > 2> > >) (T ) (T )> ) (T )>)> (NM2) (CH) FALSE>) )> > > ]> ) (<==? .OPER NAME> > ) (T )> )> >>)> >>>